FS/FS/part_svc.pm

   1 package FS::part_svc;
   2
   3 use strict;
   4 use vars qw( @ISA );
   5 use FS::Record qw( qsearch qsearchs fields dbh );
   6 use FS::part_svc_column;
   7
   8 @ISA = qw(FS::Record);
   9
  10 =head1 NAME
  11
  12 FS::part_svc - Object methods for part_svc objects
  13
  14 =head1 SYNOPSIS
  15
  16   use FS::part_svc;
  17
  18   $record = new FS::part_svc \%hash
  19   $record = new FS::part_svc { 'column' => 'value' };
  20
  21   $error = $record->insert;
  22
  23   $error = $new_record->replace($old_record);
  24
  25   $error = $record->delete;
  26
  27   $error = $record->check;
  28
  29 =head1 DESCRIPTION
  30
  31 An FS::part_svc represents a service definition.  FS::part_svc inherits from
  32 FS::Record.  The following fields are currently supported:
  33
  34 =over 4
  35
  36 =item svcpart - primary key (assigned automatically for new service definitions)
  37
  38 =item svc - text name of this service definition
  39
  40 =item svcdb - table used for this service.  See L<FS::svc_acct>,
  41 L<FS::svc_domain>, and L<FS::svc_forward>, among others.
  42
  43 =item disabled - Disabled flag, empty or `Y'
  44
  45 =back
  46
  47 =head1 METHODS
  48
  49 =over 4
  50
  51 =item new HASHREF
  52
  53 Creates a new service definition.  To add the service definition to the
  54 database, see L<"insert">.
  55
  56 =cut
  57
  58 sub table { 'part_svc'; }
  59
  60 =item insert
  61
  62 Adds this service definition to the database.  If there is an error, returns
  63 the error, otherwise returns false.
  64
  65 =item I<svcdb>__I<field> - Default or fixed value for I<field> in I<svcdb>.
  66
  67 =item I<svcdb>__I<field>_flag - defines I<svcdb>__I<field> action: null, `D' for default, or `F' for fixed
  68
  69 =cut
  70
  71 sub insert {
  72   my $self = shift;
  73
  74   local $SIG{HUP} = 'IGNORE';
  75   local $SIG{INT} = 'IGNORE';
  76   local $SIG{QUIT} = 'IGNORE';
  77   local $SIG{TERM} = 'IGNORE';
  78   local $SIG{TSTP} = 'IGNORE';
  79   local $SIG{PIPE} = 'IGNORE';
  80
  81   my $oldAutoCommit = $FS::UID::AutoCommit;
  82   local $FS::UID::AutoCommit = 0;
  83   my $dbh = dbh;
  84
  85   my $error = $self->SUPER::insert;
  86   if ( $error ) {
  87     $dbh->rollback if $oldAutoCommit;
  88     return $error;
  89   }
  90
  91   my $svcdb = $self->svcdb;
  92 #  my @rows = map { /^${svcdb}__(.*)$/; $1 }
  93 #    grep ! /_flag$/,
  94 #      grep /^${svcdb}__/,
  95 #        fields('part_svc');
  96   foreach my $field (
  97     grep { $_ ne 'svcnum'
  98            && defined( $self->getfield($svcdb.'__'.$_.'_flag') )
  99          } fields($svcdb)
 100   ) {
 101     my $part_svc_column = $self->part_svc_column($field);
 102     my $previous = qsearchs('part_svc_column', {
 103       'svcpart'    => $self->svcpart,
 104       'columnname' => $field,
 105     } );
 106
 107     my $flag = $self->getfield($svcdb.'__'.$field.'_flag');
 108     if ( uc($flag) =~ /^([DF])$/ ) {
 109       $part_svc_column->setfield('columnflag', $1);
 110       $part_svc_column->setfield('columnvalue',
 111         $self->getfield($svcdb.'__'.$field)
 112       );
 113       if ( $previous ) {
 114         $error = $part_svc_column->replace($previous);
 115       } else {
 116         $error = $part_svc_column->insert;
 117       }
 118     } else {
 119       $error = $previous ? $previous->delete : '';
 120     }
 121     if ( $error ) {
 122       $dbh->rollback if $oldAutoCommit;
 123       return $error;
 124     }
 125
 126   }
 127
 128   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 129
 130   '';
 131 }
 132
 133 =item delete
 134
 135 Currently unimplemented.
 136
 137 =cut
 138
 139 sub delete {
 140   return "Can't (yet?) delete service definitions.";
 141 # check & make sure the svcpart isn't in cust_svc or pkg_svc (in any packages)?
 142 }
 143
 144 =item replace OLD_RECORD
 145
 146 Replaces OLD_RECORD with this one in the database.  If there is an error,
 147 returns the error, otherwise returns false.
 148
 149 =cut
 150
 151 sub replace {
 152   my ( $new, $old ) = ( shift, shift );
 153
 154   return "Can't change svcdb for an existing service definition!"
 155     unless $old->svcdb eq $new->svcdb;
 156
 157   local $SIG{HUP} = 'IGNORE';
 158   local $SIG{INT} = 'IGNORE';
 159   local $SIG{QUIT} = 'IGNORE';
 160   local $SIG{TERM} = 'IGNORE';
 161   local $SIG{TSTP} = 'IGNORE';
 162   local $SIG{PIPE} = 'IGNORE';
 163
 164   my $oldAutoCommit = $FS::UID::AutoCommit;
 165   local $FS::UID::AutoCommit = 0;
 166   my $dbh = dbh;
 167
 168   my $error = $new->SUPER::replace( $old );
 169   if ( $error ) {
 170     $dbh->rollback if $oldAutoCommit;
 171     return $error;
 172   }
 173
 174   if ( @_ && $_[0] eq '1.3-COMPAT' ) {
 175     my $svcdb = $new->svcdb;
 176     foreach my $field (
 177       grep { $_ ne 'svcnum'
 178              && defined( $new->getfield($svcdb.'__'.$_.'_flag') )
 179            } fields($svcdb)
 180     ) {
 181       my $part_svc_column = $new->part_svc_column($field);
 182       my $previous = qsearchs('part_svc_column', {
 183         'svcpart'    => $new->svcpart,
 184         'columnname' => $field,
 185       } );
 186
 187       my $flag = $new->getfield($svcdb.'__'.$field.'_flag');
 188       if ( uc($flag) =~ /^([DF])$/ ) {
 189         $part_svc_column->setfield('columnflag', $1);
 190         $part_svc_column->setfield('columnvalue',
 191           $new->getfield($svcdb.'__'.$field)
 192         );
 193         if ( $previous ) {
 194           $error = $part_svc_column->replace($previous);
 195         } else {
 196           $error = $part_svc_column->insert;
 197         }
 198       } else {
 199         $error = $previous ? $previous->delete : '';
 200       }
 201       if ( $error ) {
 202         $dbh->rollback if $oldAutoCommit;
 203         return $error;
 204       }
 205     }
 206   } else {
 207     $dbh->rollback if $oldAutoCommit;
 208     return 'non-1.3-COMPAT interface not yet written';
 209     #not yet implemented
 210   }
 211
 212   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 213
 214   '';
 215 }
 216
 217 =item check
 218
 219 Checks all fields to make sure this is a valid service definition.  If there is
 220 an error, returns the error, otherwise returns false.  Called by the insert
 221 and replace methods.
 222
 223 =cut
 224
 225 sub check {
 226   my $self = shift;
 227   my $recref = $self->hashref;
 228
 229   my $error;
 230   $error=
 231     $self->ut_numbern('svcpart')
 232     || $self->ut_text('svc')
 233     || $self->ut_alpha('svcdb')
 234     || $self->ut_enum('disabled', [ '', 'Y' ] )
 235   ;
 236   return $error if $error;
 237
 238   my @fields = eval { fields( $recref->{svcdb} ) }; #might die
 239   return "Unknown svcdb!" unless @fields;
 240
 241 ##REPLACED BY part_svc_column
 242 #  my $svcdb;
 243 #  foreach $svcdb ( qw(
 244 #    svc_acct svc_acct_sm svc_domain
 245 #  ) ) {
 246 #    my @rows = map { /^${svcdb}__(.*)$/; $1 }
 247 #      grep ! /_flag$/,
 248 #        grep /^${svcdb}__/,
 249 #          fields('part_svc');
 250 #    foreach my $row (@rows) {
 251 #      unless ( $svcdb eq $recref->{svcdb} ) {
 252 #        $recref->{$svcdb.'__'.$row}='';
 253 #        $recref->{$svcdb.'__'.$row.'_flag'}='';
 254 #        next;
 255 #      }
 256 #      $recref->{$svcdb.'__'.$row.'_flag'} =~ /^([DF]?)$/
 257 #        or return "Illegal flag for $svcdb $row";
 258 #      $recref->{$svcdb.'__'.$row.'_flag'} = $1;
 259 #
 260 #      my $error = $self->ut_anything($svcdb.'__'.$row);
 261 #      return $error if $error;
 262 #
 263 #    }
 264 #  }
 265
 266   ''; #no error
 267 }
 268
 269 =item part_svc_column COLUMNNAME
 270
 271 Returns the part_svc_column object (see L<FS::part_svc_column>) for the given
 272 COLUMNNAME, or a new part_svc_column object if none exists.
 273
 274 =cut
 275
 276 sub part_svc_column {
 277   my $self = shift;
 278   my $columnname = shift;
 279   qsearchs('part_svc_column',  {
 280                                  'svcpart'    => $self->svcpart,
 281                                  'columnname' => $columnname,
 282                                }
 283   ) or new FS::part_svc_column {
 284                                  'svcpart'    => $self->svcpart,
 285                                  'columnname' => $columnname,
 286                                };
 287 }
 288
 289 =item all_part_svc_column
 290
 291 =cut
 292
 293 sub all_part_svc_column {
 294   my $self = shift;
 295   qsearch('part_svc_column', { 'svcpart' => $self->svcpart } );
 296 }
 297
 298 =item part_export
 299
 300 =cut
 301
 302 sub part_export {
 303   my $self = shift;
 304   my %search = ( 'svcpart' => $self->svcpart );
 305   qsearch('part_export', \%search);
 306 }
 307
 308 =back
 309
 310 =head1 VERSION
 311
 312 $Id: part_svc.pm,v 1.10 2002-03-20 21:31:49 ivan Exp $
 313
 314 =head1 BUGS
 315
 316 Delete is unimplemented.
 317
 318 The list of svc_* tables is hardcoded.  When svc_acct_pop is renamed, this
 319 should be fixed.
 320
 321 =head1 SEE ALSO
 322
 323 L<FS::Record>, L<FS::part_svc_column>, L<FS::part_pkg>, L<FS::pkg_svc>,
 324 L<FS::cust_svc>, L<FS::svc_acct>, L<FS::svc_forward>, L<FS::svc_domain>,
 325 schema.html from the base documentation.
 326
 327 =cut
 328
 329 1;
 330