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