FS/FS/svc_Common.pm

   1 package FS::svc_Common;
   2
   3 use strict;
   4 use vars qw( @ISA $noexport_hack $DEBUG );
   5 use FS::Record qw( qsearch qsearchs fields dbh );
   6 use FS::cust_svc;
   7 use FS::part_svc;
   8 use FS::queue;
   9
  10 @ISA = qw( FS::Record );
  11
  12 $DEBUG = 0;
  13 #$DEBUG = 1;
  14
  15 =head1 NAME
  16
  17 FS::svc_Common - Object method for all svc_ records
  18
  19 =head1 SYNOPSIS
  20
  21 use FS::svc_Common;
  22
  23 @ISA = qw( FS::svc_Common );
  24
  25 =head1 DESCRIPTION
  26
  27 FS::svc_Common is intended as a base class for table-specific classes to
  28 inherit from, i.e. FS::svc_acct.  FS::svc_Common inherits from FS::Record.
  29
  30 =head1 METHODS
  31
  32 =over 4
  33
  34 =cut
  35
  36 sub virtual_fields {
  37
  38   # This restricts the fields based on part_svc_column and the svcpart of
  39   # the service.  There are four possible cases:
  40   # 1.  svcpart passed as part of the svc_x hash.
  41   # 2.  svcpart fetched via cust_svc based on svcnum.
  42   # 3.  No svcnum or svcpart.  In this case, return ALL the fields with
  43   #     dbtable eq $self->table.
  44   # 4.  Called via "fields('svc_acct')" or something similar.  In this case
  45   #     there is no $self object.
  46
  47   my $self = shift;
  48   my $svcpart;
  49   my @vfields = $self->SUPER::virtual_fields;
  50
  51   return @vfields unless (ref $self); # Case 4
  52
  53   if ($self->svcpart) { # Case 1
  54     $svcpart = $self->svcpart;
  55   } elsif ( $self->svcnum
  56             && qsearchs('cust_svc',{'svcnum'=>$self->svcnum} )
  57           ) { #Case 2
  58     $svcpart = $self->cust_svc->svcpart;
  59   } else { # Case 3
  60     $svcpart = '';
  61   }
  62
  63   if ($svcpart) { #Cases 1 and 2
  64     my %flags = map { $_->columnname, $_->columnflag } (
  65         qsearch ('part_svc_column', { svcpart => $svcpart } )
  66       );
  67     return grep { not ($flags{$_} eq 'X') } @vfields;
  68   } else { # Case 3
  69     return @vfields;
  70   }
  71   return ();
  72 }
  73
  74 =item check
  75
  76 Checks the validity of fields in this record.
  77
  78 At present, this does nothing but call FS::Record::check (which, in turn,
  79 does nothing but run virtual field checks).
  80
  81 =cut
  82
  83 sub check {
  84   my $self = shift;
  85   $self->SUPER::check;
  86 }
  87
  88 =item insert [ , OPTION => VALUE ... ]
  89
  90 Adds this record to the database.  If there is an error, returns the error,
  91 otherwise returns false.
  92
  93 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
  94 defined.  An FS::cust_svc record will be created and inserted.
  95
  96 Currently available options are: I<jobnums>, I<child_objects> and
  97 I<depend_jobnum>.
  98
  99 If I<jobnum> is set to an array reference, the jobnums of any export jobs will
 100 be added to the referenced array.
 101
 102 If I<child_objects> is set to an array reference of FS::tablename objects (for
 103 example, FS::acct_snarf objects), they will have their svcnum field set and
 104 will be inserted after this record, but before any exports are run.  Each
 105 element of the array can also optionally be a two-element array reference
 106 containing the child object and the name of an alternate field to be filled in
 107 with the newly-inserted svcnum, for example C<[ $svc_forward, 'srcsvc' ]>
 108
 109 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
 110 jobnums), all provisioning jobs will have a dependancy on the supplied
 111 jobnum(s) (they will not run until the specific job(s) complete(s)).
 112
 113 =cut
 114
 115 sub insert {
 116   my $self = shift;
 117   my %options = @_;
 118   warn "FS::svc_Common::insert called with options ".
 119      join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 120   if $DEBUG;
 121
 122   my @jobnums = ();
 123   local $FS::queue::jobnums = \@jobnums;
 124   warn "FS::svc_Common::insert: set \$FS::queue::jobnums to $FS::queue::jobnums"
 125     if $DEBUG;
 126   my $objects = $options{'child_objects'} || [];
 127   my $depend_jobnums = $options{'depend_jobnum'} || [];
 128   $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
 129   my $error;
 130
 131   local $SIG{HUP} = 'IGNORE';
 132   local $SIG{INT} = 'IGNORE';
 133   local $SIG{QUIT} = 'IGNORE';
 134   local $SIG{TERM} = 'IGNORE';
 135   local $SIG{TSTP} = 'IGNORE';
 136   local $SIG{PIPE} = 'IGNORE';
 137
 138   my $oldAutoCommit = $FS::UID::AutoCommit;
 139   local $FS::UID::AutoCommit = 0;
 140   my $dbh = dbh;
 141
 142   $error = $self->check;
 143   return $error if $error;
 144
 145   my $svcnum = $self->svcnum;
 146   my $cust_svc = $svcnum ? qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) : '';
 147   #unless ( $svcnum ) {
 148   if ( !$svcnum or !$cust_svc ) {
 149     $cust_svc = new FS::cust_svc ( {
 150       #hua?# 'svcnum'  => $svcnum,
 151       'svcnum'  => $self->svcnum,
 152       'pkgnum'  => $self->pkgnum,
 153       'svcpart' => $self->svcpart,
 154     } );
 155     $error = $cust_svc->insert;
 156     if ( $error ) {
 157       $dbh->rollback if $oldAutoCommit;
 158       return $error;
 159     }
 160     $svcnum = $self->svcnum($cust_svc->svcnum);
 161   } else {
 162     #$cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
 163     unless ( $cust_svc ) {
 164       $dbh->rollback if $oldAutoCommit;
 165       return "no cust_svc record found for svcnum ". $self->svcnum;
 166     }
 167     $self->pkgnum($cust_svc->pkgnum);
 168     $self->svcpart($cust_svc->svcpart);
 169   }
 170
 171   $error = $self->SUPER::insert;
 172   if ( $error ) {
 173     $dbh->rollback if $oldAutoCommit;
 174     return $error;
 175   }
 176
 177   foreach my $object ( @$objects ) {
 178     my($field, $obj);
 179     if ( ref($object) eq 'ARRAY' ) {
 180       ($obj, $field) = @$object;
 181     } else {
 182       $obj = $object;
 183       $field = 'svcnum';
 184     }
 185     $obj->$field($self->svcnum);
 186     $error = $obj->insert;
 187     if ( $error ) {
 188       $dbh->rollback if $oldAutoCommit;
 189       return $error;
 190     }
 191   }
 192
 193   #new-style exports!
 194   unless ( $noexport_hack ) {
 195
 196     warn "FS::svc_Common::insert: \$FS::queue::jobnums is $FS::queue::jobnums"
 197       if $DEBUG;
 198
 199     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 200       my $error = $part_export->export_insert($self);
 201       if ( $error ) {
 202         $dbh->rollback if $oldAutoCommit;
 203         return "exporting to ". $part_export->exporttype.
 204                " (transaction rolled back): $error";
 205       }
 206     }
 207
 208     foreach my $depend_jobnum ( @$depend_jobnums ) {
 209       warn "inserting dependancies on supplied job $depend_jobnum\n"
 210         if $DEBUG;
 211       foreach my $jobnum ( @jobnums ) {
 212         my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
 213         warn "inserting dependancy for job $jobnum on $depend_jobnum\n"
 214           if $DEBUG;
 215         my $error = $queue->depend_insert($depend_jobnum);
 216         if ( $error ) {
 217           $dbh->rollback if $oldAutoCommit;
 218           return "error queuing job dependancy: $error";
 219         }
 220       }
 221     }
 222
 223   }
 224
 225   if ( exists $options{'jobnums'} ) {
 226     push @{ $options{'jobnums'} }, @jobnums;
 227   }
 228
 229   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 230
 231   '';
 232 }
 233
 234 =item delete
 235
 236 Deletes this account from the database.  If there is an error, returns the
 237 error, otherwise returns false.
 238
 239 The corresponding FS::cust_svc record will be deleted as well.
 240
 241 =cut
 242
 243 sub delete {
 244   my $self = shift;
 245   my $error;
 246
 247   local $SIG{HUP} = 'IGNORE';
 248   local $SIG{INT} = 'IGNORE';
 249   local $SIG{QUIT} = 'IGNORE';
 250   local $SIG{TERM} = 'IGNORE';
 251   local $SIG{TSTP} = 'IGNORE';
 252   local $SIG{PIPE} = 'IGNORE';
 253
 254   my $svcnum = $self->svcnum;
 255
 256   my $oldAutoCommit = $FS::UID::AutoCommit;
 257   local $FS::UID::AutoCommit = 0;
 258   my $dbh = dbh;
 259
 260   $error = $self->SUPER::delete;
 261   return $error if $error;
 262
 263   #new-style exports!
 264   unless ( $noexport_hack ) {
 265     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 266       my $error = $part_export->export_delete($self);
 267       if ( $error ) {
 268         $dbh->rollback if $oldAutoCommit;
 269         return "exporting to ". $part_export->exporttype.
 270                " (transaction rolled back): $error";
 271       }
 272     }
 273   }
 274
 275   return $error if $error;
 276
 277   my $cust_svc = $self->cust_svc;
 278   $error = $cust_svc->delete;
 279   return $error if $error;
 280
 281   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 282
 283   '';
 284 }
 285
 286 =item replace OLD_RECORD
 287
 288 Replaces OLD_RECORD with this one.  If there is an error, returns the error,
 289 otherwise returns false.
 290
 291 =cut
 292
 293 sub replace {
 294   my ($new, $old) = (shift, shift);
 295
 296   local $SIG{HUP} = 'IGNORE';
 297   local $SIG{INT} = 'IGNORE';
 298   local $SIG{QUIT} = 'IGNORE';
 299   local $SIG{TERM} = 'IGNORE';
 300   local $SIG{TSTP} = 'IGNORE';
 301   local $SIG{PIPE} = 'IGNORE';
 302
 303   my $oldAutoCommit = $FS::UID::AutoCommit;
 304   local $FS::UID::AutoCommit = 0;
 305   my $dbh = dbh;
 306
 307   my $error = $new->SUPER::replace($old);
 308   if ($error) {
 309     $dbh->rollback if $oldAutoCommit;
 310     return $error;
 311   }
 312
 313   #new-style exports!
 314   unless ( $noexport_hack ) {
 315
 316     #not quite false laziness, but same pattern as FS::svc_acct::replace and
 317     #FS::part_export::sqlradius::_export_replace.  List::Compare or something
 318     #would be useful but too much of a pain in the ass to deploy
 319
 320     my @old_part_export = $old->cust_svc->part_svc->part_export;
 321     my %old_exportnum = map { $_->exportnum => 1 } @old_part_export;
 322     my @new_part_export =
 323       $new->svcpart
 324         ? qsearchs('part_svc', { svcpart=>$new->svcpart } )->part_export
 325         : $new->cust_svc->part_svc->part_export;
 326     my %new_exportnum = map { $_->exportnum => 1 } @new_part_export;
 327
 328     foreach my $delete_part_export (
 329       grep { ! $new_exportnum{$_->exportnum} } @old_part_export
 330     ) {
 331       my $error = $delete_part_export->export_delete($old);
 332       if ( $error ) {
 333         $dbh->rollback if $oldAutoCommit;
 334         return "error deleting, export to ". $delete_part_export->exporttype.
 335                " (transaction rolled back): $error";
 336       }
 337     }
 338
 339     foreach my $replace_part_export (
 340       grep { $old_exportnum{$_->exportnum} } @new_part_export
 341     ) {
 342       my $error = $replace_part_export->export_replace($new,$old);
 343       if ( $error ) {
 344         $dbh->rollback if $oldAutoCommit;
 345         return "error exporting to ". $replace_part_export->exporttype.
 346                " (transaction rolled back): $error";
 347       }
 348     }
 349
 350     foreach my $insert_part_export (
 351       grep { ! $old_exportnum{$_->exportnum} } @new_part_export
 352     ) {
 353       my $error = $insert_part_export->export_insert($new);
 354       if ( $error ) {
 355         $dbh->rollback if $oldAutoCommit;
 356         return "error inserting export to ". $insert_part_export->exporttype.
 357                " (transaction rolled back): $error";
 358       }
 359     }
 360
 361   }
 362
 363   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 364   '';
 365 }
 366
 367
 368 =item setfixed
 369
 370 Sets any fixed fields for this service (see L<FS::part_svc>).  If there is an
 371 error, returns the error, otherwise returns the FS::part_svc object (use ref()
 372 to test the return).  Usually called by the check method.
 373
 374 =cut
 375
 376 sub setfixed {
 377   my $self = shift;
 378   $self->setx('F');
 379 }
 380
 381 =item setdefault
 382
 383 Sets all fields to their defaults (see L<FS::part_svc>), overriding their
 384 current values.  If there is an error, returns the error, otherwise returns
 385 the FS::part_svc object (use ref() to test the return).
 386
 387 =cut
 388
 389 sub setdefault {
 390   my $self = shift;
 391   $self->setx('D');
 392 }
 393
 394 sub setx {
 395   my $self = shift;
 396   my $x = shift;
 397
 398   my $error;
 399
 400   $error =
 401     $self->ut_numbern('svcnum')
 402   ;
 403   return $error if $error;
 404
 405   #get part_svc
 406   my $svcpart;
 407   if ( $self->get('svcpart') ) {
 408     $svcpart = $self->get('svcpart');
 409   } elsif ( $self->svcnum && qsearchs('cust_svc', {'svcnum'=>$self->svcnum}) ) {
 410     my $cust_svc = $self->cust_svc;
 411     return "Unknown svcnum" unless $cust_svc;
 412     $svcpart = $cust_svc->svcpart;
 413   }
 414   my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
 415   return "Unkonwn svcpart" unless $part_svc;
 416
 417   #set default/fixed/whatever fields from part_svc
 418   my $table = $self->table;
 419   foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
 420     my $part_svc_column = $part_svc->part_svc_column($field);
 421     if ( $part_svc_column->columnflag eq $x ) {
 422       $self->setfield( $field, $part_svc_column->columnvalue );
 423     }
 424   }
 425
 426  $part_svc;
 427
 428 }
 429
 430 =item cust_svc
 431
 432 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
 433 object (see L<FS::cust_svc>).
 434
 435 =cut
 436
 437 sub cust_svc {
 438   my $self = shift;
 439   qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
 440 }
 441
 442 =item suspend
 443
 444 Runs export_suspend callbacks.
 445
 446 =cut
 447
 448 sub suspend {
 449   my $self = shift;
 450
 451   local $SIG{HUP} = 'IGNORE';
 452   local $SIG{INT} = 'IGNORE';
 453   local $SIG{QUIT} = 'IGNORE';
 454   local $SIG{TERM} = 'IGNORE';
 455   local $SIG{TSTP} = 'IGNORE';
 456   local $SIG{PIPE} = 'IGNORE';
 457
 458   my $oldAutoCommit = $FS::UID::AutoCommit;
 459   local $FS::UID::AutoCommit = 0;
 460   my $dbh = dbh;
 461
 462   #new-style exports!
 463   unless ( $noexport_hack ) {
 464     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 465       my $error = $part_export->export_suspend($self);
 466       if ( $error ) {
 467         $dbh->rollback if $oldAutoCommit;
 468         return "error exporting to ". $part_export->exporttype.
 469                " (transaction rolled back): $error";
 470       }
 471     }
 472   }
 473
 474   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 475   '';
 476
 477 }
 478
 479 =item unsuspend
 480
 481 Runs export_unsuspend callbacks.
 482
 483 =cut
 484
 485 sub unsuspend {
 486   my $self = shift;
 487
 488   local $SIG{HUP} = 'IGNORE';
 489   local $SIG{INT} = 'IGNORE';
 490   local $SIG{QUIT} = 'IGNORE';
 491   local $SIG{TERM} = 'IGNORE';
 492   local $SIG{TSTP} = 'IGNORE';
 493   local $SIG{PIPE} = 'IGNORE';
 494
 495   my $oldAutoCommit = $FS::UID::AutoCommit;
 496   local $FS::UID::AutoCommit = 0;
 497   my $dbh = dbh;
 498
 499   #new-style exports!
 500   unless ( $noexport_hack ) {
 501     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 502       my $error = $part_export->export_unsuspend($self);
 503       if ( $error ) {
 504         $dbh->rollback if $oldAutoCommit;
 505         return "error exporting to ". $part_export->exporttype.
 506                " (transaction rolled back): $error";
 507       }
 508     }
 509   }
 510
 511   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 512   '';
 513
 514 }
 515
 516 =item cancel
 517
 518 Stub - returns false (no error) so derived classes don't need to define these
 519 methods.  Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 520
 521 =cut
 522
 523 sub cancel { ''; }
 524
 525 =item clone_suspended
 526
 527 Constructor used by FS::part_export::_export_suspend fallback.  Stub returning
 528 same object for svc_ classes which don't implement a suspension fallback
 529 (everything except svc_acct at the moment).  Document better.
 530
 531 =cut
 532
 533 sub clone_suspended {
 534   shift;
 535 }
 536
 537 =item clone_kludge_unsuspend
 538
 539 Constructor used by FS::part_export::_export_unsuspend fallback.  Stub returning
 540 same object for svc_ classes which don't implement a suspension fallback
 541 (everything except svc_acct at the moment).  Document better.
 542
 543 =cut
 544
 545 sub clone_kludge_unsuspend {
 546   shift;
 547 }
 548
 549 =back
 550
 551 =head1 BUGS
 552
 553 The setfixed method return value.
 554
 555 =head1 SEE ALSO
 556
 557 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
 558 from the base documentation.
 559
 560 =cut
 561
 562 1;
 563