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     warn "hi";
 668     %pbxes = map { $_->svcnum => $_->title } qsearch('svc_pbx', {} );
 669     warn %pbxes;
 670   }
 671
 672   if ($part_svc && $part_svc->part_svc_column('pbxsvc')->columnflag eq 'D') {
 673     my $svc_pbx = qsearchs('svc_pbx',
 674       { 'svcnum' => $part_svc->part_svc_column('pbxsvc')->columnvalue } );
 675     if ( $svc_pbx ) {
 676       $pbxes{$svc_pbx->svcnum}  = $svc_pbx->title;
 677     } else {
 678       warn "unknown svc_pbx.svcnum for part_svc_column pbxsvc: ".
 679            $part_svc->part_svc_column('pbxsvc')->columnvalue;
 680
 681     }
 682   }
 683
 684   (%pbxes);
 685
 686 }
 687
 688 =item set_auto_inventory
 689
 690 Sets any fields which auto-populate from inventory (see L<FS::part_svc>).
 691 If there is an error, returns the error, otherwise returns false.
 692
 693 =cut
 694
 695 sub set_auto_inventory {
 696   my $self = shift;
 697
 698   my $error =
 699     $self->ut_numbern('svcnum')
 700   ;
 701   return $error if $error;
 702
 703   my $part_svc = $self->part_svc;
 704   return "Unkonwn svcpart" unless $part_svc;
 705
 706   local $SIG{HUP} = 'IGNORE';
 707   local $SIG{INT} = 'IGNORE';
 708   local $SIG{QUIT} = 'IGNORE';
 709   local $SIG{TERM} = 'IGNORE';
 710   local $SIG{TSTP} = 'IGNORE';
 711   local $SIG{PIPE} = 'IGNORE';
 712
 713   my $oldAutoCommit = $FS::UID::AutoCommit;
 714   local $FS::UID::AutoCommit = 0;
 715   my $dbh = dbh;
 716
 717   #set default/fixed/whatever fields from part_svc
 718   my $table = $self->table;
 719   foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
 720     my $part_svc_column = $part_svc->part_svc_column($field);
 721     if ( $part_svc_column->columnflag eq 'A' && $self->$field() eq '' ) {
 722
 723       my $classnum = $part_svc_column->columnvalue;
 724       my $inventory_item = qsearchs({
 725         'table'     => 'inventory_item',
 726         'hashref'   => { 'classnum' => $classnum,
 727                          'svcnum'   => '',
 728                        },
 729         'extra_sql' => 'LIMIT 1 FOR UPDATE',
 730       });
 731
 732       unless ( $inventory_item ) {
 733         $dbh->rollback if $oldAutoCommit;
 734         my $inventory_class =
 735           qsearchs('inventory_class', { 'classnum' => $classnum } );
 736         return "Can't find inventory_class.classnum $classnum"
 737           unless $inventory_class;
 738         return "Out of ". $inventory_class->classname. "s\n"; #Lingua:: BS
 739                                                               #for pluralizing
 740       }
 741
 742       $inventory_item->svcnum( $self->svcnum );
 743       my $ierror = $inventory_item->replace();
 744       if ( $ierror ) {
 745         $dbh->rollback if $oldAutoCommit;
 746         return "Error provisioning inventory: $ierror";
 747
 748       }
 749
 750       $self->setfield( $field, $inventory_item->item );
 751
 752     }
 753   }
 754
 755  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 756
 757  '';
 758
 759 }
 760
 761 =item return_inventory
 762
 763 =cut
 764
 765 sub return_inventory {
 766   my $self = shift;
 767
 768   local $SIG{HUP} = 'IGNORE';
 769   local $SIG{INT} = 'IGNORE';
 770   local $SIG{QUIT} = 'IGNORE';
 771   local $SIG{TERM} = 'IGNORE';
 772   local $SIG{TSTP} = 'IGNORE';
 773   local $SIG{PIPE} = 'IGNORE';
 774
 775   my $oldAutoCommit = $FS::UID::AutoCommit;
 776   local $FS::UID::AutoCommit = 0;
 777   my $dbh = dbh;
 778
 779   foreach my $inventory_item ( $self->inventory_item ) {
 780     $inventory_item->svcnum('');
 781     my $error = $inventory_item->replace();
 782     if ( $error ) {
 783       $dbh->rollback if $oldAutoCommit;
 784       return "Error returning inventory: $error";
 785     }
 786   }
 787
 788   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 789
 790   '';
 791 }
 792
 793 =item inventory_item
 794
 795 Returns the inventory items associated with this svc_ record, as
 796 FS::inventory_item objects (see L<FS::inventory_item>.
 797
 798 =cut
 799
 800 sub inventory_item {
 801   my $self = shift;
 802   qsearch({
 803     'table'     => 'inventory_item',
 804     'hashref'   => { 'svcnum' => $self->svcnum, },
 805   });
 806 }
 807
 808 =item cust_svc
 809
 810 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
 811 object (see L<FS::cust_svc>).
 812
 813 =cut
 814
 815 sub cust_svc {
 816   my $self = shift;
 817   qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
 818 }
 819
 820 =item suspend
 821
 822 Runs export_suspend callbacks.
 823
 824 =cut
 825
 826 sub suspend {
 827   my $self = shift;
 828   my %options = @_;
 829   my $export_args = $options{'export_args'} || [];
 830   $self->export('suspend', @$export_args);
 831 }
 832
 833 =item unsuspend
 834
 835 Runs export_unsuspend callbacks.
 836
 837 =cut
 838
 839 sub unsuspend {
 840   my $self = shift;
 841   my %options = @_;
 842   my $export_args = $options{'export_args'} || [];
 843   $self->export('unsuspend', @$export_args);
 844 }
 845
 846 =item export_links
 847
 848 Runs export_links callbacks and returns the links.
 849
 850 =cut
 851
 852 sub export_links {
 853   my $self = shift;
 854   my $return = [];
 855   $self->export('links', $return);
 856   $return;
 857 }
 858
 859 =item export HOOK [ EXPORT_ARGS ]
 860
 861 Runs the provided export hook (i.e. "suspend", "unsuspend") for this service.
 862
 863 =cut
 864
 865 sub export {
 866   my( $self, $method ) = ( shift, shift );
 867
 868   $method = "export_$method" unless $method =~ /^export_/;
 869
 870   local $SIG{HUP} = 'IGNORE';
 871   local $SIG{INT} = 'IGNORE';
 872   local $SIG{QUIT} = 'IGNORE';
 873   local $SIG{TERM} = 'IGNORE';
 874   local $SIG{TSTP} = 'IGNORE';
 875   local $SIG{PIPE} = 'IGNORE';
 876
 877   my $oldAutoCommit = $FS::UID::AutoCommit;
 878   local $FS::UID::AutoCommit = 0;
 879   my $dbh = dbh;
 880
 881   #new-style exports!
 882   unless ( $noexport_hack ) {
 883     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 884       next unless $part_export->can($method);
 885       my $error = $part_export->$method($self, @_);
 886       if ( $error ) {
 887         $dbh->rollback if $oldAutoCommit;
 888         return "error exporting $method event to ". $part_export->exporttype.
 889                " (transaction rolled back): $error";
 890       }
 891     }
 892   }
 893
 894   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 895   '';
 896
 897 }
 898
 899 =item overlimit
 900
 901 Sets or retrieves overlimit date.
 902
 903 =cut
 904
 905 sub overlimit {
 906   my $self = shift;
 907   #$self->cust_svc->overlimit(@_);
 908   my $cust_svc = $self->cust_svc;
 909   unless ( $cust_svc ) { #wtf?
 910     my $error = "$me overlimit: missing cust_svc record for svc_acct svcnum ".
 911                 $self->svcnum;
 912     if ( $overlimit_missing_cust_svc_nonfatal_kludge ) {
 913       cluck "$error; continuing anyway as requested";
 914       return '';
 915     } else {
 916       confess $error;
 917     }
 918   }
 919   $cust_svc->overlimit(@_);
 920 }
 921
 922 =item cancel
 923
 924 Stub - returns false (no error) so derived classes don't need to define this
 925 methods.  Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 926
 927 This method is called *before* the deletion step which actually deletes the
 928 services.  This method should therefore only be used for "pre-deletion"
 929 cancellation steps, if necessary.
 930
 931 =cut
 932
 933 sub cancel { ''; }
 934
 935 =item clone_suspended
 936
 937 Constructor used by FS::part_export::_export_suspend fallback.  Stub returning
 938 same object for svc_ classes which don't implement a suspension fallback
 939 (everything except svc_acct at the moment).  Document better.
 940
 941 =cut
 942
 943 sub clone_suspended {
 944   shift;
 945 }
 946
 947 =item clone_kludge_unsuspend
 948
 949 Constructor used by FS::part_export::_export_unsuspend fallback.  Stub returning
 950 same object for svc_ classes which don't implement a suspension fallback
 951 (everything except svc_acct at the moment).  Document better.
 952
 953 =cut
 954
 955 sub clone_kludge_unsuspend {
 956   shift;
 957 }
 958
 959 =back
 960
 961 =head1 BUGS
 962
 963 The setfixed method return value.
 964
 965 B<export> method isn't used by insert and replace methods yet.
 966
 967 =head1 SEE ALSO
 968
 969 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
 970 from the base documentation.
 971
 972 =cut
 973
 974 1;
 975