FS/FS/svc_Common.pm

   1 package FS::svc_Common;
   2
   3 use strict;
   4 use vars qw( @ISA $noexport_hack $DEBUG $me
   5              $overlimit_missing_cust_svc_nonfatal_kludge );
   6 use Carp qw( cluck carp croak confess ); #specify cluck have to specify them all
   7 use Scalar::Util qw( blessed );
   8 use FS::Record qw( qsearch qsearchs fields dbh );
   9 use FS::cust_main_Mixin;
  10 use FS::cust_svc;
  11 use FS::part_svc;
  12 use FS::queue;
  13 use FS::cust_main;
  14 use FS::inventory_item;
  15 use FS::inventory_class;
  16
  17 @ISA = qw( FS::cust_main_Mixin FS::Record );
  18
  19 $me = '[FS::svc_Common]';
  20 $DEBUG = 0;
  21
  22 $overlimit_missing_cust_svc_nonfatal_kludge = 0;
  23
  24 =head1 NAME
  25
  26 FS::svc_Common - Object method for all svc_ records
  27
  28 =head1 SYNOPSIS
  29
  30 use FS::svc_Common;
  31
  32 @ISA = qw( FS::svc_Common );
  33
  34 =head1 DESCRIPTION
  35
  36 FS::svc_Common is intended as a base class for table-specific classes to
  37 inherit from, i.e. FS::svc_acct.  FS::svc_Common inherits from FS::Record.
  38
  39 =head1 METHODS
  40
  41 =over 4
  42
  43 =item search_sql_field FIELD STRING
  44
  45 Class method which returns an SQL fragment to search for STRING in FIELD.
  46
  47 It is now case-insensitive by default.
  48
  49 =cut
  50
  51 sub search_sql_field {
  52   my( $class, $field, $string ) = @_;
  53   my $table = $class->table;
  54   my $q_string = dbh->quote($string);
  55   "LOWER($table.$field) = LOWER($q_string)";
  56 }
  57
  58 #fallback for services that don't provide a search...
  59 sub search_sql {
  60   #my( $class, $string ) = @_;
  61   '1 = 0'; #false
  62 }
  63
  64 =item new
  65
  66 =cut
  67
  68 sub new {
  69   my $proto = shift;
  70   my $class = ref($proto) || $proto;
  71   my $self = {};
  72   bless ($self, $class);
  73
  74   unless ( defined ( $self->table ) ) {
  75     $self->{'Table'} = shift;
  76     carp "warning: FS::Record::new called with table name ". $self->{'Table'};
  77   }
  78
  79   #$self->{'Hash'} = shift;
  80   my $newhash = shift;
  81   $self->{'Hash'} = { map { $_ => $newhash->{$_} } qw(svcnum svcpart) };
  82
  83   $self->setdefault( $self->_fieldhandlers )
  84     unless $self->svcnum;
  85
  86   $self->{'Hash'}{$_} = $newhash->{$_}
  87     foreach grep { defined($newhash->{$_}) && length($newhash->{$_}) }
  88                  keys %$newhash;
  89
  90   foreach my $field ( grep !defined($self->{'Hash'}{$_}), $self->fields ) {
  91     $self->{'Hash'}{$field}='';
  92   }
  93
  94   $self->_rebless if $self->can('_rebless');
  95
  96   $self->{'modified'} = 0;
  97
  98   $self->_cache($self->{'Hash'}, shift) if $self->can('_cache') && @_;
  99
 100   $self;
 101 }
 102
 103 #empty default
 104 sub _fieldhandlers { {}; }
 105
 106 sub virtual_fields {
 107
 108   # This restricts the fields based on part_svc_column and the svcpart of
 109   # the service.  There are four possible cases:
 110   # 1.  svcpart passed as part of the svc_x hash.
 111   # 2.  svcpart fetched via cust_svc based on svcnum.
 112   # 3.  No svcnum or svcpart.  In this case, return ALL the fields with
 113   #     dbtable eq $self->table.
 114   # 4.  Called via "fields('svc_acct')" or something similar.  In this case
 115   #     there is no $self object.
 116
 117   my $self = shift;
 118   my $svcpart;
 119   my @vfields = $self->SUPER::virtual_fields;
 120
 121   return @vfields unless (ref $self); # Case 4
 122
 123   if ($self->svcpart) { # Case 1
 124     $svcpart = $self->svcpart;
 125   } elsif ( $self->svcnum
 126             && qsearchs('cust_svc',{'svcnum'=>$self->svcnum} )
 127           ) { #Case 2
 128     $svcpart = $self->cust_svc->svcpart;
 129   } else { # Case 3
 130     $svcpart = '';
 131   }
 132
 133   if ($svcpart) { #Cases 1 and 2
 134     my %flags = map { $_->columnname, $_->columnflag } (
 135         qsearch ('part_svc_column', { svcpart => $svcpart } )
 136       );
 137     return grep { not ( defined($flags{$_}) && $flags{$_} eq 'X') } @vfields;
 138   } else { # Case 3
 139     return @vfields;
 140   }
 141   return ();
 142 }
 143
 144 =item label
 145
 146 svc_Common provides a fallback label subroutine that just returns the svcnum.
 147
 148 =cut
 149
 150 sub label {
 151   my $self = shift;
 152   cluck "warning: ". ref($self). " not loaded or missing label method; ".
 153         "using svcnum";
 154   $self->svcnum;
 155 }
 156
 157 sub label_long {
 158   my $self = shift;
 159   $self->label(@_);
 160 }
 161
 162 =item check
 163
 164 Checks the validity of fields in this record.
 165
 166 At present, this does nothing but call FS::Record::check (which, in turn,
 167 does nothing but run virtual field checks).
 168
 169 =cut
 170
 171 sub check {
 172   my $self = shift;
 173   $self->SUPER::check;
 174 }
 175
 176 =item insert [ , OPTION => VALUE ... ]
 177
 178 Adds this record to the database.  If there is an error, returns the error,
 179 otherwise returns false.
 180
 181 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
 182 defined.  An FS::cust_svc record will be created and inserted.
 183
 184 Currently available options are: I<jobnums>, I<child_objects> and
 185 I<depend_jobnum>.
 186
 187 If I<jobnum> is set to an array reference, the jobnums of any export jobs will
 188 be added to the referenced array.
 189
 190 If I<child_objects> is set to an array reference of FS::tablename objects (for
 191 example, FS::acct_snarf objects), they will have their svcnum field set and
 192 will be inserted after this record, but before any exports are run.  Each
 193 element of the array can also optionally be a two-element array reference
 194 containing the child object and the name of an alternate field to be filled in
 195 with the newly-inserted svcnum, for example C<[ $svc_forward, 'srcsvc' ]>
 196
 197 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
 198 jobnums), all provisioning jobs will have a dependancy on the supplied
 199 jobnum(s) (they will not run until the specific job(s) complete(s)).
 200
 201 If I<export_args> is set to an array reference, the referenced list will be
 202 passed to export commands.
 203
 204 =cut
 205
 206 sub insert {
 207   my $self = shift;
 208   my %options = @_;
 209   warn "[$me] insert called with options ".
 210        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 211     if $DEBUG;
 212
 213   my @jobnums = ();
 214   local $FS::queue::jobnums = \@jobnums;
 215   warn "[$me] insert: set \$FS::queue::jobnums to $FS::queue::jobnums\n"
 216     if $DEBUG;
 217   my $objects = $options{'child_objects'} || [];
 218   my $depend_jobnums = $options{'depend_jobnum'} || [];
 219   $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
 220
 221   local $SIG{HUP} = 'IGNORE';
 222   local $SIG{INT} = 'IGNORE';
 223   local $SIG{QUIT} = 'IGNORE';
 224   local $SIG{TERM} = 'IGNORE';
 225   local $SIG{TSTP} = 'IGNORE';
 226   local $SIG{PIPE} = 'IGNORE';
 227
 228   my $oldAutoCommit = $FS::UID::AutoCommit;
 229   local $FS::UID::AutoCommit = 0;
 230   my $dbh = dbh;
 231
 232   my $svcnum = $self->svcnum;
 233   my $cust_svc = $svcnum ? qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) : '';
 234   #unless ( $svcnum ) {
 235   if ( !$svcnum or !$cust_svc ) {
 236     $cust_svc = new FS::cust_svc ( {
 237       #hua?# 'svcnum'  => $svcnum,
 238       'svcnum'  => $self->svcnum,
 239       'pkgnum'  => $self->pkgnum,
 240       'svcpart' => $self->svcpart,
 241     } );
 242     my $error = $cust_svc->insert;
 243     if ( $error ) {
 244       $dbh->rollback if $oldAutoCommit;
 245       return $error;
 246     }
 247     $svcnum = $self->svcnum($cust_svc->svcnum);
 248   } else {
 249     #$cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
 250     unless ( $cust_svc ) {
 251       $dbh->rollback if $oldAutoCommit;
 252       return "no cust_svc record found for svcnum ". $self->svcnum;
 253     }
 254     $self->pkgnum($cust_svc->pkgnum);
 255     $self->svcpart($cust_svc->svcpart);
 256   }
 257
 258   my $error =    $self->preinsert_hook_first
 259               || $self->set_auto_inventory
 260               || $self->check
 261               || $self->_check_duplicate
 262               || $self->preinsert_hook
 263               || $self->SUPER::insert;
 264   if ( $error ) {
 265     $dbh->rollback if $oldAutoCommit;
 266     return $error;
 267   }
 268
 269   foreach my $object ( @$objects ) {
 270     my($field, $obj);
 271     if ( ref($object) eq 'ARRAY' ) {
 272       ($obj, $field) = @$object;
 273     } else {
 274       $obj = $object;
 275       $field = 'svcnum';
 276     }
 277     $obj->$field($self->svcnum);
 278     $error = $obj->insert;
 279     if ( $error ) {
 280       $dbh->rollback if $oldAutoCommit;
 281       return $error;
 282     }
 283   }
 284
 285   #new-style exports!
 286   unless ( $noexport_hack ) {
 287
 288     warn "[$me] insert: \$FS::queue::jobnums is $FS::queue::jobnums\n"
 289       if $DEBUG;
 290
 291     my $export_args = $options{'export_args'} || [];
 292
 293     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 294       my $error = $part_export->export_insert($self, @$export_args);
 295       if ( $error ) {
 296         $dbh->rollback if $oldAutoCommit;
 297         return "exporting to ". $part_export->exporttype.
 298                " (transaction rolled back): $error";
 299       }
 300     }
 301
 302     foreach my $depend_jobnum ( @$depend_jobnums ) {
 303       warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
 304         if $DEBUG;
 305       foreach my $jobnum ( @jobnums ) {
 306         my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
 307         warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
 308           if $DEBUG;
 309         my $error = $queue->depend_insert($depend_jobnum);
 310         if ( $error ) {
 311           $dbh->rollback if $oldAutoCommit;
 312           return "error queuing job dependancy: $error";
 313         }
 314       }
 315     }
 316
 317   }
 318
 319   if ( exists $options{'jobnums'} ) {
 320     push @{ $options{'jobnums'} }, @jobnums;
 321   }
 322
 323   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 324
 325   '';
 326 }
 327
 328 #fallbacks
 329 sub preinsert_hook_first { ''; }
 330 sub _check_duplcate { ''; }
 331 sub preinsert_hook { ''; }
 332 sub table_dupcheck_fields { (); }
 333
 334 =item delete [ , OPTION => VALUE ... ]
 335
 336 Deletes this account from the database.  If there is an error, returns the
 337 error, otherwise returns false.
 338
 339 The corresponding FS::cust_svc record will be deleted as well.
 340
 341 =cut
 342
 343 sub delete {
 344   my $self = shift;
 345   my %options = @_;
 346   my $export_args = $options{'export_args'} || [];
 347
 348   local $SIG{HUP} = 'IGNORE';
 349   local $SIG{INT} = 'IGNORE';
 350   local $SIG{QUIT} = 'IGNORE';
 351   local $SIG{TERM} = 'IGNORE';
 352   local $SIG{TSTP} = 'IGNORE';
 353   local $SIG{PIPE} = 'IGNORE';
 354
 355   my $oldAutoCommit = $FS::UID::AutoCommit;
 356   local $FS::UID::AutoCommit = 0;
 357   my $dbh = dbh;
 358
 359   my $error =    $self->SUPER::delete
 360               || $self->export('delete', @$export_args)
 361               || $self->return_inventory
 362               || $self->cust_svc->delete
 363   ;
 364   if ( $error ) {
 365     $dbh->rollback if $oldAutoCommit;
 366     return $error;
 367   }
 368
 369   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 370
 371   '';
 372 }
 373
 374 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ]
 375
 376 Replaces OLD_RECORD with this one.  If there is an error, returns the error,
 377 otherwise returns false.
 378
 379 =cut
 380
 381 sub replace {
 382   my $new = shift;
 383
 384   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
 385               ? shift
 386               : $new->replace_old;
 387
 388   my $options =
 389     ( ref($_[0]) eq 'HASH' )
 390       ? shift
 391       : { @_ };
 392
 393   local $SIG{HUP} = 'IGNORE';
 394   local $SIG{INT} = 'IGNORE';
 395   local $SIG{QUIT} = 'IGNORE';
 396   local $SIG{TERM} = 'IGNORE';
 397   local $SIG{TSTP} = 'IGNORE';
 398   local $SIG{PIPE} = 'IGNORE';
 399
 400   my $oldAutoCommit = $FS::UID::AutoCommit;
 401   local $FS::UID::AutoCommit = 0;
 402   my $dbh = dbh;
 403
 404   my $error = $new->set_auto_inventory;
 405   if ( $error ) {
 406     $dbh->rollback if $oldAutoCommit;
 407     return $error;
 408   }
 409
 410   #redundant, but so any duplicate fields are maniuplated as appropriate
 411   # (svc_phone.phonenum)
 412   $error = $new->check;
 413   if ( $error ) {
 414     $dbh->rollback if $oldAutoCommit;
 415     return $error;
 416   }
 417
 418   #if ( $old->username ne $new->username || $old->domsvc != $new->domsvc ) {
 419   if ( grep { $old->$_ ne $new->$_ } $new->table_dupcheck_fields ) {
 420
 421     $new->svcpart( $new->cust_svc->svcpart ) unless $new->svcpart;
 422     $error = $new->_check_duplicate;
 423     if ( $error ) {
 424       $dbh->rollback if $oldAutoCommit;
 425       return $error;
 426     }
 427   }
 428
 429   $error = $new->SUPER::replace($old);
 430   if ($error) {
 431     $dbh->rollback if $oldAutoCommit;
 432     return $error;
 433   }
 434
 435   #new-style exports!
 436   unless ( $noexport_hack ) {
 437
 438     my $export_args = $options->{'export_args'} || [];
 439
 440     #not quite false laziness, but same pattern as FS::svc_acct::replace and
 441     #FS::part_export::sqlradius::_export_replace.  List::Compare or something
 442     #would be useful but too much of a pain in the ass to deploy
 443
 444     my @old_part_export = $old->cust_svc->part_svc->part_export;
 445     my %old_exportnum = map { $_->exportnum => 1 } @old_part_export;
 446     my @new_part_export =
 447       $new->svcpart
 448         ? qsearchs('part_svc', { svcpart=>$new->svcpart } )->part_export
 449         : $new->cust_svc->part_svc->part_export;
 450     my %new_exportnum = map { $_->exportnum => 1 } @new_part_export;
 451
 452     foreach my $delete_part_export (
 453       grep { ! $new_exportnum{$_->exportnum} } @old_part_export
 454     ) {
 455       my $error = $delete_part_export->export_delete($old, @$export_args);
 456       if ( $error ) {
 457         $dbh->rollback if $oldAutoCommit;
 458         return "error deleting, export to ". $delete_part_export->exporttype.
 459                " (transaction rolled back): $error";
 460       }
 461     }
 462
 463     foreach my $replace_part_export (
 464       grep { $old_exportnum{$_->exportnum} } @new_part_export
 465     ) {
 466       my $error =
 467         $replace_part_export->export_replace( $new, $old, @$export_args);
 468       if ( $error ) {
 469         $dbh->rollback if $oldAutoCommit;
 470         return "error exporting to ". $replace_part_export->exporttype.
 471                " (transaction rolled back): $error";
 472       }
 473     }
 474
 475     foreach my $insert_part_export (
 476       grep { ! $old_exportnum{$_->exportnum} } @new_part_export
 477     ) {
 478       my $error = $insert_part_export->export_insert($new, @$export_args );
 479       if ( $error ) {
 480         $dbh->rollback if $oldAutoCommit;
 481         return "error inserting export to ". $insert_part_export->exporttype.
 482                " (transaction rolled back): $error";
 483       }
 484     }
 485
 486   }
 487
 488   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 489   '';
 490 }
 491
 492 =item setfixed
 493
 494 Sets any fixed fields for this service (see L<FS::part_svc>).  If there is an
 495 error, returns the error, otherwise returns the FS::part_svc object (use ref()
 496 to test the return).  Usually called by the check method.
 497
 498 =cut
 499
 500 sub setfixed {
 501   my $self = shift;
 502   $self->setx('F', @_);
 503 }
 504
 505 =item setdefault
 506
 507 Sets all fields to their defaults (see L<FS::part_svc>), overriding their
 508 current values.  If there is an error, returns the error, otherwise returns
 509 the FS::part_svc object (use ref() to test the return).
 510
 511 =cut
 512
 513 sub setdefault {
 514   my $self = shift;
 515   $self->setx('D', @_ );
 516 }
 517
 518 =item set_default_and_fixed
 519
 520 =cut
 521
 522 sub set_default_and_fixed {
 523   my $self = shift;
 524   $self->setx( [ 'D', 'F' ], @_ );
 525 }
 526
 527 =item setx FLAG | FLAG_ARRAYREF , [ CALLBACK_HASHREF ]
 528
 529 Sets fields according to the passed in flag or arrayref of flags.
 530
 531 Optionally, a hashref of field names and callback coderefs can be passed.
 532 If a coderef exists for a given field name, instead of setting the field,
 533 the coderef is called with the column value (part_svc_column.columnvalue)
 534 as the single parameter.
 535
 536 =cut
 537
 538 sub setx {
 539   my $self = shift;
 540   my $x = shift;
 541   my @x = ref($x) ? @$x : ($x);
 542   my $coderef = scalar(@_) ? shift : $self->_fieldhandlers;
 543
 544   my $error =
 545     $self->ut_numbern('svcnum')
 546   ;
 547   return $error if $error;
 548
 549   my $part_svc = $self->part_svc;
 550   return "Unknown svcpart" unless $part_svc;
 551
 552   #set default/fixed/whatever fields from part_svc
 553
 554   foreach my $part_svc_column (
 555     grep { my $f = $_->columnflag; grep { $f eq $_ } @x } #columnflag in @x
 556     $part_svc->all_part_svc_column
 557   ) {
 558
 559     my $columnname  = $part_svc_column->columnname;
 560     my $columnvalue = $part_svc_column->columnvalue;
 561
 562     $columnvalue = &{ $coderef->{$columnname} }( $self, $columnvalue )
 563       if exists( $coderef->{$columnname} );
 564     $self->setfield( $columnname, $columnvalue );
 565
 566   }
 567
 568  $part_svc;
 569
 570 }
 571
 572 sub part_svc {
 573   my $self = shift;
 574
 575   #get part_svc
 576   my $svcpart;
 577   if ( $self->get('svcpart') ) {
 578     $svcpart = $self->get('svcpart');
 579   } elsif ( $self->svcnum && qsearchs('cust_svc', {'svcnum'=>$self->svcnum}) ) {
 580     my $cust_svc = $self->cust_svc;
 581     return "Unknown svcnum" unless $cust_svc;
 582     $svcpart = $cust_svc->svcpart;
 583   }
 584
 585   qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
 586
 587 }
 588
 589 =item set_auto_inventory
 590
 591 Sets any fields which auto-populate from inventory (see L<FS::part_svc>).
 592 If there is an error, returns the error, otherwise returns false.
 593
 594 =cut
 595
 596 sub set_auto_inventory {
 597   my $self = shift;
 598
 599   my $error =
 600     $self->ut_numbern('svcnum')
 601   ;
 602   return $error if $error;
 603
 604   my $part_svc = $self->part_svc;
 605   return "Unkonwn svcpart" unless $part_svc;
 606
 607   local $SIG{HUP} = 'IGNORE';
 608   local $SIG{INT} = 'IGNORE';
 609   local $SIG{QUIT} = 'IGNORE';
 610   local $SIG{TERM} = 'IGNORE';
 611   local $SIG{TSTP} = 'IGNORE';
 612   local $SIG{PIPE} = 'IGNORE';
 613
 614   my $oldAutoCommit = $FS::UID::AutoCommit;
 615   local $FS::UID::AutoCommit = 0;
 616   my $dbh = dbh;
 617
 618   #set default/fixed/whatever fields from part_svc
 619   my $table = $self->table;
 620   foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
 621     my $part_svc_column = $part_svc->part_svc_column($field);
 622     if ( $part_svc_column->columnflag eq 'A' && $self->$field() eq '' ) {
 623
 624       my $classnum = $part_svc_column->columnvalue;
 625       my $inventory_item = qsearchs({
 626         'table'     => 'inventory_item',
 627         'hashref'   => { 'classnum' => $classnum,
 628                          'svcnum'   => '',
 629                        },
 630         'extra_sql' => 'LIMIT 1 FOR UPDATE',
 631       });
 632
 633       unless ( $inventory_item ) {
 634         $dbh->rollback if $oldAutoCommit;
 635         my $inventory_class =
 636           qsearchs('inventory_class', { 'classnum' => $classnum } );
 637         return "Can't find inventory_class.classnum $classnum"
 638           unless $inventory_class;
 639         return "Out of ". $inventory_class->classname. "s\n"; #Lingua:: BS
 640                                                               #for pluralizing
 641       }
 642
 643       $inventory_item->svcnum( $self->svcnum );
 644       my $ierror = $inventory_item->replace();
 645       if ( $ierror ) {
 646         $dbh->rollback if $oldAutoCommit;
 647         return "Error provisioning inventory: $ierror";
 648
 649       }
 650
 651       $self->setfield( $field, $inventory_item->item );
 652
 653     }
 654   }
 655
 656  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 657
 658  '';
 659
 660 }
 661
 662 =item return_inventory
 663
 664 =cut
 665
 666 sub return_inventory {
 667   my $self = shift;
 668
 669   local $SIG{HUP} = 'IGNORE';
 670   local $SIG{INT} = 'IGNORE';
 671   local $SIG{QUIT} = 'IGNORE';
 672   local $SIG{TERM} = 'IGNORE';
 673   local $SIG{TSTP} = 'IGNORE';
 674   local $SIG{PIPE} = 'IGNORE';
 675
 676   my $oldAutoCommit = $FS::UID::AutoCommit;
 677   local $FS::UID::AutoCommit = 0;
 678   my $dbh = dbh;
 679
 680   foreach my $inventory_item ( $self->inventory_item ) {
 681     $inventory_item->svcnum('');
 682     my $error = $inventory_item->replace();
 683     if ( $error ) {
 684       $dbh->rollback if $oldAutoCommit;
 685       return "Error returning inventory: $error";
 686     }
 687   }
 688
 689   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 690
 691   '';
 692 }
 693
 694 =item inventory_item
 695
 696 Returns the inventory items associated with this svc_ record, as
 697 FS::inventory_item objects (see L<FS::inventory_item>.
 698
 699 =cut
 700
 701 sub inventory_item {
 702   my $self = shift;
 703   qsearch({
 704     'table'     => 'inventory_item',
 705     'hashref'   => { 'svcnum' => $self->svcnum, },
 706   });
 707 }
 708
 709 =item cust_svc
 710
 711 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
 712 object (see L<FS::cust_svc>).
 713
 714 =cut
 715
 716 sub cust_svc {
 717   my $self = shift;
 718   qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
 719 }
 720
 721 =item suspend
 722
 723 Runs export_suspend callbacks.
 724
 725 =cut
 726
 727 sub suspend {
 728   my $self = shift;
 729   my %options = @_;
 730   my $export_args = $options{'export_args'} || [];
 731   $self->export('suspend', @$export_args);
 732 }
 733
 734 =item unsuspend
 735
 736 Runs export_unsuspend callbacks.
 737
 738 =cut
 739
 740 sub unsuspend {
 741   my $self = shift;
 742   my %options = @_;
 743   my $export_args = $options{'export_args'} || [];
 744   $self->export('unsuspend', @$export_args);
 745 }
 746
 747 =item export_links
 748
 749 Runs export_links callbacks and returns the links.
 750
 751 =cut
 752
 753 sub export_links {
 754   my $self = shift;
 755   my $return = [];
 756   $self->export('links', $return);
 757   $return;
 758 }
 759
 760 =item export HOOK [ EXPORT_ARGS ]
 761
 762 Runs the provided export hook (i.e. "suspend", "unsuspend") for this service.
 763
 764 =cut
 765
 766 sub export {
 767   my( $self, $method ) = ( shift, shift );
 768
 769   $method = "export_$method" unless $method =~ /^export_/;
 770
 771   local $SIG{HUP} = 'IGNORE';
 772   local $SIG{INT} = 'IGNORE';
 773   local $SIG{QUIT} = 'IGNORE';
 774   local $SIG{TERM} = 'IGNORE';
 775   local $SIG{TSTP} = 'IGNORE';
 776   local $SIG{PIPE} = 'IGNORE';
 777
 778   my $oldAutoCommit = $FS::UID::AutoCommit;
 779   local $FS::UID::AutoCommit = 0;
 780   my $dbh = dbh;
 781
 782   #new-style exports!
 783   unless ( $noexport_hack ) {
 784     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 785       next unless $part_export->can($method);
 786       my $error = $part_export->$method($self, @_);
 787       if ( $error ) {
 788         $dbh->rollback if $oldAutoCommit;
 789         return "error exporting $method event to ". $part_export->exporttype.
 790                " (transaction rolled back): $error";
 791       }
 792     }
 793   }
 794
 795   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 796   '';
 797
 798 }
 799
 800 =item overlimit
 801
 802 Sets or retrieves overlimit date.
 803
 804 =cut
 805
 806 sub overlimit {
 807   my $self = shift;
 808   #$self->cust_svc->overlimit(@_);
 809   my $cust_svc = $self->cust_svc;
 810   unless ( $cust_svc ) { #wtf?
 811     my $error = "$me overlimit: missing cust_svc record for svc_acct svcnum ".
 812                 $self->svcnum;
 813     if ( $overlimit_missing_cust_svc_nonfatal_kludge ) {
 814       cluck "$error; continuing anyway as requested";
 815       return '';
 816     } else {
 817       confess $error;
 818     }
 819   }
 820   $cust_svc->overlimit(@_);
 821 }
 822
 823 =item cancel
 824
 825 Stub - returns false (no error) so derived classes don't need to define this
 826 methods.  Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 827
 828 This method is called *before* the deletion step which actually deletes the
 829 services.  This method should therefore only be used for "pre-deletion"
 830 cancellation steps, if necessary.
 831
 832 =cut
 833
 834 sub cancel { ''; }
 835
 836 =item clone_suspended
 837
 838 Constructor used by FS::part_export::_export_suspend fallback.  Stub returning
 839 same object for svc_ classes which don't implement a suspension fallback
 840 (everything except svc_acct at the moment).  Document better.
 841
 842 =cut
 843
 844 sub clone_suspended {
 845   shift;
 846 }
 847
 848 =item clone_kludge_unsuspend
 849
 850 Constructor used by FS::part_export::_export_unsuspend fallback.  Stub returning
 851 same object for svc_ classes which don't implement a suspension fallback
 852 (everything except svc_acct at the moment).  Document better.
 853
 854 =cut
 855
 856 sub clone_kludge_unsuspend {
 857   shift;
 858 }
 859
 860 =back
 861
 862 =head1 BUGS
 863
 864 The setfixed method return value.
 865
 866 B<export> method isn't used by insert and replace methods yet.
 867
 868 =head1 SEE ALSO
 869
 870 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
 871 from the base documentation.
 872
 873 =cut
 874
 875 1;
 876