FS/FS/svc_Common.pm

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