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