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->set_auto_inventory
 259               || $self->check
 260               || $self->_check_duplicate
 261               || $self->SUPER::insert;
 262   if ( $error ) {
 263     $dbh->rollback if $oldAutoCommit;
 264     return $error;
 265   }
 266
 267   foreach my $object ( @$objects ) {
 268     my($field, $obj);
 269     if ( ref($object) eq 'ARRAY' ) {
 270       ($obj, $field) = @$object;
 271     } else {
 272       $obj = $object;
 273       $field = 'svcnum';
 274     }
 275     $obj->$field($self->svcnum);
 276     $error = $obj->insert;
 277     if ( $error ) {
 278       $dbh->rollback if $oldAutoCommit;
 279       return $error;
 280     }
 281   }
 282
 283   #new-style exports!
 284   unless ( $noexport_hack ) {
 285
 286     warn "[$me] insert: \$FS::queue::jobnums is $FS::queue::jobnums\n"
 287       if $DEBUG;
 288
 289     my $export_args = $options{'export_args'} || [];
 290
 291     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 292       my $error = $part_export->export_insert($self, @$export_args);
 293       if ( $error ) {
 294         $dbh->rollback if $oldAutoCommit;
 295         return "exporting to ". $part_export->exporttype.
 296                " (transaction rolled back): $error";
 297       }
 298     }
 299
 300     foreach my $depend_jobnum ( @$depend_jobnums ) {
 301       warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
 302         if $DEBUG;
 303       foreach my $jobnum ( @jobnums ) {
 304         my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
 305         warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
 306           if $DEBUG;
 307         my $error = $queue->depend_insert($depend_jobnum);
 308         if ( $error ) {
 309           $dbh->rollback if $oldAutoCommit;
 310           return "error queuing job dependancy: $error";
 311         }
 312       }
 313     }
 314
 315   }
 316
 317   if ( exists $options{'jobnums'} ) {
 318     push @{ $options{'jobnums'} }, @jobnums;
 319   }
 320
 321   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 322
 323   '';
 324 }
 325
 326 #fallbacks
 327 sub _check_duplcate { ''; }
 328 sub table_dupcheck_fields { (); }
 329
 330 =item delete [ , OPTION => VALUE ... ]
 331
 332 Deletes this account from the database.  If there is an error, returns the
 333 error, otherwise returns false.
 334
 335 The corresponding FS::cust_svc record will be deleted as well.
 336
 337 =cut
 338
 339 sub delete {
 340   my $self = shift;
 341   my %options = @_;
 342   my $export_args = $options{'export_args'} || [];
 343
 344   local $SIG{HUP} = 'IGNORE';
 345   local $SIG{INT} = 'IGNORE';
 346   local $SIG{QUIT} = 'IGNORE';
 347   local $SIG{TERM} = 'IGNORE';
 348   local $SIG{TSTP} = 'IGNORE';
 349   local $SIG{PIPE} = 'IGNORE';
 350
 351   my $oldAutoCommit = $FS::UID::AutoCommit;
 352   local $FS::UID::AutoCommit = 0;
 353   my $dbh = dbh;
 354
 355   my $error =    $self->SUPER::delete
 356               || $self->export('delete', @$export_args)
 357               || $self->return_inventory
 358               || $self->cust_svc->delete
 359   ;
 360   if ( $error ) {
 361     $dbh->rollback if $oldAutoCommit;
 362     return $error;
 363   }
 364
 365   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 366
 367   '';
 368 }
 369
 370 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ]
 371
 372 Replaces OLD_RECORD with this one.  If there is an error, returns the error,
 373 otherwise returns false.
 374
 375 =cut
 376
 377 sub replace {
 378   my $new = shift;
 379
 380   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
 381               ? shift
 382               : $new->replace_old;
 383
 384   my $options =
 385     ( ref($_[0]) eq 'HASH' )
 386       ? shift
 387       : { @_ };
 388
 389   local $SIG{HUP} = 'IGNORE';
 390   local $SIG{INT} = 'IGNORE';
 391   local $SIG{QUIT} = 'IGNORE';
 392   local $SIG{TERM} = 'IGNORE';
 393   local $SIG{TSTP} = 'IGNORE';
 394   local $SIG{PIPE} = 'IGNORE';
 395
 396   my $oldAutoCommit = $FS::UID::AutoCommit;
 397   local $FS::UID::AutoCommit = 0;
 398   my $dbh = dbh;
 399
 400   my $error = $new->set_auto_inventory;
 401   if ( $error ) {
 402     $dbh->rollback if $oldAutoCommit;
 403     return $error;
 404   }
 405
 406   #redundant, but so any duplicate fields are maniuplated as appropriate
 407   # (svc_phone.phonenum)
 408   $error = $new->check;
 409   if ( $error ) {
 410     $dbh->rollback if $oldAutoCommit;
 411     return $error;
 412   }
 413
 414   #if ( $old->username ne $new->username || $old->domsvc != $new->domsvc ) {
 415   if ( grep { $old->$_ ne $new->$_ } $new->table_dupcheck_fields ) {
 416
 417     $new->svcpart( $new->cust_svc->svcpart ) unless $new->svcpart;
 418     $error = $new->_check_duplicate;
 419     if ( $error ) {
 420       $dbh->rollback if $oldAutoCommit;
 421       return $error;
 422     }
 423   }
 424
 425   $error = $new->SUPER::replace($old);
 426   if ($error) {
 427     $dbh->rollback if $oldAutoCommit;
 428     return $error;
 429   }
 430
 431   #new-style exports!
 432   unless ( $noexport_hack ) {
 433
 434     my $export_args = $options->{'export_args'} || [];
 435
 436     #not quite false laziness, but same pattern as FS::svc_acct::replace and
 437     #FS::part_export::sqlradius::_export_replace.  List::Compare or something
 438     #would be useful but too much of a pain in the ass to deploy
 439
 440     my @old_part_export = $old->cust_svc->part_svc->part_export;
 441     my %old_exportnum = map { $_->exportnum => 1 } @old_part_export;
 442     my @new_part_export =
 443       $new->svcpart
 444         ? qsearchs('part_svc', { svcpart=>$new->svcpart } )->part_export
 445         : $new->cust_svc->part_svc->part_export;
 446     my %new_exportnum = map { $_->exportnum => 1 } @new_part_export;
 447
 448     foreach my $delete_part_export (
 449       grep { ! $new_exportnum{$_->exportnum} } @old_part_export
 450     ) {
 451       my $error = $delete_part_export->export_delete($old, @$export_args);
 452       if ( $error ) {
 453         $dbh->rollback if $oldAutoCommit;
 454         return "error deleting, export to ". $delete_part_export->exporttype.
 455                " (transaction rolled back): $error";
 456       }
 457     }
 458
 459     foreach my $replace_part_export (
 460       grep { $old_exportnum{$_->exportnum} } @new_part_export
 461     ) {
 462       my $error =
 463         $replace_part_export->export_replace( $new, $old, @$export_args);
 464       if ( $error ) {
 465         $dbh->rollback if $oldAutoCommit;
 466         return "error exporting to ". $replace_part_export->exporttype.
 467                " (transaction rolled back): $error";
 468       }
 469     }
 470
 471     foreach my $insert_part_export (
 472       grep { ! $old_exportnum{$_->exportnum} } @new_part_export
 473     ) {
 474       my $error = $insert_part_export->export_insert($new, @$export_args );
 475       if ( $error ) {
 476         $dbh->rollback if $oldAutoCommit;
 477         return "error inserting export to ". $insert_part_export->exporttype.
 478                " (transaction rolled back): $error";
 479       }
 480     }
 481
 482   }
 483
 484   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 485   '';
 486 }
 487
 488 =item setfixed
 489
 490 Sets any fixed fields for this service (see L<FS::part_svc>).  If there is an
 491 error, returns the error, otherwise returns the FS::part_svc object (use ref()
 492 to test the return).  Usually called by the check method.
 493
 494 =cut
 495
 496 sub setfixed {
 497   my $self = shift;
 498   $self->setx('F', @_);
 499 }
 500
 501 =item setdefault
 502
 503 Sets all fields to their defaults (see L<FS::part_svc>), overriding their
 504 current values.  If there is an error, returns the error, otherwise returns
 505 the FS::part_svc object (use ref() to test the return).
 506
 507 =cut
 508
 509 sub setdefault {
 510   my $self = shift;
 511   $self->setx('D', @_ );
 512 }
 513
 514 =item set_default_and_fixed
 515
 516 =cut
 517
 518 sub set_default_and_fixed {
 519   my $self = shift;
 520   $self->setx( [ 'D', 'F' ], @_ );
 521 }
 522
 523 =item setx FLAG | FLAG_ARRAYREF , [ CALLBACK_HASHREF ]
 524
 525 Sets fields according to the passed in flag or arrayref of flags.
 526
 527 Optionally, a hashref of field names and callback coderefs can be passed.
 528 If a coderef exists for a given field name, instead of setting the field,
 529 the coderef is called with the column value (part_svc_column.columnvalue)
 530 as the single parameter.
 531
 532 =cut
 533
 534 sub setx {
 535   my $self = shift;
 536   my $x = shift;
 537   my @x = ref($x) ? @$x : ($x);
 538   my $coderef = scalar(@_) ? shift : $self->_fieldhandlers;
 539
 540   my $error =
 541     $self->ut_numbern('svcnum')
 542   ;
 543   return $error if $error;
 544
 545   my $part_svc = $self->part_svc;
 546   return "Unknown svcpart" unless $part_svc;
 547
 548   #set default/fixed/whatever fields from part_svc
 549
 550   foreach my $part_svc_column (
 551     grep { my $f = $_->columnflag; grep { $f eq $_ } @x } #columnflag in @x
 552     $part_svc->all_part_svc_column
 553   ) {
 554
 555     my $columnname  = $part_svc_column->columnname;
 556     my $columnvalue = $part_svc_column->columnvalue;
 557
 558     $columnvalue = &{ $coderef->{$columnname} }( $self, $columnvalue )
 559       if exists( $coderef->{$columnname} );
 560     $self->setfield( $columnname, $columnvalue );
 561
 562   }
 563
 564  $part_svc;
 565
 566 }
 567
 568 sub part_svc {
 569   my $self = shift;
 570
 571   #get part_svc
 572   my $svcpart;
 573   if ( $self->get('svcpart') ) {
 574     $svcpart = $self->get('svcpart');
 575   } elsif ( $self->svcnum && qsearchs('cust_svc', {'svcnum'=>$self->svcnum}) ) {
 576     my $cust_svc = $self->cust_svc;
 577     return "Unknown svcnum" unless $cust_svc;
 578     $svcpart = $cust_svc->svcpart;
 579   }
 580
 581   qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
 582
 583 }
 584
 585 =item set_auto_inventory
 586
 587 Sets any fields which auto-populate from inventory (see L<FS::part_svc>).
 588 If there is an error, returns the error, otherwise returns false.
 589
 590 =cut
 591
 592 sub set_auto_inventory {
 593   my $self = shift;
 594
 595   my $error =
 596     $self->ut_numbern('svcnum')
 597   ;
 598   return $error if $error;
 599
 600   my $part_svc = $self->part_svc;
 601   return "Unkonwn svcpart" unless $part_svc;
 602
 603   local $SIG{HUP} = 'IGNORE';
 604   local $SIG{INT} = 'IGNORE';
 605   local $SIG{QUIT} = 'IGNORE';
 606   local $SIG{TERM} = 'IGNORE';
 607   local $SIG{TSTP} = 'IGNORE';
 608   local $SIG{PIPE} = 'IGNORE';
 609
 610   my $oldAutoCommit = $FS::UID::AutoCommit;
 611   local $FS::UID::AutoCommit = 0;
 612   my $dbh = dbh;
 613
 614   #set default/fixed/whatever fields from part_svc
 615   my $table = $self->table;
 616   foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
 617     my $part_svc_column = $part_svc->part_svc_column($field);
 618     if ( $part_svc_column->columnflag eq 'A' && $self->$field() eq '' ) {
 619
 620       my $classnum = $part_svc_column->columnvalue;
 621       my $inventory_item = qsearchs({
 622         'table'     => 'inventory_item',
 623         'hashref'   => { 'classnum' => $classnum,
 624                          'svcnum'   => '',
 625                        },
 626         'extra_sql' => 'LIMIT 1 FOR UPDATE',
 627       });
 628
 629       unless ( $inventory_item ) {
 630         $dbh->rollback if $oldAutoCommit;
 631         my $inventory_class =
 632           qsearchs('inventory_class', { 'classnum' => $classnum } );
 633         return "Can't find inventory_class.classnum $classnum"
 634           unless $inventory_class;
 635         return "Out of ". $inventory_class->classname. "s\n"; #Lingua:: BS
 636                                                               #for pluralizing
 637       }
 638
 639       $inventory_item->svcnum( $self->svcnum );
 640       my $ierror = $inventory_item->replace();
 641       if ( $ierror ) {
 642         $dbh->rollback if $oldAutoCommit;
 643         return "Error provisioning inventory: $ierror";
 644
 645       }
 646
 647       $self->setfield( $field, $inventory_item->item );
 648
 649     }
 650   }
 651
 652  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 653
 654  '';
 655
 656 }
 657
 658 =item return_inventory
 659
 660 =cut
 661
 662 sub return_inventory {
 663   my $self = shift;
 664
 665   local $SIG{HUP} = 'IGNORE';
 666   local $SIG{INT} = 'IGNORE';
 667   local $SIG{QUIT} = 'IGNORE';
 668   local $SIG{TERM} = 'IGNORE';
 669   local $SIG{TSTP} = 'IGNORE';
 670   local $SIG{PIPE} = 'IGNORE';
 671
 672   my $oldAutoCommit = $FS::UID::AutoCommit;
 673   local $FS::UID::AutoCommit = 0;
 674   my $dbh = dbh;
 675
 676   foreach my $inventory_item ( $self->inventory_item ) {
 677     $inventory_item->svcnum('');
 678     my $error = $inventory_item->replace();
 679     if ( $error ) {
 680       $dbh->rollback if $oldAutoCommit;
 681       return "Error returning inventory: $error";
 682     }
 683   }
 684
 685   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 686
 687   '';
 688 }
 689
 690 =item inventory_item
 691
 692 Returns the inventory items associated with this svc_ record, as
 693 FS::inventory_item objects (see L<FS::inventory_item>.
 694
 695 =cut
 696
 697 sub inventory_item {
 698   my $self = shift;
 699   qsearch({
 700     'table'     => 'inventory_item',
 701     'hashref'   => { 'svcnum' => $self->svcnum, },
 702   });
 703 }
 704
 705 =item cust_svc
 706
 707 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
 708 object (see L<FS::cust_svc>).
 709
 710 =cut
 711
 712 sub cust_svc {
 713   my $self = shift;
 714   qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
 715 }
 716
 717 =item suspend
 718
 719 Runs export_suspend callbacks.
 720
 721 =cut
 722
 723 sub suspend {
 724   my $self = shift;
 725   my %options = @_;
 726   my $export_args = $options{'export_args'} || [];
 727   $self->export('suspend', @$export_args);
 728 }
 729
 730 =item unsuspend
 731
 732 Runs export_unsuspend callbacks.
 733
 734 =cut
 735
 736 sub unsuspend {
 737   my $self = shift;
 738   my %options = @_;
 739   my $export_args = $options{'export_args'} || [];
 740   $self->export('unsuspend', @$export_args);
 741 }
 742
 743 =item export_links
 744
 745 Runs export_links callbacks and returns the links.
 746
 747 =cut
 748
 749 sub export_links {
 750   my $self = shift;
 751   my $return = [];
 752   $self->export('links', $return);
 753   $return;
 754 }
 755
 756 =item export HOOK [ EXPORT_ARGS ]
 757
 758 Runs the provided export hook (i.e. "suspend", "unsuspend") for this service.
 759
 760 =cut
 761
 762 sub export {
 763   my( $self, $method ) = ( shift, shift );
 764
 765   $method = "export_$method" unless $method =~ /^export_/;
 766
 767   local $SIG{HUP} = 'IGNORE';
 768   local $SIG{INT} = 'IGNORE';
 769   local $SIG{QUIT} = 'IGNORE';
 770   local $SIG{TERM} = 'IGNORE';
 771   local $SIG{TSTP} = 'IGNORE';
 772   local $SIG{PIPE} = 'IGNORE';
 773
 774   my $oldAutoCommit = $FS::UID::AutoCommit;
 775   local $FS::UID::AutoCommit = 0;
 776   my $dbh = dbh;
 777
 778   #new-style exports!
 779   unless ( $noexport_hack ) {
 780     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 781       next unless $part_export->can($method);
 782       my $error = $part_export->$method($self, @_);
 783       if ( $error ) {
 784         $dbh->rollback if $oldAutoCommit;
 785         return "error exporting $method event to ". $part_export->exporttype.
 786                " (transaction rolled back): $error";
 787       }
 788     }
 789   }
 790
 791   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 792   '';
 793
 794 }
 795
 796 =item overlimit
 797
 798 Sets or retrieves overlimit date.
 799
 800 =cut
 801
 802 sub overlimit {
 803   my $self = shift;
 804   #$self->cust_svc->overlimit(@_);
 805   my $cust_svc = $self->cust_svc;
 806   unless ( $cust_svc ) { #wtf?
 807     my $error = "$me overlimit: missing cust_svc record for svc_acct svcnum ".
 808                 $self->svcnum;
 809     if ( $overlimit_missing_cust_svc_nonfatal_kludge ) {
 810       cluck "$error; continuing anyway as requested";
 811       return '';
 812     } else {
 813       confess $error;
 814     }
 815   }
 816   $cust_svc->overlimit(@_);
 817 }
 818
 819 =item cancel
 820
 821 Stub - returns false (no error) so derived classes don't need to define this
 822 methods.  Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 823
 824 This method is called *before* the deletion step which actually deletes the
 825 services.  This method should therefore only be used for "pre-deletion"
 826 cancellation steps, if necessary.
 827
 828 =cut
 829
 830 sub cancel { ''; }
 831
 832 =item clone_suspended
 833
 834 Constructor used by FS::part_export::_export_suspend fallback.  Stub returning
 835 same object for svc_ classes which don't implement a suspension fallback
 836 (everything except svc_acct at the moment).  Document better.
 837
 838 =cut
 839
 840 sub clone_suspended {
 841   shift;
 842 }
 843
 844 =item clone_kludge_unsuspend
 845
 846 Constructor used by FS::part_export::_export_unsuspend fallback.  Stub returning
 847 same object for svc_ classes which don't implement a suspension fallback
 848 (everything except svc_acct at the moment).  Document better.
 849
 850 =cut
 851
 852 sub clone_kludge_unsuspend {
 853   shift;
 854 }
 855
 856 =back
 857
 858 =head1 BUGS
 859
 860 The setfixed method return value.
 861
 862 B<export> method isn't used by insert and replace methods yet.
 863
 864 =head1 SEE ALSO
 865
 866 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
 867 from the base documentation.
 868
 869 =cut
 870
 871 1;
 872