FS/FS/svc_Common.pm

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