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     foreach my $part_export ( $new->cust_svc->part_svc->part_export ) {
 306       my $error = $part_export->export_replace($new,$old);
 307       if ( $error ) {
 308         $dbh->rollback if $oldAutoCommit;
 309         return "error exporting to ". $part_export->exporttype.
 310                " (transaction rolled back): $error";
 311       }
 312     }
 313   }
 314
 315   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 316   '';
 317 }
 318
 319
 320 =item setfixed
 321
 322 Sets any fixed fields for this service (see L<FS::part_svc>).  If there is an
 323 error, returns the error, otherwise returns the FS::part_svc object (use ref()
 324 to test the return).  Usually called by the check method.
 325
 326 =cut
 327
 328 sub setfixed {
 329   my $self = shift;
 330   $self->setx('F');
 331 }
 332
 333 =item setdefault
 334
 335 Sets all fields to their defaults (see L<FS::part_svc>), overriding their
 336 current values.  If there is an error, returns the error, otherwise returns
 337 the FS::part_svc object (use ref() to test the return).
 338
 339 =cut
 340
 341 sub setdefault {
 342   my $self = shift;
 343   $self->setx('D');
 344 }
 345
 346 sub setx {
 347   my $self = shift;
 348   my $x = shift;
 349
 350   my $error;
 351
 352   $error =
 353     $self->ut_numbern('svcnum')
 354   ;
 355   return $error if $error;
 356
 357   #get part_svc
 358   my $svcpart;
 359   if ( $self->svcnum && qsearchs('cust_svc', {'svcnum'=>$self->svcnum}) ) {
 360     my $cust_svc = $self->cust_svc;
 361     return "Unknown svcnum" unless $cust_svc;
 362     $svcpart = $cust_svc->svcpart;
 363   } else {
 364     $svcpart = $self->getfield('svcpart');
 365   }
 366   my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
 367   return "Unkonwn svcpart" unless $part_svc;
 368
 369   #set default/fixed/whatever fields from part_svc
 370   my $table = $self->table;
 371   foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
 372     my $part_svc_column = $part_svc->part_svc_column($field);
 373     if ( $part_svc_column->columnflag eq $x ) {
 374       $self->setfield( $field, $part_svc_column->columnvalue );
 375     }
 376   }
 377
 378  $part_svc;
 379
 380 }
 381
 382 =item cust_svc
 383
 384 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
 385 object (see L<FS::cust_svc>).
 386
 387 =cut
 388
 389 sub cust_svc {
 390   my $self = shift;
 391   qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
 392 }
 393
 394 =item suspend
 395
 396 Runs export_suspend callbacks.
 397
 398 =cut
 399
 400 sub suspend {
 401   my $self = shift;
 402
 403   local $SIG{HUP} = 'IGNORE';
 404   local $SIG{INT} = 'IGNORE';
 405   local $SIG{QUIT} = 'IGNORE';
 406   local $SIG{TERM} = 'IGNORE';
 407   local $SIG{TSTP} = 'IGNORE';
 408   local $SIG{PIPE} = 'IGNORE';
 409
 410   my $oldAutoCommit = $FS::UID::AutoCommit;
 411   local $FS::UID::AutoCommit = 0;
 412   my $dbh = dbh;
 413
 414   #new-style exports!
 415   unless ( $noexport_hack ) {
 416     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 417       my $error = $part_export->export_suspend($self);
 418       if ( $error ) {
 419         $dbh->rollback if $oldAutoCommit;
 420         return "error exporting to ". $part_export->exporttype.
 421                " (transaction rolled back): $error";
 422       }
 423     }
 424   }
 425
 426   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 427   '';
 428
 429 }
 430
 431 =item unsuspend
 432
 433 Runs export_unsuspend callbacks.
 434
 435 =cut
 436
 437 sub unsuspend {
 438   my $self = shift;
 439
 440   local $SIG{HUP} = 'IGNORE';
 441   local $SIG{INT} = 'IGNORE';
 442   local $SIG{QUIT} = 'IGNORE';
 443   local $SIG{TERM} = 'IGNORE';
 444   local $SIG{TSTP} = 'IGNORE';
 445   local $SIG{PIPE} = 'IGNORE';
 446
 447   my $oldAutoCommit = $FS::UID::AutoCommit;
 448   local $FS::UID::AutoCommit = 0;
 449   my $dbh = dbh;
 450
 451   #new-style exports!
 452   unless ( $noexport_hack ) {
 453     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 454       my $error = $part_export->export_unsuspend($self);
 455       if ( $error ) {
 456         $dbh->rollback if $oldAutoCommit;
 457         return "error exporting to ". $part_export->exporttype.
 458                " (transaction rolled back): $error";
 459       }
 460     }
 461   }
 462
 463   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 464   '';
 465
 466 }
 467
 468 =item cancel
 469
 470 Stub - returns false (no error) so derived classes don't need to define these
 471 methods.  Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 472
 473 =cut
 474
 475 sub cancel { ''; }
 476
 477 =item clone_suspended
 478
 479 Constructor used by FS::part_export::_export_suspend fallback.  Stub returning
 480 same object for svc_ classes which don't implement a suspension fallback
 481 (everything except svc_acct at the moment).  Document better.
 482
 483 =cut
 484
 485 sub clone_suspended {
 486   shift;
 487 }
 488
 489 =item clone_kludge_unsuspend
 490
 491 Constructor used by FS::part_export::_export_unsuspend fallback.  Stub returning
 492 same object for svc_ classes which don't implement a suspension fallback
 493 (everything except svc_acct at the moment).  Document better.
 494
 495 =cut
 496
 497 sub clone_kludge_unsuspend {
 498   shift;
 499 }
 500
 501 =back
 502
 503 =head1 BUGS
 504
 505 The setfixed method return value.
 506
 507 =head1 SEE ALSO
 508
 509 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
 510 from the base documentation.
 511
 512 =cut
 513
 514 1;
 515