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($old);
 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>), and
 689 also check any manually populated inventory fields.
 690
 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   my $old = @_ ? shift : '';
 698
 699   my $error =
 700     $self->ut_numbern('svcnum')
 701   ;
 702   return $error if $error;
 703
 704   my $part_svc = $self->part_svc;
 705   return "Unkonwn svcpart" unless $part_svc;
 706
 707   local $SIG{HUP} = 'IGNORE';
 708   local $SIG{INT} = 'IGNORE';
 709   local $SIG{QUIT} = 'IGNORE';
 710   local $SIG{TERM} = 'IGNORE';
 711   local $SIG{TSTP} = 'IGNORE';
 712   local $SIG{PIPE} = 'IGNORE';
 713
 714   my $oldAutoCommit = $FS::UID::AutoCommit;
 715   local $FS::UID::AutoCommit = 0;
 716   my $dbh = dbh;
 717
 718   #set default/fixed/whatever fields from part_svc
 719   my $table = $self->table;
 720   foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
 721
 722     my $part_svc_column = $part_svc->part_svc_column($field);
 723     my $columnflag = $part_svc_column->columnflag;
 724     next unless $columnflag =~ /^[AM]$/;
 725
 726     next if $columnflag eq 'A' && $self->$field() ne '';
 727
 728     my $classnum = $part_svc_column->columnvalue;
 729     my %hash = ( 'classnum' => $classnum );
 730
 731     if ( $columnflag eq 'A' && $self->$field() eq '' ) {
 732       $hash{'svcnum'} = '';
 733     } elsif ( $columnflag eq 'M' ) {
 734       return "Select inventory item for $field" unless $self->getfield($field);
 735       $hash{'item'} = $self->getfield($field);
 736     }
 737
 738     my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql(
 739       'null'  => 1,
 740       'table' => 'inventory_item',
 741     );
 742
 743     my $inventory_item = qsearchs({
 744       'table'     => 'inventory_item',
 745       'hashref'   => \%hash,
 746       'extra_sql' => "AND $agentnums_sql",
 747       'order_by'  => 'ORDER BY ( agentnum IS NULL ) '. #agent inventory first
 748                      ' LIMIT 1 FOR UPDATE',
 749     });
 750
 751     unless ( $inventory_item ) {
 752       $dbh->rollback if $oldAutoCommit;
 753       my $inventory_class =
 754         qsearchs('inventory_class', { 'classnum' => $classnum } );
 755       return "Can't find inventory_class.classnum $classnum"
 756         unless $inventory_class;
 757       return "Out of ". $inventory_class->classname. "s\n"; #Lingua:: BS
 758                                                             #for pluralizing
 759     }
 760
 761     next if $columnflag eq 'M' && $inventory_item->svcnum == $self->svcnum;
 762
 763     $self->setfield( $field, $inventory_item->item );
 764       #if $columnflag eq 'A' && $self->$field() eq '';
 765
 766     $inventory_item->svcnum( $self->svcnum );
 767     my $ierror = $inventory_item->replace();
 768     if ( $ierror ) {
 769       $dbh->rollback if $oldAutoCommit;
 770       return "Error provisioning inventory: $ierror";
 771     }
 772
 773     if ( $old && $old->$field() && $old->$field() ne $self->$field() ) {
 774       my $old_inv = qsearchs({
 775         'table'   => 'inventory_item',
 776         'hashref' => { 'classnum' => $classnum,
 777                        'svcnum'   => $old->svcnum,
 778                        'item'     => $old->$field(),
 779                      },
 780       });
 781       if ( $old_inv ) {
 782         $old_inv->svcnum('');
 783         my $oerror = $old_inv->replace;
 784         if ( $oerror ) {
 785           $dbh->rollback if $oldAutoCommit;
 786           return "Error unprovisioning inventory: $oerror";
 787         }
 788       }
 789     }
 790
 791   }
 792
 793  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 794
 795  '';
 796
 797 }
 798
 799 =item return_inventory
 800
 801 =cut
 802
 803 sub return_inventory {
 804   my $self = shift;
 805
 806   local $SIG{HUP} = 'IGNORE';
 807   local $SIG{INT} = 'IGNORE';
 808   local $SIG{QUIT} = 'IGNORE';
 809   local $SIG{TERM} = 'IGNORE';
 810   local $SIG{TSTP} = 'IGNORE';
 811   local $SIG{PIPE} = 'IGNORE';
 812
 813   my $oldAutoCommit = $FS::UID::AutoCommit;
 814   local $FS::UID::AutoCommit = 0;
 815   my $dbh = dbh;
 816
 817   foreach my $inventory_item ( $self->inventory_item ) {
 818     $inventory_item->svcnum('');
 819     my $error = $inventory_item->replace();
 820     if ( $error ) {
 821       $dbh->rollback if $oldAutoCommit;
 822       return "Error returning inventory: $error";
 823     }
 824   }
 825
 826   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 827
 828   '';
 829 }
 830
 831 =item inventory_item
 832
 833 Returns the inventory items associated with this svc_ record, as
 834 FS::inventory_item objects (see L<FS::inventory_item>.
 835
 836 =cut
 837
 838 sub inventory_item {
 839   my $self = shift;
 840   qsearch({
 841     'table'     => 'inventory_item',
 842     'hashref'   => { 'svcnum' => $self->svcnum, },
 843   });
 844 }
 845
 846 =item cust_svc
 847
 848 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
 849 object (see L<FS::cust_svc>).
 850
 851 =cut
 852
 853 sub cust_svc {
 854   my $self = shift;
 855   qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
 856 }
 857
 858 =item suspend
 859
 860 Runs export_suspend callbacks.
 861
 862 =cut
 863
 864 sub suspend {
 865   my $self = shift;
 866   my %options = @_;
 867   my $export_args = $options{'export_args'} || [];
 868   $self->export('suspend', @$export_args);
 869 }
 870
 871 =item unsuspend
 872
 873 Runs export_unsuspend callbacks.
 874
 875 =cut
 876
 877 sub unsuspend {
 878   my $self = shift;
 879   my %options = @_;
 880   my $export_args = $options{'export_args'} || [];
 881   $self->export('unsuspend', @$export_args);
 882 }
 883
 884 =item export_links
 885
 886 Runs export_links callbacks and returns the links.
 887
 888 =cut
 889
 890 sub export_links {
 891   my $self = shift;
 892   my $return = [];
 893   $self->export('links', $return);
 894   $return;
 895 }
 896
 897 =item export_getsettings
 898
 899 Runs export_getsettings callbacks and returns the two hashrefs.
 900
 901 =cut
 902
 903 sub export_getsettings {
 904   my $self = shift;
 905   my %settings = ();
 906   my %defaults = ();
 907   my $error = $self->export('getsettings', \%settings, \%defaults);
 908   if ( $error ) {
 909     #XXX bubble this up better
 910     warn "error running export_getsetings: $error";
 911     return ( {}, {} );
 912   }
 913   ( \%settings, \%defaults );
 914 }
 915
 916 =item export HOOK [ EXPORT_ARGS ]
 917
 918 Runs the provided export hook (i.e. "suspend", "unsuspend") for this service.
 919
 920 =cut
 921
 922 sub export {
 923   my( $self, $method ) = ( shift, shift );
 924
 925   $method = "export_$method" unless $method =~ /^export_/;
 926
 927   local $SIG{HUP} = 'IGNORE';
 928   local $SIG{INT} = 'IGNORE';
 929   local $SIG{QUIT} = 'IGNORE';
 930   local $SIG{TERM} = 'IGNORE';
 931   local $SIG{TSTP} = 'IGNORE';
 932   local $SIG{PIPE} = 'IGNORE';
 933
 934   my $oldAutoCommit = $FS::UID::AutoCommit;
 935   local $FS::UID::AutoCommit = 0;
 936   my $dbh = dbh;
 937
 938   #new-style exports!
 939   unless ( $noexport_hack ) {
 940     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 941       next unless $part_export->can($method);
 942       my $error = $part_export->$method($self, @_);
 943       if ( $error ) {
 944         $dbh->rollback if $oldAutoCommit;
 945         return "error exporting $method event to ". $part_export->exporttype.
 946                " (transaction rolled back): $error";
 947       }
 948     }
 949   }
 950
 951   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 952   '';
 953
 954 }
 955
 956 =item overlimit
 957
 958 Sets or retrieves overlimit date.
 959
 960 =cut
 961
 962 sub overlimit {
 963   my $self = shift;
 964   #$self->cust_svc->overlimit(@_);
 965   my $cust_svc = $self->cust_svc;
 966   unless ( $cust_svc ) { #wtf?
 967     my $error = "$me overlimit: missing cust_svc record for svc_acct svcnum ".
 968                 $self->svcnum;
 969     if ( $overlimit_missing_cust_svc_nonfatal_kludge ) {
 970       cluck "$error; continuing anyway as requested";
 971       return '';
 972     } else {
 973       confess $error;
 974     }
 975   }
 976   $cust_svc->overlimit(@_);
 977 }
 978
 979 =item cancel
 980
 981 Stub - returns false (no error) so derived classes don't need to define this
 982 methods.  Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 983
 984 This method is called *before* the deletion step which actually deletes the
 985 services.  This method should therefore only be used for "pre-deletion"
 986 cancellation steps, if necessary.
 987
 988 =cut
 989
 990 sub cancel { ''; }
 991
 992 =item clone_suspended
 993
 994 Constructor used by FS::part_export::_export_suspend fallback.  Stub returning
 995 same object for svc_ classes which don't implement a suspension fallback
 996 (everything except svc_acct at the moment).  Document better.
 997
 998 =cut
 999
1000 sub clone_suspended {
1001   shift;
1002 }
1003
1004 =item clone_kludge_unsuspend
1005
1006 Constructor used by FS::part_export::_export_unsuspend fallback.  Stub returning
1007 same object for svc_ classes which don't implement a suspension fallback
1008 (everything except svc_acct at the moment).  Document better.
1009
1010 =cut
1011
1012 sub clone_kludge_unsuspend {
1013   shift;
1014 }
1015
1016 =item find_duplicates MODE FIELDS...
1017
1018 Method used by _check_duplicate routines to find services with duplicate
1019 values in specified fields.  Set MODE to 'global' to search across all
1020 services, or 'export' to limit to those that share one or more exports
1021 with this service.  FIELDS is a list of field names; only services
1022 matching in all fields will be returned.  Empty fields will be skipped.
1023
1024 =cut
1025
1026 sub find_duplicates {
1027   my $self = shift;
1028   my $mode = shift;
1029   my @fields = @_;
1030
1031   my %search = map { $_ => $self->getfield($_) }
1032                grep { length($self->getfield($_)) } @fields;
1033   return () if !%search;
1034   my @dup = grep { ! $self->svcnum or $_->svcnum != $self->svcnum }
1035             qsearch( $self->table, \%search );
1036   return () if !@dup;
1037   return @dup if $mode eq 'global';
1038   die "incorrect find_duplicates mode '$mode'" if $mode ne 'export';
1039
1040   my $exports = FS::part_export::export_info($self->table);
1041   my %conflict_svcparts;
1042   my $part_svc = $self->part_svc;
1043   foreach my $part_export ( $part_svc->part_export ) {
1044     %conflict_svcparts = map { $_->svcpart => 1 } $part_export->export_svc;
1045   }
1046   return grep { $conflict_svcparts{$_->cust_svc->svcpart} } @dup;
1047 }
1048
1049
1050
1051
1052 =back
1053
1054 =head1 BUGS
1055
1056 The setfixed method return value.
1057
1058 B<export> method isn't used by insert and replace methods yet.
1059
1060 =head1 SEE ALSO
1061
1062 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
1063 from the base documentation.
1064
1065 =cut
1066
1067 1;
1068