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