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