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