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