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