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 sub predelete_hook { ''; }
 334 sub predelete_hook_first { ''; }
 335
 336 =item delete [ , OPTION => VALUE ... ]
 337
 338 Deletes this account from the database.  If there is an error, returns the
 339 error, otherwise returns false.
 340
 341 The corresponding FS::cust_svc record will be deleted as well.
 342
 343 =cut
 344
 345 sub delete {
 346   my $self = shift;
 347   my %options = @_;
 348   my $export_args = $options{'export_args'} || [];
 349
 350   local $SIG{HUP} = 'IGNORE';
 351   local $SIG{INT} = 'IGNORE';
 352   local $SIG{QUIT} = 'IGNORE';
 353   local $SIG{TERM} = 'IGNORE';
 354   local $SIG{TSTP} = 'IGNORE';
 355   local $SIG{PIPE} = 'IGNORE';
 356
 357   my $oldAutoCommit = $FS::UID::AutoCommit;
 358   local $FS::UID::AutoCommit = 0;
 359   my $dbh = dbh;
 360
 361   my $error =   $self->predelete_hook_first
 362               || $self->SUPER::delete
 363               || $self->export('delete', @$export_args)
 364               || $self->return_inventory
 365               || $self->predelete_hook
 366               || $self->cust_svc->delete
 367   ;
 368   if ( $error ) {
 369     $dbh->rollback if $oldAutoCommit;
 370     return $error;
 371   }
 372
 373   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 374
 375   '';
 376 }
 377
 378 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ]
 379
 380 Replaces OLD_RECORD with this one.  If there is an error, returns the error,
 381 otherwise returns false.
 382
 383 =cut
 384
 385 sub replace {
 386   my $new = shift;
 387
 388   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
 389               ? shift
 390               : $new->replace_old;
 391
 392   my $options =
 393     ( ref($_[0]) eq 'HASH' )
 394       ? shift
 395       : { @_ };
 396
 397   local $SIG{HUP} = 'IGNORE';
 398   local $SIG{INT} = 'IGNORE';
 399   local $SIG{QUIT} = 'IGNORE';
 400   local $SIG{TERM} = 'IGNORE';
 401   local $SIG{TSTP} = 'IGNORE';
 402   local $SIG{PIPE} = 'IGNORE';
 403
 404   my $oldAutoCommit = $FS::UID::AutoCommit;
 405   local $FS::UID::AutoCommit = 0;
 406   my $dbh = dbh;
 407
 408   my $error = $new->set_auto_inventory($old);
 409   if ( $error ) {
 410     $dbh->rollback if $oldAutoCommit;
 411     return $error;
 412   }
 413
 414   #redundant, but so any duplicate fields are maniuplated as appropriate
 415   # (svc_phone.phonenum)
 416   $error = $new->check;
 417   if ( $error ) {
 418     $dbh->rollback if $oldAutoCommit;
 419     return $error;
 420   }
 421
 422   #if ( $old->username ne $new->username || $old->domsvc != $new->domsvc ) {
 423   if ( grep { $old->$_ ne $new->$_ } $new->table_dupcheck_fields ) {
 424
 425     $new->svcpart( $new->cust_svc->svcpart ) unless $new->svcpart;
 426     $error = $new->_check_duplicate;
 427     if ( $error ) {
 428       $dbh->rollback if $oldAutoCommit;
 429       return $error;
 430     }
 431   }
 432
 433   $error = $new->SUPER::replace($old);
 434   if ($error) {
 435     $dbh->rollback if $oldAutoCommit;
 436     return $error;
 437   }
 438
 439   #new-style exports!
 440   unless ( $noexport_hack ) {
 441
 442     my $export_args = $options->{'export_args'} || [];
 443
 444     #not quite false laziness, but same pattern as FS::svc_acct::replace and
 445     #FS::part_export::sqlradius::_export_replace.  List::Compare or something
 446     #would be useful but too much of a pain in the ass to deploy
 447
 448     my @old_part_export = $old->cust_svc->part_svc->part_export;
 449     my %old_exportnum = map { $_->exportnum => 1 } @old_part_export;
 450     my @new_part_export =
 451       $new->svcpart
 452         ? qsearchs('part_svc', { svcpart=>$new->svcpart } )->part_export
 453         : $new->cust_svc->part_svc->part_export;
 454     my %new_exportnum = map { $_->exportnum => 1 } @new_part_export;
 455
 456     foreach my $delete_part_export (
 457       grep { ! $new_exportnum{$_->exportnum} } @old_part_export
 458     ) {
 459       my $error = $delete_part_export->export_delete($old, @$export_args);
 460       if ( $error ) {
 461         $dbh->rollback if $oldAutoCommit;
 462         return "error deleting, export to ". $delete_part_export->exporttype.
 463                " (transaction rolled back): $error";
 464       }
 465     }
 466
 467     foreach my $replace_part_export (
 468       grep { $old_exportnum{$_->exportnum} } @new_part_export
 469     ) {
 470       my $error =
 471         $replace_part_export->export_replace( $new, $old, @$export_args);
 472       if ( $error ) {
 473         $dbh->rollback if $oldAutoCommit;
 474         return "error exporting to ". $replace_part_export->exporttype.
 475                " (transaction rolled back): $error";
 476       }
 477     }
 478
 479     foreach my $insert_part_export (
 480       grep { ! $old_exportnum{$_->exportnum} } @new_part_export
 481     ) {
 482       my $error = $insert_part_export->export_insert($new, @$export_args );
 483       if ( $error ) {
 484         $dbh->rollback if $oldAutoCommit;
 485         return "error inserting export to ". $insert_part_export->exporttype.
 486                " (transaction rolled back): $error";
 487       }
 488     }
 489
 490   }
 491
 492   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 493   '';
 494 }
 495
 496 =item setfixed
 497
 498 Sets any fixed fields for this service (see L<FS::part_svc>).  If there is an
 499 error, returns the error, otherwise returns the FS::part_svc object (use ref()
 500 to test the return).  Usually called by the check method.
 501
 502 =cut
 503
 504 sub setfixed {
 505   my $self = shift;
 506   $self->setx('F', @_);
 507 }
 508
 509 =item setdefault
 510
 511 Sets all fields to their defaults (see L<FS::part_svc>), overriding their
 512 current values.  If there is an error, returns the error, otherwise returns
 513 the FS::part_svc object (use ref() to test the return).
 514
 515 =cut
 516
 517 sub setdefault {
 518   my $self = shift;
 519   $self->setx('D', @_ );
 520 }
 521
 522 =item set_default_and_fixed
 523
 524 =cut
 525
 526 sub set_default_and_fixed {
 527   my $self = shift;
 528   $self->setx( [ 'D', 'F' ], @_ );
 529 }
 530
 531 =item setx FLAG | FLAG_ARRAYREF , [ CALLBACK_HASHREF ]
 532
 533 Sets fields according to the passed in flag or arrayref of flags.
 534
 535 Optionally, a hashref of field names and callback coderefs can be passed.
 536 If a coderef exists for a given field name, instead of setting the field,
 537 the coderef is called with the column value (part_svc_column.columnvalue)
 538 as the single parameter.
 539
 540 =cut
 541
 542 sub setx {
 543   my $self = shift;
 544   my $x = shift;
 545   my @x = ref($x) ? @$x : ($x);
 546   my $coderef = scalar(@_) ? shift : $self->_fieldhandlers;
 547
 548   my $error =
 549     $self->ut_numbern('svcnum')
 550   ;
 551   return $error if $error;
 552
 553   my $part_svc = $self->part_svc;
 554   return "Unknown svcpart" unless $part_svc;
 555
 556   #set default/fixed/whatever fields from part_svc
 557
 558   foreach my $part_svc_column (
 559     grep { my $f = $_->columnflag; grep { $f eq $_ } @x } #columnflag in @x
 560     $part_svc->all_part_svc_column
 561   ) {
 562
 563     my $columnname  = $part_svc_column->columnname;
 564     my $columnvalue = $part_svc_column->columnvalue;
 565
 566     $columnvalue = &{ $coderef->{$columnname} }( $self, $columnvalue )
 567       if exists( $coderef->{$columnname} );
 568     $self->setfield( $columnname, $columnvalue );
 569
 570   }
 571
 572  $part_svc;
 573
 574 }
 575
 576 sub part_svc {
 577   my $self = shift;
 578
 579   #get part_svc
 580   my $svcpart;
 581   if ( $self->get('svcpart') ) {
 582     $svcpart = $self->get('svcpart');
 583   } elsif ( $self->svcnum && qsearchs('cust_svc', {'svcnum'=>$self->svcnum}) ) {
 584     my $cust_svc = $self->cust_svc;
 585     return "Unknown svcnum" unless $cust_svc;
 586     $svcpart = $cust_svc->svcpart;
 587   }
 588
 589   qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
 590
 591 }
 592
 593 =item svc_pbx
 594
 595 Returns the FS::svc_pbx record for this service, if any (see L<FS::svc_pbx>).
 596
 597 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
 598 svc_acct).
 599
 600 =cut
 601
 602 # XXX FS::h_svc_{acct,phone} could have a history-aware svc_pbx override
 603
 604 sub svc_pbx {
 605   my $self = shift;
 606   return '' unless $self->pbxsvc;
 607   qsearchs( 'svc_pbx', { 'svcnum' => $self->pbxsvc } );
 608 }
 609
 610 =item pbx_title
 611
 612 Returns the title of the FS::svc_pbx record associated with this service, if
 613 any.
 614
 615 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
 616 svc_acct).
 617
 618 =cut
 619
 620 sub pbx_title {
 621   my $self = shift;
 622   my $svc_pbx = $self->svc_pbx or return '';
 623   $svc_pbx->title;
 624 }
 625
 626 =item pbx_select_hash %OPTIONS
 627
 628 Can be called as an object method or a class method.
 629
 630 Returns a hash SVCNUM => TITLE ...  representing the PBXes this customer
 631 that may be associated with this service.
 632
 633 Currently available options are: I<pkgnum> I<svcpart>
 634
 635 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
 636 svc_acct).
 637
 638 =cut
 639
 640 #false laziness w/svc_acct::domain_select_hash
 641 sub pbx_select_hash {
 642   my ($self, %options) = @_;
 643   my %pbxes = ();
 644   my $part_svc;
 645   my $cust_pkg;
 646
 647   if (ref($self)) {
 648     $part_svc = $self->part_svc;
 649     $cust_pkg = $self->cust_svc->cust_pkg
 650       if $self->cust_svc;
 651   }
 652
 653   $part_svc = qsearchs('part_svc', { 'svcpart' => $options{svcpart} })
 654     if $options{'svcpart'};
 655
 656   $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $options{pkgnum} })
 657     if $options{'pkgnum'};
 658
 659   if ($part_svc && ( $part_svc->part_svc_column('pbxsvc')->columnflag eq 'S'
 660                   || $part_svc->part_svc_column('pbxsvc')->columnflag eq 'F')) {
 661     %pbxes = map { $_->svcnum => $_->title }
 662              map { qsearchs('svc_pbx', { 'svcnum' => $_ }) }
 663              split(',', $part_svc->part_svc_column('pbxsvc')->columnvalue);
 664   } elsif ($cust_pkg) { # && !$conf->exists('svc_acct-alldomains') ) {
 665     %pbxes = map { $_->svcnum => $_->title }
 666              map { qsearchs('svc_pbx', { 'svcnum' => $_->svcnum }) }
 667              map { qsearch('cust_svc', { 'pkgnum' => $_->pkgnum } ) }
 668              qsearch('cust_pkg', { 'custnum' => $cust_pkg->custnum });
 669   } else {
 670     #XXX agent-virt
 671     %pbxes = map { $_->svcnum => $_->title } qsearch('svc_pbx', {} );
 672   }
 673
 674   if ($part_svc && $part_svc->part_svc_column('pbxsvc')->columnflag eq 'D') {
 675     my $svc_pbx = qsearchs('svc_pbx',
 676       { 'svcnum' => $part_svc->part_svc_column('pbxsvc')->columnvalue } );
 677     if ( $svc_pbx ) {
 678       $pbxes{$svc_pbx->svcnum}  = $svc_pbx->title;
 679     } else {
 680       warn "unknown svc_pbx.svcnum for part_svc_column pbxsvc: ".
 681            $part_svc->part_svc_column('pbxsvc')->columnvalue;
 682
 683     }
 684   }
 685
 686   (%pbxes);
 687
 688 }
 689
 690 =item set_auto_inventory
 691
 692 Sets any fields which auto-populate from inventory (see L<FS::part_svc>), and
 693 also check any manually populated inventory fields.
 694
 695 If there is an error, returns the error, otherwise returns false.
 696
 697 =cut
 698
 699 sub set_auto_inventory {
 700   my $self = shift;
 701   my $old = @_ ? shift : '';
 702
 703   my $error =
 704     $self->ut_numbern('svcnum')
 705   ;
 706   return $error if $error;
 707
 708   my $part_svc = $self->part_svc;
 709   return "Unkonwn svcpart" unless $part_svc;
 710
 711   local $SIG{HUP} = 'IGNORE';
 712   local $SIG{INT} = 'IGNORE';
 713   local $SIG{QUIT} = 'IGNORE';
 714   local $SIG{TERM} = 'IGNORE';
 715   local $SIG{TSTP} = 'IGNORE';
 716   local $SIG{PIPE} = 'IGNORE';
 717
 718   my $oldAutoCommit = $FS::UID::AutoCommit;
 719   local $FS::UID::AutoCommit = 0;
 720   my $dbh = dbh;
 721
 722   #set default/fixed/whatever fields from part_svc
 723   my $table = $self->table;
 724   foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
 725
 726     my $part_svc_column = $part_svc->part_svc_column($field);
 727     my $columnflag = $part_svc_column->columnflag;
 728     next unless $columnflag =~ /^[AM]$/;
 729
 730     next if $columnflag eq 'A' && $self->$field() ne '';
 731
 732     my $classnum = $part_svc_column->columnvalue;
 733     my %hash = ( 'classnum' => $classnum );
 734
 735     if ( $columnflag eq 'A' && $self->$field() eq '' ) {
 736       $hash{'svcnum'} = '';
 737     } elsif ( $columnflag eq 'M' ) {
 738       return "Select inventory item for $field" unless $self->getfield($field);
 739       $hash{'item'} = $self->getfield($field);
 740     }
 741
 742     my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql(
 743       'null'  => 1,
 744       'table' => 'inventory_item',
 745     );
 746
 747     my $inventory_item = qsearchs({
 748       'table'     => 'inventory_item',
 749       'hashref'   => \%hash,
 750       'extra_sql' => "AND $agentnums_sql",
 751       'order_by'  => 'ORDER BY ( agentnum IS NULL ) '. #agent inventory first
 752                      ' LIMIT 1 FOR UPDATE',
 753     });
 754
 755     unless ( $inventory_item ) {
 756       $dbh->rollback if $oldAutoCommit;
 757       my $inventory_class =
 758         qsearchs('inventory_class', { 'classnum' => $classnum } );
 759       return "Can't find inventory_class.classnum $classnum"
 760         unless $inventory_class;
 761       return "Out of ". $inventory_class->classname. "s\n"; #Lingua:: BS
 762                                                             #for pluralizing
 763     }
 764
 765     next if $columnflag eq 'M' && $inventory_item->svcnum == $self->svcnum;
 766
 767     $self->setfield( $field, $inventory_item->item );
 768       #if $columnflag eq 'A' && $self->$field() eq '';
 769
 770     $inventory_item->svcnum( $self->svcnum );
 771     my $ierror = $inventory_item->replace();
 772     if ( $ierror ) {
 773       $dbh->rollback if $oldAutoCommit;
 774       return "Error provisioning inventory: $ierror";
 775     }
 776
 777     if ( $old && $old->$field() && $old->$field() ne $self->$field() ) {
 778       my $old_inv = qsearchs({
 779         'table'   => 'inventory_item',
 780         'hashref' => { 'classnum' => $classnum,
 781                        'svcnum'   => $old->svcnum,
 782                        'item'     => $old->$field(),
 783                      },
 784       });
 785       if ( $old_inv ) {
 786         $old_inv->svcnum('');
 787         my $oerror = $old_inv->replace;
 788         if ( $oerror ) {
 789           $dbh->rollback if $oldAutoCommit;
 790           return "Error unprovisioning inventory: $oerror";
 791         }
 792       }
 793     }
 794
 795   }
 796
 797  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 798
 799  '';
 800
 801 }
 802
 803 =item return_inventory
 804
 805 =cut
 806
 807 sub return_inventory {
 808   my $self = shift;
 809
 810   local $SIG{HUP} = 'IGNORE';
 811   local $SIG{INT} = 'IGNORE';
 812   local $SIG{QUIT} = 'IGNORE';
 813   local $SIG{TERM} = 'IGNORE';
 814   local $SIG{TSTP} = 'IGNORE';
 815   local $SIG{PIPE} = 'IGNORE';
 816
 817   my $oldAutoCommit = $FS::UID::AutoCommit;
 818   local $FS::UID::AutoCommit = 0;
 819   my $dbh = dbh;
 820
 821   foreach my $inventory_item ( $self->inventory_item ) {
 822     $inventory_item->svcnum('');
 823     my $error = $inventory_item->replace();
 824     if ( $error ) {
 825       $dbh->rollback if $oldAutoCommit;
 826       return "Error returning inventory: $error";
 827     }
 828   }
 829
 830   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 831
 832   '';
 833 }
 834
 835 =item inventory_item
 836
 837 Returns the inventory items associated with this svc_ record, as
 838 FS::inventory_item objects (see L<FS::inventory_item>.
 839
 840 =cut
 841
 842 sub inventory_item {
 843   my $self = shift;
 844   qsearch({
 845     'table'     => 'inventory_item',
 846     'hashref'   => { 'svcnum' => $self->svcnum, },
 847   });
 848 }
 849
 850 =item cust_svc
 851
 852 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
 853 object (see L<FS::cust_svc>).
 854
 855 =cut
 856
 857 sub cust_svc {
 858   my $self = shift;
 859   qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
 860 }
 861
 862 =item suspend
 863
 864 Runs export_suspend callbacks.
 865
 866 =cut
 867
 868 sub suspend {
 869   my $self = shift;
 870   my %options = @_;
 871   my $export_args = $options{'export_args'} || [];
 872   $self->export('suspend', @$export_args);
 873 }
 874
 875 =item unsuspend
 876
 877 Runs export_unsuspend callbacks.
 878
 879 =cut
 880
 881 sub unsuspend {
 882   my $self = shift;
 883   my %options = @_;
 884   my $export_args = $options{'export_args'} || [];
 885   $self->export('unsuspend', @$export_args);
 886 }
 887
 888 =item export_links
 889
 890 Runs export_links callbacks and returns the links.
 891
 892 =cut
 893
 894 sub export_links {
 895   my $self = shift;
 896   my $return = [];
 897   $self->export('links', $return);
 898   $return;
 899 }
 900
 901 =item export_getsettings
 902
 903 Runs export_getsettings callbacks and returns the two hashrefs.
 904
 905 =cut
 906
 907 sub export_getsettings {
 908   my $self = shift;
 909   my %settings = ();
 910   my %defaults = ();
 911   my $error = $self->export('getsettings', \%settings, \%defaults);
 912   if ( $error ) {
 913     #XXX bubble this up better
 914     warn "error running export_getsetings: $error";
 915     return ( {}, {} );
 916   }
 917   ( \%settings, \%defaults );
 918 }
 919
 920 =item export HOOK [ EXPORT_ARGS ]
 921
 922 Runs the provided export hook (i.e. "suspend", "unsuspend") for this service.
 923
 924 =cut
 925
 926 sub export {
 927   my( $self, $method ) = ( shift, shift );
 928
 929   $method = "export_$method" unless $method =~ /^export_/;
 930
 931   local $SIG{HUP} = 'IGNORE';
 932   local $SIG{INT} = 'IGNORE';
 933   local $SIG{QUIT} = 'IGNORE';
 934   local $SIG{TERM} = 'IGNORE';
 935   local $SIG{TSTP} = 'IGNORE';
 936   local $SIG{PIPE} = 'IGNORE';
 937
 938   my $oldAutoCommit = $FS::UID::AutoCommit;
 939   local $FS::UID::AutoCommit = 0;
 940   my $dbh = dbh;
 941
 942   #new-style exports!
 943   unless ( $noexport_hack ) {
 944     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 945       next unless $part_export->can($method);
 946       my $error = $part_export->$method($self, @_);
 947       if ( $error ) {
 948         $dbh->rollback if $oldAutoCommit;
 949         return "error exporting $method event to ". $part_export->exporttype.
 950                " (transaction rolled back): $error";
 951       }
 952     }
 953   }
 954
 955   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 956   '';
 957
 958 }
 959
 960 =item overlimit
 961
 962 Sets or retrieves overlimit date.
 963
 964 =cut
 965
 966 sub overlimit {
 967   my $self = shift;
 968   #$self->cust_svc->overlimit(@_);
 969   my $cust_svc = $self->cust_svc;
 970   unless ( $cust_svc ) { #wtf?
 971     my $error = "$me overlimit: missing cust_svc record for svc_acct svcnum ".
 972                 $self->svcnum;
 973     if ( $overlimit_missing_cust_svc_nonfatal_kludge ) {
 974       cluck "$error; continuing anyway as requested";
 975       return '';
 976     } else {
 977       confess $error;
 978     }
 979   }
 980   $cust_svc->overlimit(@_);
 981 }
 982
 983 =item cancel
 984
 985 Stub - returns false (no error) so derived classes don't need to define this
 986 methods.  Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 987
 988 This method is called *before* the deletion step which actually deletes the
 989 services.  This method should therefore only be used for "pre-deletion"
 990 cancellation steps, if necessary.
 991
 992 =cut
 993
 994 sub cancel { ''; }
 995
 996 =item clone_suspended
 997
 998 Constructor used by FS::part_export::_export_suspend fallback.  Stub returning
 999 same object for svc_ classes which don't implement a suspension fallback
1000 (everything except svc_acct at the moment).  Document better.
1001
1002 =cut
1003
1004 sub clone_suspended {
1005   shift;
1006 }
1007
1008 =item clone_kludge_unsuspend
1009
1010 Constructor used by FS::part_export::_export_unsuspend fallback.  Stub returning
1011 same object for svc_ classes which don't implement a suspension fallback
1012 (everything except svc_acct at the moment).  Document better.
1013
1014 =cut
1015
1016 sub clone_kludge_unsuspend {
1017   shift;
1018 }
1019
1020 =item find_duplicates MODE FIELDS...
1021
1022 Method used by _check_duplicate routines to find services with duplicate
1023 values in specified fields.  Set MODE to 'global' to search across all
1024 services, or 'export' to limit to those that share one or more exports
1025 with this service.  FIELDS is a list of field names; only services
1026 matching in all fields will be returned.  Empty fields will be skipped.
1027
1028 =cut
1029
1030 sub find_duplicates {
1031   my $self = shift;
1032   my $mode = shift;
1033   my @fields = @_;
1034
1035   my %search = map { $_ => $self->getfield($_) }
1036                grep { length($self->getfield($_)) } @fields;
1037   return () if !%search;
1038   my @dup = grep { ! $self->svcnum or $_->svcnum != $self->svcnum }
1039             qsearch( $self->table, \%search );
1040   return () if !@dup;
1041   return @dup if $mode eq 'global';
1042   die "incorrect find_duplicates mode '$mode'" if $mode ne 'export';
1043
1044   my $exports = FS::part_export::export_info($self->table);
1045   my %conflict_svcparts;
1046   my $part_svc = $self->part_svc;
1047   foreach my $part_export ( $part_svc->part_export ) {
1048     %conflict_svcparts = map { $_->svcpart => 1 } $part_export->export_svc;
1049   }
1050   return grep { $conflict_svcparts{$_->cust_svc->svcpart} } @dup;
1051 }
1052
1053
1054
1055
1056 =back
1057
1058 =head1 BUGS
1059
1060 The setfixed method return value.
1061
1062 B<export> method isn't used by insert and replace methods yet.
1063
1064 =head1 SEE ALSO
1065
1066 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
1067 from the base documentation.
1068
1069 =cut
1070
1071 1;
1072