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