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 fieldsset and
 104 will be inserted after this record, but before any exports are run.
 105
 106 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
 107 jobnums), all provisioning jobs will have a dependancy on the supplied
 108 jobnum(s) (they will not run until the specific job(s) complete(s)).
 109
 110 =cut
 111
 112 sub insert {
 113   my $self = shift;
 114   my %options = @_;
 115   warn "FS::svc_Common::insert called with options ".
 116      join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 117   if $DEBUG;
 118
 119   my @jobnums = ();
 120   local $FS::queue::jobnums = \@jobnums;
 121   warn "FS::svc_Common::insert: set \$FS::queue::jobnums to $FS::queue::jobnums"
 122     if $DEBUG;
 123   my $objects = $options{'child_objects'} || [];
 124   my $depend_jobnums = $options{'depend_jobnum'} || [];
 125   $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
 126   my $error;
 127
 128   local $SIG{HUP} = 'IGNORE';
 129   local $SIG{INT} = 'IGNORE';
 130   local $SIG{QUIT} = 'IGNORE';
 131   local $SIG{TERM} = 'IGNORE';
 132   local $SIG{TSTP} = 'IGNORE';
 133   local $SIG{PIPE} = 'IGNORE';
 134
 135   my $oldAutoCommit = $FS::UID::AutoCommit;
 136   local $FS::UID::AutoCommit = 0;
 137   my $dbh = dbh;
 138
 139   $error = $self->check;
 140   return $error if $error;
 141
 142   my $svcnum = $self->svcnum;
 143   my $cust_svc = $svcnum ? qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) : '';
 144   #unless ( $svcnum ) {
 145   if ( !$svcnum or !$cust_svc ) {
 146     $cust_svc = new FS::cust_svc ( {
 147       #hua?# 'svcnum'  => $svcnum,
 148       'svcnum'  => $self->svcnum,
 149       'pkgnum'  => $self->pkgnum,
 150       'svcpart' => $self->svcpart,
 151     } );
 152     $error = $cust_svc->insert;
 153     if ( $error ) {
 154       $dbh->rollback if $oldAutoCommit;
 155       return $error;
 156     }
 157     $svcnum = $self->svcnum($cust_svc->svcnum);
 158   } else {
 159     #$cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
 160     unless ( $cust_svc ) {
 161       $dbh->rollback if $oldAutoCommit;
 162       return "no cust_svc record found for svcnum ". $self->svcnum;
 163     }
 164     $self->pkgnum($cust_svc->pkgnum);
 165     $self->svcpart($cust_svc->svcpart);
 166   }
 167
 168   $error = $self->SUPER::insert;
 169   if ( $error ) {
 170     $dbh->rollback if $oldAutoCommit;
 171     return $error;
 172   }
 173
 174   foreach my $object ( @$objects ) {
 175     $object->svcnum($self->svcnum);
 176     $error = $object->insert;
 177     if ( $error ) {
 178       $dbh->rollback if $oldAutoCommit;
 179       return $error;
 180     }
 181   }
 182
 183   #new-style exports!
 184   unless ( $noexport_hack ) {
 185
 186     warn "FS::svc_Common::insert: \$FS::queue::jobnums is $FS::queue::jobnums"
 187       if $DEBUG;
 188
 189     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 190       my $error = $part_export->export_insert($self);
 191       if ( $error ) {
 192         $dbh->rollback if $oldAutoCommit;
 193         return "exporting to ". $part_export->exporttype.
 194                " (transaction rolled back): $error";
 195       }
 196     }
 197
 198     foreach my $depend_jobnum ( @$depend_jobnums ) {
 199       warn "inserting dependancies on supplied job $depend_jobnum\n"
 200         if $DEBUG;
 201       foreach my $jobnum ( @jobnums ) {
 202         my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
 203         warn "inserting dependancy for job $jobnum on $depend_jobnum\n"
 204           if $DEBUG;
 205         my $error = $queue->depend_insert($depend_jobnum);
 206         if ( $error ) {
 207           $dbh->rollback if $oldAutoCommit;
 208           return "error queuing job dependancy: $error";
 209         }
 210       }
 211     }
 212
 213   }
 214
 215   if ( exists $options{'jobnums'} ) {
 216     push @{ $options{'jobnums'} }, @jobnums;
 217   }
 218
 219   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 220
 221   '';
 222 }
 223
 224 =item delete
 225
 226 Deletes this account from the database.  If there is an error, returns the
 227 error, otherwise returns false.
 228
 229 The corresponding FS::cust_svc record will be deleted as well.
 230
 231 =cut
 232
 233 sub delete {
 234   my $self = shift;
 235   my $error;
 236
 237   local $SIG{HUP} = 'IGNORE';
 238   local $SIG{INT} = 'IGNORE';
 239   local $SIG{QUIT} = 'IGNORE';
 240   local $SIG{TERM} = 'IGNORE';
 241   local $SIG{TSTP} = 'IGNORE';
 242   local $SIG{PIPE} = 'IGNORE';
 243
 244   my $svcnum = $self->svcnum;
 245
 246   my $oldAutoCommit = $FS::UID::AutoCommit;
 247   local $FS::UID::AutoCommit = 0;
 248   my $dbh = dbh;
 249
 250   $error = $self->SUPER::delete;
 251   return $error if $error;
 252
 253   #new-style exports!
 254   unless ( $noexport_hack ) {
 255     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 256       my $error = $part_export->export_delete($self);
 257       if ( $error ) {
 258         $dbh->rollback if $oldAutoCommit;
 259         return "exporting to ". $part_export->exporttype.
 260                " (transaction rolled back): $error";
 261       }
 262     }
 263   }
 264
 265   return $error if $error;
 266
 267   my $cust_svc = $self->cust_svc;
 268   $error = $cust_svc->delete;
 269   return $error if $error;
 270
 271   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 272
 273   '';
 274 }
 275
 276 =item replace OLD_RECORD
 277
 278 Replaces OLD_RECORD with this one.  If there is an error, returns the error,
 279 otherwise returns false.
 280
 281 =cut
 282
 283 sub replace {
 284   my ($new, $old) = (shift, shift);
 285
 286   local $SIG{HUP} = 'IGNORE';
 287   local $SIG{INT} = 'IGNORE';
 288   local $SIG{QUIT} = 'IGNORE';
 289   local $SIG{TERM} = 'IGNORE';
 290   local $SIG{TSTP} = 'IGNORE';
 291   local $SIG{PIPE} = 'IGNORE';
 292
 293   my $oldAutoCommit = $FS::UID::AutoCommit;
 294   local $FS::UID::AutoCommit = 0;
 295   my $dbh = dbh;
 296
 297   my $error = $new->SUPER::replace($old);
 298   if ($error) {
 299     $dbh->rollback if $oldAutoCommit;
 300     return $error;
 301   }
 302
 303   #new-style exports!
 304   unless ( $noexport_hack ) {
 305
 306     #not quite false laziness, but same pattern as FS::svc_acct::replace and
 307     #FS::part_export::sqlradius::_export_replace.  List::Compare or something
 308     #would be useful but too much of a pain in the ass to deploy
 309
 310     my @old_part_export = $old->cust_svc->part_svc->part_export;
 311     my %old_exportnum = map { $_->exportnum => 1 } @old_part_export;
 312     my @new_part_export =
 313       $new->svcpart
 314         ? qsearchs('part_svc', { svcpart=>$new->svcpart } )->part_export
 315         : $new->cust_svc->part_svc->part_export;
 316     my %new_exportnum = map { $_->exportnum => 1 } @new_part_export;
 317
 318     foreach my $delete_part_export (
 319       grep { ! $new_exportnum{$_->exportnum} } @old_part_export
 320     ) {
 321       my $error = $delete_part_export->export_delete($old);
 322       if ( $error ) {
 323         $dbh->rollback if $oldAutoCommit;
 324         return "error deleting, export to ". $delete_part_export->exporttype.
 325                " (transaction rolled back): $error";
 326       }
 327     }
 328
 329     foreach my $replace_part_export (
 330       grep { $old_exportnum{$_->exportnum} } @new_part_export
 331     ) {
 332       my $error = $replace_part_export->export_replace($new,$old);
 333       if ( $error ) {
 334         $dbh->rollback if $oldAutoCommit;
 335         return "error exporting to ". $replace_part_export->exporttype.
 336                " (transaction rolled back): $error";
 337       }
 338     }
 339
 340     foreach my $insert_part_export (
 341       grep { ! $old_exportnum{$_->exportnum} } @new_part_export
 342     ) {
 343       my $error = $insert_part_export->export_insert($new);
 344       if ( $error ) {
 345         $dbh->rollback if $oldAutoCommit;
 346         return "error inserting export to ". $insert_part_export->exporttype.
 347                " (transaction rolled back): $error";
 348       }
 349     }
 350
 351   }
 352
 353   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 354   '';
 355 }
 356
 357
 358 =item setfixed
 359
 360 Sets any fixed fields for this service (see L<FS::part_svc>).  If there is an
 361 error, returns the error, otherwise returns the FS::part_svc object (use ref()
 362 to test the return).  Usually called by the check method.
 363
 364 =cut
 365
 366 sub setfixed {
 367   my $self = shift;
 368   $self->setx('F');
 369 }
 370
 371 =item setdefault
 372
 373 Sets all fields to their defaults (see L<FS::part_svc>), overriding their
 374 current values.  If there is an error, returns the error, otherwise returns
 375 the FS::part_svc object (use ref() to test the return).
 376
 377 =cut
 378
 379 sub setdefault {
 380   my $self = shift;
 381   $self->setx('D');
 382 }
 383
 384 sub setx {
 385   my $self = shift;
 386   my $x = shift;
 387
 388   my $error;
 389
 390   $error =
 391     $self->ut_numbern('svcnum')
 392   ;
 393   return $error if $error;
 394
 395   #get part_svc
 396   my $svcpart;
 397   if ( $self->get('svcpart') ) {
 398     $svcpart = $self->get('svcpart');
 399   } elsif ( $self->svcnum && qsearchs('cust_svc', {'svcnum'=>$self->svcnum}) ) {
 400     my $cust_svc = $self->cust_svc;
 401     return "Unknown svcnum" unless $cust_svc;
 402     $svcpart = $cust_svc->svcpart;
 403   }
 404   my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
 405   return "Unkonwn svcpart" unless $part_svc;
 406
 407   #set default/fixed/whatever fields from part_svc
 408   my $table = $self->table;
 409   foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
 410     my $part_svc_column = $part_svc->part_svc_column($field);
 411     if ( $part_svc_column->columnflag eq $x ) {
 412       $self->setfield( $field, $part_svc_column->columnvalue );
 413     }
 414   }
 415
 416  $part_svc;
 417
 418 }
 419
 420 =item cust_svc
 421
 422 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
 423 object (see L<FS::cust_svc>).
 424
 425 =cut
 426
 427 sub cust_svc {
 428   my $self = shift;
 429   qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
 430 }
 431
 432 =item suspend
 433
 434 Runs export_suspend callbacks.
 435
 436 =cut
 437
 438 sub suspend {
 439   my $self = shift;
 440
 441   local $SIG{HUP} = 'IGNORE';
 442   local $SIG{INT} = 'IGNORE';
 443   local $SIG{QUIT} = 'IGNORE';
 444   local $SIG{TERM} = 'IGNORE';
 445   local $SIG{TSTP} = 'IGNORE';
 446   local $SIG{PIPE} = 'IGNORE';
 447
 448   my $oldAutoCommit = $FS::UID::AutoCommit;
 449   local $FS::UID::AutoCommit = 0;
 450   my $dbh = dbh;
 451
 452   #new-style exports!
 453   unless ( $noexport_hack ) {
 454     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 455       my $error = $part_export->export_suspend($self);
 456       if ( $error ) {
 457         $dbh->rollback if $oldAutoCommit;
 458         return "error exporting to ". $part_export->exporttype.
 459                " (transaction rolled back): $error";
 460       }
 461     }
 462   }
 463
 464   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 465   '';
 466
 467 }
 468
 469 =item unsuspend
 470
 471 Runs export_unsuspend callbacks.
 472
 473 =cut
 474
 475 sub unsuspend {
 476   my $self = shift;
 477
 478   local $SIG{HUP} = 'IGNORE';
 479   local $SIG{INT} = 'IGNORE';
 480   local $SIG{QUIT} = 'IGNORE';
 481   local $SIG{TERM} = 'IGNORE';
 482   local $SIG{TSTP} = 'IGNORE';
 483   local $SIG{PIPE} = 'IGNORE';
 484
 485   my $oldAutoCommit = $FS::UID::AutoCommit;
 486   local $FS::UID::AutoCommit = 0;
 487   my $dbh = dbh;
 488
 489   #new-style exports!
 490   unless ( $noexport_hack ) {
 491     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 492       my $error = $part_export->export_unsuspend($self);
 493       if ( $error ) {
 494         $dbh->rollback if $oldAutoCommit;
 495         return "error exporting to ". $part_export->exporttype.
 496                " (transaction rolled back): $error";
 497       }
 498     }
 499   }
 500
 501   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 502   '';
 503
 504 }
 505
 506 =item cancel
 507
 508 Stub - returns false (no error) so derived classes don't need to define these
 509 methods.  Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 510
 511 =cut
 512
 513 sub cancel { ''; }
 514
 515 =item clone_suspended
 516
 517 Constructor used by FS::part_export::_export_suspend fallback.  Stub returning
 518 same object for svc_ classes which don't implement a suspension fallback
 519 (everything except svc_acct at the moment).  Document better.
 520
 521 =cut
 522
 523 sub clone_suspended {
 524   shift;
 525 }
 526
 527 =item clone_kludge_unsuspend
 528
 529 Constructor used by FS::part_export::_export_unsuspend 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_kludge_unsuspend {
 536   shift;
 537 }
 538
 539 =back
 540
 541 =head1 BUGS
 542
 543 The setfixed method return value.
 544
 545 =head1 SEE ALSO
 546
 547 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
 548 from the base documentation.
 549
 550 =cut
 551
 552 1;
 553