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