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