FS/FS/part_svc.pm

   1 package FS::part_svc;
   2
   3 use strict;
   4 use vars qw( @ISA $DEBUG );
   5 use FS::Record qw( qsearch qsearchs fields dbh );
   6 use FS::part_svc_column;
   7 use FS::part_export;
   8 use FS::export_svc;
   9 use FS::cust_svc;
  10
  11 @ISA = qw(FS::Record);
  12
  13 $DEBUG = 1;
  14
  15 =head1 NAME
  16
  17 FS::part_svc - Object methods for part_svc objects
  18
  19 =head1 SYNOPSIS
  20
  21   use FS::part_svc;
  22
  23   $record = new FS::part_svc \%hash
  24   $record = new FS::part_svc { 'column' => 'value' };
  25
  26   $error = $record->insert;
  27   $error = $record->insert( [ 'pseudofield' ] );
  28   $error = $record->insert( [ 'pseudofield' ], \%exportnums );
  29
  30   $error = $new_record->replace($old_record);
  31   $error = $new_record->replace($old_record, '1.3-COMPAT', [ 'pseudofield' ] );
  32   $error = $new_record->replace($old_record, '1.3-COMPAT', [ 'pseudofield' ], \%exportnums );
  33
  34   $error = $record->delete;
  35
  36   $error = $record->check;
  37
  38 =head1 DESCRIPTION
  39
  40 An FS::part_svc represents a service definition.  FS::part_svc inherits from
  41 FS::Record.  The following fields are currently supported:
  42
  43 =over 4
  44
  45 =item svcpart - primary key (assigned automatically for new service definitions)
  46
  47 =item svc - text name of this service definition
  48
  49 =item svcdb - table used for this service.  See L<FS::svc_acct>,
  50 L<FS::svc_domain>, and L<FS::svc_forward>, among others.
  51
  52 =item disabled - Disabled flag, empty or `Y'
  53
  54 =back
  55
  56 =head1 METHODS
  57
  58 =over 4
  59
  60 =item new HASHREF
  61
  62 Creates a new service definition.  To add the service definition to the
  63 database, see L<"insert">.
  64
  65 =cut
  66
  67 sub table { 'part_svc'; }
  68
  69 =item insert [ EXTRA_FIELDS_ARRAYREF [ , EXPORTNUMS_HASHREF [ , JOB ] ] ]
  70
  71 Adds this service definition to the database.  If there is an error, returns
  72 the error, otherwise returns false.
  73
  74 The following pseudo-fields may be defined, and will be maintained in
  75 the part_svc_column table appropriately (see L<FS::part_svc_column>).
  76
  77 =over 4
  78
  79 =item I<svcdb>__I<field> - Default or fixed value for I<field> in I<svcdb>.
  80
  81 =item I<svcdb>__I<field>_flag - defines I<svcdb>__I<field> action: null, `D' for default, or `F' for fixed.  For virtual fields, can also be 'X' for excluded.
  82
  83 =back
  84
  85 If you want to add part_svc_column records for fields that do not exist as
  86 (real or virtual) fields in the I<svcdb> table, make sure to list then in
  87 EXTRA_FIELDS_ARRAYREF also.
  88
  89 If EXPORTNUMS_HASHREF is specified (keys are exportnums and values are
  90 boolean), the appopriate export_svc records will be inserted.
  91
  92 TODOC: JOB
  93
  94 =cut
  95
  96 sub insert {
  97   my $self = shift;
  98   my @fields = ();
  99   my @exportnums = ();
 100   @fields = @{shift(@_)} if @_;
 101   if ( @_ ) {
 102     my $exportnums = shift;
 103     @exportnums = grep $exportnums->{$_}, keys %$exportnums;
 104   }
 105   my $job = '';
 106   $job = shift if @_;
 107
 108   local $SIG{HUP} = 'IGNORE';
 109   local $SIG{INT} = 'IGNORE';
 110   local $SIG{QUIT} = 'IGNORE';
 111   local $SIG{TERM} = 'IGNORE';
 112   local $SIG{TSTP} = 'IGNORE';
 113   local $SIG{PIPE} = 'IGNORE';
 114
 115   my $oldAutoCommit = $FS::UID::AutoCommit;
 116   local $FS::UID::AutoCommit = 0;
 117   my $dbh = dbh;
 118
 119   my $error = $self->SUPER::insert;
 120   if ( $error ) {
 121     $dbh->rollback if $oldAutoCommit;
 122     return $error;
 123   }
 124
 125   # add part_svc_column records
 126
 127   my $svcdb = $self->svcdb;
 128 #  my @rows = map { /^${svcdb}__(.*)$/; $1 }
 129 #    grep ! /_flag$/,
 130 #      grep /^${svcdb}__/,
 131 #        fields('part_svc');
 132   foreach my $field (
 133     grep { $_ ne 'svcnum'
 134            && defined( $self->getfield($svcdb.'__'.$_.'_flag') )
 135          } (fields($svcdb), @fields)
 136   ) {
 137     my $part_svc_column = $self->part_svc_column($field);
 138     my $previous = qsearchs('part_svc_column', {
 139       'svcpart'    => $self->svcpart,
 140       'columnname' => $field,
 141     } );
 142
 143     my $flag = $self->getfield($svcdb.'__'.$field.'_flag');
 144     if ( uc($flag) =~ /^([DFX])$/ ) {
 145       $part_svc_column->setfield('columnflag', $1);
 146       $part_svc_column->setfield('columnvalue',
 147         $self->getfield($svcdb.'__'.$field)
 148       );
 149       if ( $previous ) {
 150         $error = $part_svc_column->replace($previous);
 151       } else {
 152         $error = $part_svc_column->insert;
 153       }
 154     } else {
 155       $error = $previous ? $previous->delete : '';
 156     }
 157     if ( $error ) {
 158       $dbh->rollback if $oldAutoCommit;
 159       return $error;
 160     }
 161
 162   }
 163
 164   # add export_svc records
 165   my $slice = 100/scalar(@exportnums) if @exportnums;
 166   my $done = 0;
 167   foreach my $exportnum ( @exportnums ) {
 168     my $export_svc = new FS::export_svc ( {
 169       'exportnum' => $exportnum,
 170       'svcpart'   => $self->svcpart,
 171     } );
 172     $error = $export_svc->insert($job, $slice*$done++, $slice);
 173     if ( $error ) {
 174       $dbh->rollback if $oldAutoCommit;
 175       return $error;
 176     }
 177   }
 178
 179   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 180
 181   '';
 182 }
 183
 184 =item delete
 185
 186 Currently unimplemented.  Set the "disabled" field instead.
 187
 188 =cut
 189
 190 sub delete {
 191   return "Can't (yet?) delete service definitions.";
 192 # check & make sure the svcpart isn't in cust_svc or pkg_svc (in any packages)?
 193 }
 194
 195 =item replace OLD_RECORD [ '1.3-COMPAT' [ , EXTRA_FIELDS_ARRAYREF [ , EXPORTNUMS_HASHREF [ , JOB ] ] ] ]
 196
 197 Replaces OLD_RECORD with this one in the database.  If there is an error,
 198 returns the error, otherwise returns false.
 199
 200 TODOC: 1.3-COMPAT
 201
 202 TODOC: EXTRA_FIELDS_ARRAYREF (same as insert method)
 203
 204 TODOC: JOB
 205
 206 =cut
 207
 208 sub replace {
 209   my ( $new, $old ) = ( shift, shift );
 210   my $compat = '';
 211   my @fields = ();
 212   my $exportnums;
 213   my $job = '';
 214   if ( @_ && $_[0] eq '1.3-COMPAT' ) {
 215     shift;
 216     $compat = '1.3';
 217     @fields = @{shift(@_)} if @_;
 218     $exportnums = @_ ? shift : '';
 219     $job = shift if @_;
 220   } else {
 221     return 'non-1.3-COMPAT interface not yet written';
 222     #not yet implemented
 223   }
 224
 225   return "Can't change svcdb for an existing service definition!"
 226     unless $old->svcdb eq $new->svcdb;
 227
 228   local $SIG{HUP} = 'IGNORE';
 229   local $SIG{INT} = 'IGNORE';
 230   local $SIG{QUIT} = 'IGNORE';
 231   local $SIG{TERM} = 'IGNORE';
 232   local $SIG{TSTP} = 'IGNORE';
 233   local $SIG{PIPE} = 'IGNORE';
 234
 235   my $oldAutoCommit = $FS::UID::AutoCommit;
 236   local $FS::UID::AutoCommit = 0;
 237   my $dbh = dbh;
 238
 239   my $error = $new->SUPER::replace( $old );
 240   if ( $error ) {
 241     $dbh->rollback if $oldAutoCommit;
 242     return $error;
 243   }
 244
 245   if ( $compat eq '1.3' ) {
 246
 247    # maintain part_svc_column records
 248
 249     my $svcdb = $new->svcdb;
 250     foreach my $field (
 251       grep { $_ ne 'svcnum'
 252              && defined( $new->getfield($svcdb.'__'.$_.'_flag') )
 253            } (fields($svcdb),@fields)
 254     ) {
 255       my $part_svc_column = $new->part_svc_column($field);
 256       my $previous = qsearchs('part_svc_column', {
 257         'svcpart'    => $new->svcpart,
 258         'columnname' => $field,
 259       } );
 260
 261       my $flag = $new->getfield($svcdb.'__'.$field.'_flag');
 262       if ( uc($flag) =~ /^([DFX])$/ ) {
 263         $part_svc_column->setfield('columnflag', $1);
 264         $part_svc_column->setfield('columnvalue',
 265           $new->getfield($svcdb.'__'.$field)
 266         );
 267         if ( $previous ) {
 268           $error = $part_svc_column->replace($previous);
 269         } else {
 270           $error = $part_svc_column->insert;
 271         }
 272       } else {
 273         $error = $previous ? $previous->delete : '';
 274       }
 275       if ( $error ) {
 276         $dbh->rollback if $oldAutoCommit;
 277         return $error;
 278       }
 279     }
 280
 281     # maintain export_svc records
 282
 283     if ( $exportnums ) {
 284
 285       #false laziness w/ edit/process/agent_type.cgi
 286       my @new_export_svc = ();
 287       foreach my $part_export ( qsearch('part_export', {}) ) {
 288         my $exportnum = $part_export->exportnum;
 289         my $hashref = {
 290           'exportnum' => $exportnum,
 291           'svcpart'   => $new->svcpart,
 292         };
 293         my $export_svc = qsearchs('export_svc', $hashref);
 294
 295         if ( $export_svc && ! $exportnums->{$exportnum} ) {
 296           $error = $export_svc->delete;
 297           if ( $error ) {
 298             $dbh->rollback if $oldAutoCommit;
 299             return $error;
 300           }
 301         } elsif ( ! $export_svc && $exportnums->{$exportnum} ) {
 302           push @new_export_svc, new FS::export_svc ( $hashref );
 303         }
 304
 305       }
 306
 307       my $slice = 100/scalar(@new_export_svc) if @new_export_svc;
 308       my $done = 0;
 309       foreach my $export_svc (@new_export_svc) {
 310         $error = $export_svc->insert($job, $slice*$done++, $slice);
 311         if ( $error ) {
 312           $dbh->rollback if $oldAutoCommit;
 313           return $error;
 314         }
 315         if ( $job ) {
 316           $error = $job->update_statustext( int( $slice * $done ) );
 317           if ( $error ) {
 318             $dbh->rollback if $oldAutoCommit;
 319             return $error;
 320           }
 321         }
 322       }
 323
 324     }
 325
 326   } else {
 327     $dbh->rollback if $oldAutoCommit;
 328     return 'non-1.3-COMPAT interface not yet written';
 329     #not yet implemented
 330   }
 331
 332   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 333
 334   '';
 335 }
 336
 337 =item check
 338
 339 Checks all fields to make sure this is a valid service definition.  If there is
 340 an error, returns the error, otherwise returns false.  Called by the insert
 341 and replace methods.
 342
 343 =cut
 344
 345 sub check {
 346   my $self = shift;
 347   my $recref = $self->hashref;
 348
 349   my $error;
 350   $error=
 351     $self->ut_numbern('svcpart')
 352     || $self->ut_text('svc')
 353     || $self->ut_alpha('svcdb')
 354     || $self->ut_enum('disabled', [ '', 'Y' ] )
 355   ;
 356   return $error if $error;
 357
 358   my @fields = eval { fields( $recref->{svcdb} ) }; #might die
 359   return "Unknown svcdb!" unless @fields;
 360
 361   $self->SUPER::check;
 362 }
 363
 364 =item part_svc_column COLUMNNAME
 365
 366 Returns the part_svc_column object (see L<FS::part_svc_column>) for the given
 367 COLUMNNAME, or a new part_svc_column object if none exists.
 368
 369 =cut
 370
 371 sub part_svc_column {
 372   my( $self, $columnname) = @_;
 373   $self->svcpart &&
 374     qsearchs('part_svc_column',  {
 375                                    'svcpart'    => $self->svcpart,
 376                                    'columnname' => $columnname,
 377                                  }
 378   ) or new FS::part_svc_column {
 379                                  'svcpart'    => $self->svcpart,
 380                                  'columnname' => $columnname,
 381                                };
 382 }
 383
 384 =item all_part_svc_column
 385
 386 =cut
 387
 388 sub all_part_svc_column {
 389   my $self = shift;
 390   qsearch('part_svc_column', { 'svcpart' => $self->svcpart } );
 391 }
 392
 393 =item part_export [ EXPORTTYPE ]
 394
 395 Returns all exports (see L<FS::part_export>) for this service, or, if an
 396 export type is specified, only returns exports of the given type.
 397
 398 =cut
 399
 400 sub part_export {
 401   my $self = shift;
 402   my %search;
 403   $search{'exporttype'} = shift if @_;
 404   map { qsearchs('part_export', { 'exportnum' => $_->exportnum, %search } ) }
 405     qsearch('export_svc', { 'svcpart' => $self->svcpart } );
 406 }
 407
 408 =item cust_svc
 409
 410 Returns a list of associated FS::cust_svc records.
 411
 412 =cut
 413
 414 sub cust_svc {
 415   my $self = shift;
 416   qsearch('cust_svc', { 'svcpart' => $self->svcpart } );
 417 }
 418
 419 =item svc_x
 420
 421 Returns a list of associated FS::svc_* records.
 422
 423 =cut
 424
 425 sub svc_x {
 426   my $self = shift;
 427   map { $_->svc_x } $self->cust_svc;
 428 }
 429
 430 =back
 431
 432 =head1 SUBROUTINES
 433
 434 =over 4
 435
 436 =item process
 437
 438 Experimental job-queue processor for web interface adds/edits
 439
 440 =cut
 441
 442 use Storable qw(thaw);
 443 use Data::Dumper;
 444 use MIME::Base64;
 445 sub process {
 446   my $job = shift;
 447
 448   my $param = thaw(decode_base64(shift));
 449   warn Dumper($param) if $DEBUG;
 450
 451   my $old = qsearchs('part_svc', { 'svcpart' => $param->{'svcpart'} })
 452     if $param->{'svcpart'};
 453
 454   $param->{'svc_acct__usergroup'} =
 455     ref($param->{'svc_acct__usergroup'})
 456       ? join(',', @{$param->{'svc_acct__usergroup'}} )
 457       : '';
 458
 459   my $new = new FS::part_svc ( {
 460     map {
 461       $_ => $param->{$_};
 462   #  } qw(svcpart svc svcdb)
 463     } ( fields('part_svc'),
 464         map { my $svcdb = $_;
 465               my @fields = fields($svcdb);
 466               push @fields, 'usergroup' if $svcdb eq 'svc_acct'; #kludge
 467               map { ( $svcdb.'__'.$_, $svcdb.'__'.$_.'_flag' )  } @fields;
 468             } grep defined( $FS::Record::dbdef->table($_) ),
 469                    qw( svc_acct svc_domain svc_forward svc_www svc_broadband )
 470       )
 471   } );
 472
 473   my %exportnums =
 474     map { $_->exportnum => ( $param->{'exportnum'.$_->exportnum} || '') }
 475         qsearch('part_export', {} );
 476
 477   my $error;
 478   if ( $param->{'svcpart'} ) {
 479     $error = $new->replace( $old,
 480                             '1.3-COMPAT',
 481                             [ 'usergroup' ],
 482                             \%exportnums,
 483                             $job
 484                           );
 485   } else {
 486     $error = $new->insert( [ 'usergroup' ],
 487                            \%exportnums,
 488                            $job,
 489                          );
 490     $param->{'svcpart'} = $new->getfield('svcpart');
 491   }
 492
 493   die $error if $error;
 494 }
 495
 496 =head1 BUGS
 497
 498 Delete is unimplemented.
 499
 500 The list of svc_* tables is hardcoded.  When svc_acct_pop is renamed, this
 501 should be fixed.
 502
 503 all_part_svc_column method should be documented
 504
 505 =head1 SEE ALSO
 506
 507 L<FS::Record>, L<FS::part_svc_column>, L<FS::part_pkg>, L<FS::pkg_svc>,
 508 L<FS::cust_svc>, L<FS::svc_acct>, L<FS::svc_forward>, L<FS::svc_domain>,
 509 schema.html from the base documentation.
 510
 511 =cut
 512
 513 1;
 514