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