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( 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 =item insert [ , OPTION => VALUE ... ]
  35
  36 Adds this record to the database.  If there is an error, returns the error,
  37 otherwise returns false.
  38
  39 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
  40 defined.  An FS::cust_svc record will be created and inserted.
  41
  42 Currently available options are: I<jobnums>, I<child_objects> and
  43 I<depend_jobnum>.
  44
  45 If I<jobnum> is set to an array reference, the jobnums of any export jobs will
  46 be added to the referenced array.
  47
  48 If I<child_objects> is set to an array reference of FS::tablename objects (for
  49 example, FS::acct_snarf objects), they will have their svcnum fieldsset and
  50 will be inserted after this record, but before any exports are run.
  51
  52 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
  53 jobnums), all provisioning jobs will have a dependancy on the supplied
  54 jobnum(s) (they will not run until the specific job(s) complete(s)).
  55
  56 =cut
  57
  58 sub insert {
  59   my $self = shift;
  60   my %options = @_;
  61   warn "FS::svc_Common::insert called with options ".
  62      join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
  63   if $DEBUG;
  64
  65   my @jobnums = ();
  66   local $FS::queue::jobnums = \@jobnums;
  67   warn "FS::svc_Common::insert: set \$FS::queue::jobnums to $FS::queue::jobnums"
  68     if $DEBUG;
  69   my $objects = $options{'child_objects'} || [];
  70   my $depend_jobnums = $options{'depend_jobnum'} || [];
  71   $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
  72   my $error;
  73
  74   local $SIG{HUP} = 'IGNORE';
  75   local $SIG{INT} = 'IGNORE';
  76   local $SIG{QUIT} = 'IGNORE';
  77   local $SIG{TERM} = 'IGNORE';
  78   local $SIG{TSTP} = 'IGNORE';
  79   local $SIG{PIPE} = 'IGNORE';
  80
  81   my $oldAutoCommit = $FS::UID::AutoCommit;
  82   local $FS::UID::AutoCommit = 0;
  83   my $dbh = dbh;
  84
  85   $error = $self->check;
  86   return $error if $error;
  87
  88   my $svcnum = $self->svcnum;
  89   my $cust_svc = $svcnum ? qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) : '';
  90   #unless ( $svcnum ) {
  91   if ( !$svcnum or !$cust_svc ) {
  92     $cust_svc = new FS::cust_svc ( {
  93       #hua?# 'svcnum'  => $svcnum,
  94       'svcnum'  => $self->svcnum,
  95       'pkgnum'  => $self->pkgnum,
  96       'svcpart' => $self->svcpart,
  97     } );
  98     $error = $cust_svc->insert;
  99     if ( $error ) {
 100       $dbh->rollback if $oldAutoCommit;
 101       return $error;
 102     }
 103     $svcnum = $self->svcnum($cust_svc->svcnum);
 104   } else {
 105     #$cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
 106     unless ( $cust_svc ) {
 107       $dbh->rollback if $oldAutoCommit;
 108       return "no cust_svc record found for svcnum ". $self->svcnum;
 109     }
 110     $self->pkgnum($cust_svc->pkgnum);
 111     $self->svcpart($cust_svc->svcpart);
 112   }
 113
 114   $error = $self->SUPER::insert;
 115   if ( $error ) {
 116     $dbh->rollback if $oldAutoCommit;
 117     return $error;
 118   }
 119
 120   foreach my $object ( @$objects ) {
 121     $object->svcnum($self->svcnum);
 122     $error = $object->insert;
 123     if ( $error ) {
 124       $dbh->rollback if $oldAutoCommit;
 125       return $error;
 126     }
 127   }
 128
 129   #new-style exports!
 130   unless ( $noexport_hack ) {
 131
 132     warn "FS::svc_Common::insert: \$FS::queue::jobnums is $FS::queue::jobnums"
 133       if $DEBUG;
 134
 135     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 136       my $error = $part_export->export_insert($self);
 137       if ( $error ) {
 138         $dbh->rollback if $oldAutoCommit;
 139         return "exporting to ". $part_export->exporttype.
 140                " (transaction rolled back): $error";
 141       }
 142     }
 143
 144     foreach my $depend_jobnum ( @$depend_jobnums ) {
 145       warn "inserting dependancies on supplied job $depend_jobnum\n"
 146         if $DEBUG;
 147       foreach my $jobnum ( @jobnums ) {
 148         my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
 149         warn "inserting dependancy for job $jobnum on $depend_jobnum\n"
 150           if $DEBUG;
 151         my $error = $queue->depend_insert($depend_jobnum);
 152         if ( $error ) {
 153           $dbh->rollback if $oldAutoCommit;
 154           return "error queuing job dependancy: $error";
 155         }
 156       }
 157     }
 158
 159   }
 160
 161   if ( exists $options{'jobnums'} ) {
 162     push @{ $options{'jobnums'} }, @jobnums;
 163   }
 164
 165   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 166
 167   '';
 168 }
 169
 170 =item delete
 171
 172 Deletes this account from the database.  If there is an error, returns the
 173 error, otherwise returns false.
 174
 175 The corresponding FS::cust_svc record will be deleted as well.
 176
 177 =cut
 178
 179 sub delete {
 180   my $self = shift;
 181   my $error;
 182
 183   local $SIG{HUP} = 'IGNORE';
 184   local $SIG{INT} = 'IGNORE';
 185   local $SIG{QUIT} = 'IGNORE';
 186   local $SIG{TERM} = 'IGNORE';
 187   local $SIG{TSTP} = 'IGNORE';
 188   local $SIG{PIPE} = 'IGNORE';
 189
 190   my $svcnum = $self->svcnum;
 191
 192   my $oldAutoCommit = $FS::UID::AutoCommit;
 193   local $FS::UID::AutoCommit = 0;
 194   my $dbh = dbh;
 195
 196   $error = $self->SUPER::delete;
 197   return $error if $error;
 198
 199   #new-style exports!
 200   unless ( $noexport_hack ) {
 201     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 202       my $error = $part_export->export_delete($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
 211   return $error if $error;
 212
 213   my $cust_svc = $self->cust_svc;
 214   $error = $cust_svc->delete;
 215   return $error if $error;
 216
 217   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 218
 219   '';
 220 }
 221
 222 =item replace OLD_RECORD
 223
 224 Replaces OLD_RECORD with this one.  If there is an error, returns the error,
 225 otherwise returns false.
 226
 227 =cut
 228
 229 sub replace {
 230   my ($new, $old) = (shift, shift);
 231
 232   local $SIG{HUP} = 'IGNORE';
 233   local $SIG{INT} = 'IGNORE';
 234   local $SIG{QUIT} = 'IGNORE';
 235   local $SIG{TERM} = 'IGNORE';
 236   local $SIG{TSTP} = 'IGNORE';
 237   local $SIG{PIPE} = 'IGNORE';
 238
 239   my $oldAutoCommit = $FS::UID::AutoCommit;
 240   local $FS::UID::AutoCommit = 0;
 241   my $dbh = dbh;
 242
 243   my $error = $new->SUPER::replace($old);
 244   if ($error) {
 245     $dbh->rollback if $oldAutoCommit;
 246     return $error;
 247   }
 248
 249   #new-style exports!
 250   unless ( $noexport_hack ) {
 251     foreach my $part_export ( $new->cust_svc->part_svc->part_export ) {
 252       my $error = $part_export->export_replace($new,$old);
 253       if ( $error ) {
 254         $dbh->rollback if $oldAutoCommit;
 255         return "error exporting to ". $part_export->exporttype.
 256                " (transaction rolled back): $error";
 257       }
 258     }
 259   }
 260
 261   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 262   '';
 263 }
 264
 265
 266 =item setfixed
 267
 268 Sets any fixed fields for this service (see L<FS::part_svc>).  If there is an
 269 error, returns the error, otherwise returns the FS::part_svc object (use ref()
 270 to test the return).  Usually called by the check method.
 271
 272 =cut
 273
 274 sub setfixed {
 275   my $self = shift;
 276   $self->setx('F');
 277 }
 278
 279 =item setdefault
 280
 281 Sets all fields to their defaults (see L<FS::part_svc>), overriding their
 282 current values.  If there is an error, returns the error, otherwise returns
 283 the FS::part_svc object (use ref() to test the return).
 284
 285 =cut
 286
 287 sub setdefault {
 288   my $self = shift;
 289   $self->setx('D');
 290 }
 291
 292 sub setx {
 293   my $self = shift;
 294   my $x = shift;
 295
 296   my $error;
 297
 298   $error =
 299     $self->ut_numbern('svcnum')
 300   ;
 301   return $error if $error;
 302
 303   #get part_svc
 304   my $svcpart;
 305   if ( $self->svcnum && qsearchs('cust_svc', {'svcnum'=>$self->svcnum}) ) {
 306     my $cust_svc = $self->cust_svc;
 307     return "Unknown svcnum" unless $cust_svc;
 308     $svcpart = $cust_svc->svcpart;
 309   } else {
 310     $svcpart = $self->getfield('svcpart');
 311   }
 312   my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
 313   return "Unkonwn svcpart" unless $part_svc;
 314
 315   #set default/fixed/whatever fields from part_svc
 316   my $table = $self->table;
 317   foreach my $field ( grep { $_ ne 'svcnum' } fields($table) ) {
 318     my $part_svc_column = $part_svc->part_svc_column($field);
 319     if ( $part_svc_column->columnflag eq $x ) {
 320       $self->setfield( $field, $part_svc_column->columnvalue );
 321     }
 322   }
 323
 324  $part_svc;
 325
 326 }
 327
 328 =item cust_svc
 329
 330 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
 331 object (see L<FS::cust_svc>).
 332
 333 =cut
 334
 335 sub cust_svc {
 336   my $self = shift;
 337   qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
 338 }
 339
 340 =item suspend
 341
 342 Runs export_suspend callbacks.
 343
 344 =cut
 345
 346 sub suspend {
 347   my $self = shift;
 348
 349   local $SIG{HUP} = 'IGNORE';
 350   local $SIG{INT} = 'IGNORE';
 351   local $SIG{QUIT} = 'IGNORE';
 352   local $SIG{TERM} = 'IGNORE';
 353   local $SIG{TSTP} = 'IGNORE';
 354   local $SIG{PIPE} = 'IGNORE';
 355
 356   my $oldAutoCommit = $FS::UID::AutoCommit;
 357   local $FS::UID::AutoCommit = 0;
 358   my $dbh = dbh;
 359
 360   #new-style exports!
 361   unless ( $noexport_hack ) {
 362     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 363       my $error = $part_export->export_suspend($self);
 364       if ( $error ) {
 365         $dbh->rollback if $oldAutoCommit;
 366         return "error exporting to ". $part_export->exporttype.
 367                " (transaction rolled back): $error";
 368       }
 369     }
 370   }
 371
 372   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 373   '';
 374
 375 }
 376
 377 =item unsuspend
 378
 379 Runs export_unsuspend callbacks.
 380
 381 =cut
 382
 383 sub unsuspend {
 384   my $self = shift;
 385
 386   local $SIG{HUP} = 'IGNORE';
 387   local $SIG{INT} = 'IGNORE';
 388   local $SIG{QUIT} = 'IGNORE';
 389   local $SIG{TERM} = 'IGNORE';
 390   local $SIG{TSTP} = 'IGNORE';
 391   local $SIG{PIPE} = 'IGNORE';
 392
 393   my $oldAutoCommit = $FS::UID::AutoCommit;
 394   local $FS::UID::AutoCommit = 0;
 395   my $dbh = dbh;
 396
 397   #new-style exports!
 398   unless ( $noexport_hack ) {
 399     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 400       my $error = $part_export->export_unsuspend($self);
 401       if ( $error ) {
 402         $dbh->rollback if $oldAutoCommit;
 403         return "error exporting to ". $part_export->exporttype.
 404                " (transaction rolled back): $error";
 405       }
 406     }
 407   }
 408
 409   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 410   '';
 411
 412 }
 413
 414 =item cancel
 415
 416 Stub - returns false (no error) so derived classes don't need to define these
 417 methods.  Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 418
 419 =cut
 420
 421 sub cancel { ''; }
 422
 423 =item clone_suspended
 424
 425 Constructor used by FS::part_export::_export_suspend fallback.  Stub returning
 426 same object for svc_ classes which don't implement a suspension fallback
 427 (everything except svc_acct at the moment).  Document better.
 428
 429 =cut
 430
 431 sub clone_suspended {
 432   shift;
 433 }
 434
 435 =item clone_kludge_unsuspend
 436
 437 Constructor used by FS::part_export::_export_unsuspend fallback.  Stub returning
 438 same object for svc_ classes which don't implement a suspension fallback
 439 (everything except svc_acct at the moment).  Document better.
 440
 441 =cut
 442
 443 sub clone_kludge_unsuspend {
 444   shift;
 445 }
 446
 447 =back
 448
 449 =head1 VERSION
 450
 451 $Id: svc_Common.pm,v 1.12.4.6 2004-03-03 13:44:27 ivan Exp $
 452
 453 =head1 BUGS
 454
 455 The setfixed method return value.
 456
 457 =head1 SEE ALSO
 458
 459 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
 460 from the base documentation.
 461
 462 =cut
 463
 464 1;
 465