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