FS/FS/svc_Common.pm

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