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 Lingua::EN::Inflect qw( PL_N );
   9 use FS::Conf;
  10 use FS::Record qw( qsearch qsearchs fields dbh );
  11 use FS::cust_main_Mixin;
  12 use FS::cust_svc;
  13 use FS::part_svc;
  14 use FS::queue;
  15 use FS::cust_main;
  16 use FS::inventory_item;
  17 use FS::inventory_class;
  18 use FS::NetworkMonitoringSystem;
  19
  20 @ISA = qw( FS::cust_main_Mixin FS::Record );
  21
  22 $me = '[FS::svc_Common]';
  23 $DEBUG = 0;
  24
  25 $overlimit_missing_cust_svc_nonfatal_kludge = 0;
  26
  27 =head1 NAME
  28
  29 FS::svc_Common - Object method for all svc_ records
  30
  31 =head1 SYNOPSIS
  32
  33 use FS::svc_Common;
  34
  35 @ISA = qw( FS::svc_Common );
  36
  37 =head1 DESCRIPTION
  38
  39 FS::svc_Common is intended as a base class for table-specific classes to
  40 inherit from, i.e. FS::svc_acct.  FS::svc_Common inherits from FS::Record.
  41
  42 =head1 METHODS
  43
  44 =over 4
  45
  46 =item search_sql_field FIELD STRING
  47
  48 Class method which returns an SQL fragment to search for STRING in FIELD.
  49
  50 It is now case-insensitive by default.
  51
  52 =cut
  53
  54 sub search_sql_field {
  55   my( $class, $field, $string ) = @_;
  56   my $table = $class->table;
  57   my $q_string = dbh->quote($string);
  58   "LOWER($table.$field) = LOWER($q_string)";
  59 }
  60
  61 #fallback for services that don't provide a search...
  62 sub search_sql {
  63   #my( $class, $string ) = @_;
  64   '1 = 0'; #false
  65 }
  66
  67 =item new
  68
  69 =cut
  70
  71 sub new {
  72   my $proto = shift;
  73   my $class = ref($proto) || $proto;
  74   my $self = {};
  75   bless ($self, $class);
  76
  77   unless ( defined ( $self->table ) ) {
  78     $self->{'Table'} = shift;
  79     carp "warning: FS::Record::new called with table name ". $self->{'Table'};
  80   }
  81
  82   #$self->{'Hash'} = shift;
  83   my $newhash = shift;
  84   $self->{'Hash'} = { map { $_ => $newhash->{$_} } qw(svcnum svcpart) };
  85
  86   $self->setdefault( $self->_fieldhandlers )
  87     unless $self->svcnum;
  88
  89   $self->{'Hash'}{$_} = $newhash->{$_}
  90     foreach grep { defined($newhash->{$_}) && length($newhash->{$_}) }
  91                  keys %$newhash;
  92
  93   foreach my $field ( grep !defined($self->{'Hash'}{$_}), $self->fields ) {
  94     $self->{'Hash'}{$field}='';
  95   }
  96
  97   $self->_rebless if $self->can('_rebless');
  98
  99   $self->{'modified'} = 0;
 100
 101   $self->_cache($self->{'Hash'}, shift) if $self->can('_cache') && @_;
 102
 103   $self;
 104 }
 105
 106 #empty default
 107 sub _fieldhandlers { {}; }
 108
 109 sub virtual_fields {
 110
 111   # This restricts the fields based on part_svc_column and the svcpart of
 112   # the service.  There are four possible cases:
 113   # 1.  svcpart passed as part of the svc_x hash.
 114   # 2.  svcpart fetched via cust_svc based on svcnum.
 115   # 3.  No svcnum or svcpart.  In this case, return ALL the fields with
 116   #     dbtable eq $self->table.
 117   # 4.  Called via "fields('svc_acct')" or something similar.  In this case
 118   #     there is no $self object.
 119
 120   my $self = shift;
 121   my $svcpart;
 122   my @vfields = $self->SUPER::virtual_fields;
 123
 124   return @vfields unless (ref $self); # Case 4
 125
 126   if ($self->svcpart) { # Case 1
 127     $svcpart = $self->svcpart;
 128   } elsif ( $self->svcnum
 129             && qsearchs('cust_svc',{'svcnum'=>$self->svcnum} )
 130           ) { #Case 2
 131     $svcpart = $self->cust_svc->svcpart;
 132   } else { # Case 3
 133     $svcpart = '';
 134   }
 135
 136   if ($svcpart) { #Cases 1 and 2
 137     my %flags = map { $_->columnname, $_->columnflag } (
 138         qsearch ('part_svc_column', { svcpart => $svcpart } )
 139       );
 140     return grep { not ( defined($flags{$_}) && $flags{$_} eq 'X') } @vfields;
 141   } else { # Case 3
 142     return @vfields;
 143   }
 144   return ();
 145 }
 146
 147 =item label
 148
 149 svc_Common provides a fallback label subroutine that just returns the svcnum.
 150
 151 =cut
 152
 153 sub label {
 154   my $self = shift;
 155   cluck "warning: ". ref($self). " not loaded or missing label method; ".
 156         "using svcnum";
 157   $self->svcnum;
 158 }
 159
 160 sub label_long {
 161   my $self = shift;
 162   $self->label(@_);
 163 }
 164
 165 sub cust_main {
 166   my $self = shift;
 167   (($self->cust_svc || return)->cust_pkg || return)->cust_main || return
 168 }
 169
 170 sub cust_linked {
 171   my $self = shift;
 172   defined($self->cust_main);
 173 }
 174
 175 =item check
 176
 177 Checks the validity of fields in this record.
 178
 179 At present, this does nothing but call FS::Record::check (which, in turn,
 180 does nothing but run virtual field checks).
 181
 182 =cut
 183
 184 sub check {
 185   my $self = shift;
 186   $self->SUPER::check;
 187 }
 188
 189 =item insert [ , OPTION => VALUE ... ]
 190
 191 Adds this record to the database.  If there is an error, returns the error,
 192 otherwise returns false.
 193
 194 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
 195 defined.  An FS::cust_svc record will be created and inserted.
 196
 197 Currently available options are: I<jobnums>, I<child_objects> and
 198 I<depend_jobnum>.
 199
 200 If I<jobnum> is set to an array reference, the jobnums of any export jobs will
 201 be added to the referenced array.
 202
 203 If I<child_objects> is set to an array reference of FS::tablename objects
 204 (for example, FS::svc_export_machine or FS::acct_snarf objects), they
 205 will have their svcnum field set and will be inserted after this record,
 206 but before any exports are run.  Each element of the array can also
 207 optionally be a two-element array reference containing the child object
 208 and the name of an alternate field to be filled in with the newly-inserted
 209 svcnum, for example C<[ $svc_forward, 'srcsvc' ]>
 210
 211 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
 212 jobnums), all provisioning jobs will have a dependancy on the supplied
 213 jobnum(s) (they will not run until the specific job(s) complete(s)).
 214
 215 If I<export_args> is set to an array reference, the referenced list will be
 216 passed to export commands.
 217
 218 =cut
 219
 220 sub insert {
 221   my $self = shift;
 222   my %options = @_;
 223   warn "[$me] insert called with options ".
 224        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 225     if $DEBUG;
 226
 227   my @jobnums = ();
 228   local $FS::queue::jobnums = \@jobnums;
 229   warn "[$me] insert: set \$FS::queue::jobnums to $FS::queue::jobnums\n"
 230     if $DEBUG;
 231   my $objects = $options{'child_objects'} || [];
 232   my $depend_jobnums = $options{'depend_jobnum'} || [];
 233   $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
 234
 235   local $SIG{HUP} = 'IGNORE';
 236   local $SIG{INT} = 'IGNORE';
 237   local $SIG{QUIT} = 'IGNORE';
 238   local $SIG{TERM} = 'IGNORE';
 239   local $SIG{TSTP} = 'IGNORE';
 240   local $SIG{PIPE} = 'IGNORE';
 241
 242   my $oldAutoCommit = $FS::UID::AutoCommit;
 243   local $FS::UID::AutoCommit = 0;
 244   my $dbh = dbh;
 245
 246   my $svcnum = $self->svcnum;
 247   my $cust_svc = $svcnum ? qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) : '';
 248   my $inserted_cust_svc = 0;
 249   #unless ( $svcnum ) {
 250   if ( !$svcnum or !$cust_svc ) {
 251     $cust_svc = new FS::cust_svc ( {
 252       #hua?# 'svcnum'  => $svcnum,
 253       'svcnum'  => $self->svcnum,
 254       'pkgnum'  => $self->pkgnum,
 255       'svcpart' => $self->svcpart,
 256     } );
 257     my $error = $cust_svc->insert;
 258     if ( $error ) {
 259       $dbh->rollback if $oldAutoCommit;
 260       return $error;
 261     }
 262     $inserted_cust_svc  = 1;
 263     $svcnum = $self->svcnum($cust_svc->svcnum);
 264   } else {
 265     #$cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
 266     unless ( $cust_svc ) {
 267       $dbh->rollback if $oldAutoCommit;
 268       return "no cust_svc record found for svcnum ". $self->svcnum;
 269     }
 270     $self->pkgnum($cust_svc->pkgnum);
 271     $self->svcpart($cust_svc->svcpart);
 272   }
 273
 274   my $error =    $self->preinsert_hook_first
 275               || $self->set_auto_inventory
 276               || $self->check
 277               || $self->_check_duplicate
 278               || $self->preinsert_hook
 279               || $self->SUPER::insert;
 280   if ( $error ) {
 281     if ( $inserted_cust_svc ) {
 282       my $derror = $cust_svc->delete;
 283       die $derror if $derror;
 284     }
 285     $dbh->rollback if $oldAutoCommit;
 286     return $error;
 287   }
 288
 289   foreach my $object ( @$objects ) {
 290     my($field, $obj);
 291     if ( ref($object) eq 'ARRAY' ) {
 292       ($obj, $field) = @$object;
 293     } else {
 294       $obj = $object;
 295       $field = 'svcnum';
 296     }
 297     $obj->$field($self->svcnum);
 298     $error = $obj->insert;
 299     if ( $error ) {
 300       $dbh->rollback if $oldAutoCommit;
 301       return $error;
 302     }
 303   }
 304
 305   #new-style exports!
 306   unless ( $noexport_hack ) {
 307
 308     warn "[$me] insert: \$FS::queue::jobnums is $FS::queue::jobnums\n"
 309       if $DEBUG;
 310
 311     my $export_args = $options{'export_args'} || [];
 312
 313     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 314       my $error = $part_export->export_insert($self, @$export_args);
 315       if ( $error ) {
 316         $dbh->rollback if $oldAutoCommit;
 317         return "exporting to ". $part_export->exporttype.
 318                " (transaction rolled back): $error";
 319       }
 320     }
 321
 322     foreach my $depend_jobnum ( @$depend_jobnums ) {
 323       warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
 324         if $DEBUG;
 325       foreach my $jobnum ( @jobnums ) {
 326         my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
 327         warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
 328           if $DEBUG;
 329         my $error = $queue->depend_insert($depend_jobnum);
 330         if ( $error ) {
 331           $dbh->rollback if $oldAutoCommit;
 332           return "error queuing job dependancy: $error";
 333         }
 334       }
 335     }
 336
 337   }
 338
 339   my $nms_ip_error = $self->nms_ip_insert;
 340   if ( $nms_ip_error ) {
 341     $dbh->rollback if $oldAutoCommit;
 342     return "error queuing IP insert: $nms_ip_error";
 343   }
 344
 345   if ( exists $options{'jobnums'} ) {
 346     push @{ $options{'jobnums'} }, @jobnums;
 347   }
 348
 349   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 350
 351   '';
 352 }
 353
 354 #fallbacks
 355 sub preinsert_hook_first { ''; }
 356 sub _check_duplcate { ''; }
 357 sub preinsert_hook { ''; }
 358 sub table_dupcheck_fields { (); }
 359 sub predelete_hook { ''; }
 360 sub predelete_hook_first { ''; }
 361
 362 =item delete [ , OPTION => VALUE ... ]
 363
 364 Deletes this account from the database.  If there is an error, returns the
 365 error, otherwise returns false.
 366
 367 The corresponding FS::cust_svc record will be deleted as well.
 368
 369 =cut
 370
 371 sub delete {
 372   my $self = shift;
 373   my %options = @_;
 374   my $export_args = $options{'export_args'} || [];
 375
 376   local $SIG{HUP} = 'IGNORE';
 377   local $SIG{INT} = 'IGNORE';
 378   local $SIG{QUIT} = 'IGNORE';
 379   local $SIG{TERM} = 'IGNORE';
 380   local $SIG{TSTP} = 'IGNORE';
 381   local $SIG{PIPE} = 'IGNORE';
 382
 383   my $oldAutoCommit = $FS::UID::AutoCommit;
 384   local $FS::UID::AutoCommit = 0;
 385   my $dbh = dbh;
 386
 387   my $error =   $self->predelete_hook_first
 388               || $self->SUPER::delete
 389               || $self->export('delete', @$export_args)
 390               || $self->return_inventory
 391               || $self->predelete_hook
 392               || $self->cust_svc->delete
 393   ;
 394   if ( $error ) {
 395     $dbh->rollback if $oldAutoCommit;
 396     return $error;
 397   }
 398
 399   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 400
 401   '';
 402 }
 403
 404 =item expire DATE
 405
 406 Currently this will only run expire exports if any are attached
 407
 408 =cut
 409
 410 sub expire {
 411   my($self,$date) = (shift,shift);
 412
 413   return 'Expire date must be specified' unless $date;
 414
 415   local $SIG{HUP} = 'IGNORE';
 416   local $SIG{INT} = 'IGNORE';
 417   local $SIG{QUIT} = 'IGNORE';
 418   local $SIG{TERM} = 'IGNORE';
 419   local $SIG{TSTP} = 'IGNORE';
 420   local $SIG{PIPE} = 'IGNORE';
 421
 422   my $oldAutoCommit = $FS::UID::AutoCommit;
 423   local $FS::UID::AutoCommit = 0;
 424   my $dbh = dbh;
 425
 426   my $export_args = [$date];
 427   my $error = $self->export('expire', @$export_args);
 428   if ( $error ) {
 429     $dbh->rollback if $oldAutoCommit;
 430     return $error;
 431   }
 432
 433   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 434
 435   '';
 436 }
 437
 438 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ]
 439
 440 Replaces OLD_RECORD with this one.  If there is an error, returns the error,
 441 otherwise returns false.
 442
 443 Currently available options are: I<child_objects>, I<export_args> and
 444 I<depend_jobnum>.
 445
 446 If I<child_objects> is set to an array reference of FS::tablename objects
 447 (for example, FS::svc_export_machine or FS::acct_snarf objects), they
 448 will have their svcnum field set and will be inserted or replaced after
 449 this record, but before any exports are run.  Each element of the array
 450 can also optionally be a two-element array reference containing the
 451 child object and the name of an alternate field to be filled in with
 452 the newly-inserted svcnum, for example C<[ $svc_forward, 'srcsvc' ]>
 453
 454 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
 455 jobnums), all provisioning jobs will have a dependancy on the supplied
 456 jobnum(s) (they will not run until the specific job(s) complete(s)).
 457
 458 If I<export_args> is set to an array reference, the referenced list will be
 459 passed to export commands.
 460
 461 =cut
 462
 463 sub replace {
 464   my $new = shift;
 465
 466   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
 467               ? shift
 468               : $new->replace_old;
 469
 470   my $options =
 471     ( ref($_[0]) eq 'HASH' )
 472       ? shift
 473       : { @_ };
 474
 475   my $objects = $options->{'child_objects'} || [];
 476
 477   my @jobnums = ();
 478   local $FS::queue::jobnums = \@jobnums;
 479   warn "[$me] replace: set \$FS::queue::jobnums to $FS::queue::jobnums\n"
 480     if $DEBUG;
 481   my $depend_jobnums = $options->{'depend_jobnum'} || [];
 482   $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
 483
 484   local $SIG{HUP} = 'IGNORE';
 485   local $SIG{INT} = 'IGNORE';
 486   local $SIG{QUIT} = 'IGNORE';
 487   local $SIG{TERM} = 'IGNORE';
 488   local $SIG{TSTP} = 'IGNORE';
 489   local $SIG{PIPE} = 'IGNORE';
 490
 491   my $oldAutoCommit = $FS::UID::AutoCommit;
 492   local $FS::UID::AutoCommit = 0;
 493   my $dbh = dbh;
 494
 495   my $error = $new->set_auto_inventory($old);
 496   if ( $error ) {
 497     $dbh->rollback if $oldAutoCommit;
 498     return $error;
 499   }
 500
 501   #redundant, but so any duplicate fields are maniuplated as appropriate
 502   # (svc_phone.phonenum)
 503   $error = $new->check;
 504   if ( $error ) {
 505     $dbh->rollback if $oldAutoCommit;
 506     return $error;
 507   }
 508
 509   #if ( $old->username ne $new->username || $old->domsvc != $new->domsvc ) {
 510   if ( grep { $old->$_ ne $new->$_ } $new->table_dupcheck_fields ) {
 511
 512     $new->svcpart( $new->cust_svc->svcpart ) unless $new->svcpart;
 513     $error = $new->_check_duplicate;
 514     if ( $error ) {
 515       $dbh->rollback if $oldAutoCommit;
 516       return $error;
 517     }
 518   }
 519
 520   $error = $new->SUPER::replace($old);
 521   if ($error) {
 522     $dbh->rollback if $oldAutoCommit;
 523     return $error;
 524   }
 525
 526   foreach my $object ( @$objects ) {
 527     my($field, $obj);
 528     if ( ref($object) eq 'ARRAY' ) {
 529       ($obj, $field) = @$object;
 530     } else {
 531       $obj = $object;
 532       $field = 'svcnum';
 533     }
 534     $obj->$field($new->svcnum);
 535
 536     my $oldobj = qsearchs( $obj->table, {
 537                              $field => $new->svcnum,
 538                              map { $_ => $obj->$_ } $obj->_svc_child_partfields,
 539                          });
 540
 541     if ( $oldobj ) {
 542       my $pkey = $oldobj->primary_key;
 543       $obj->$pkey($oldobj->$pkey);
 544       $obj->replace($oldobj);
 545     } else {
 546       $error = $obj->insert;
 547     }
 548     if ( $error ) {
 549       $dbh->rollback if $oldAutoCommit;
 550       return $error;
 551     }
 552   }
 553
 554   #new-style exports!
 555   unless ( $noexport_hack ) {
 556
 557     warn "[$me] replace: \$FS::queue::jobnums is $FS::queue::jobnums\n"
 558       if $DEBUG;
 559
 560     my $export_args = $options->{'export_args'} || [];
 561
 562     #not quite false laziness, but same pattern as FS::svc_acct::replace and
 563     #FS::part_export::sqlradius::_export_replace.  List::Compare or something
 564     #would be useful but too much of a pain in the ass to deploy
 565
 566     my @old_part_export = $old->cust_svc->part_svc->part_export;
 567     my %old_exportnum = map { $_->exportnum => 1 } @old_part_export;
 568     my @new_part_export =
 569       $new->svcpart
 570         ? qsearchs('part_svc', { svcpart=>$new->svcpart } )->part_export
 571         : $new->cust_svc->part_svc->part_export;
 572     my %new_exportnum = map { $_->exportnum => 1 } @new_part_export;
 573
 574     foreach my $delete_part_export (
 575       grep { ! $new_exportnum{$_->exportnum} } @old_part_export
 576     ) {
 577       my $error = $delete_part_export->export_delete($old, @$export_args);
 578       if ( $error ) {
 579         $dbh->rollback if $oldAutoCommit;
 580         return "error deleting, export to ". $delete_part_export->exporttype.
 581                " (transaction rolled back): $error";
 582       }
 583     }
 584
 585     foreach my $replace_part_export (
 586       grep { $old_exportnum{$_->exportnum} } @new_part_export
 587     ) {
 588       my $error =
 589         $replace_part_export->export_replace( $new, $old, @$export_args);
 590       if ( $error ) {
 591         $dbh->rollback if $oldAutoCommit;
 592         return "error exporting to ". $replace_part_export->exporttype.
 593                " (transaction rolled back): $error";
 594       }
 595     }
 596
 597     foreach my $insert_part_export (
 598       grep { ! $old_exportnum{$_->exportnum} } @new_part_export
 599     ) {
 600       my $error = $insert_part_export->export_insert($new, @$export_args );
 601       if ( $error ) {
 602         $dbh->rollback if $oldAutoCommit;
 603         return "error inserting export to ". $insert_part_export->exporttype.
 604                " (transaction rolled back): $error";
 605       }
 606     }
 607
 608     foreach my $depend_jobnum ( @$depend_jobnums ) {
 609       warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
 610         if $DEBUG;
 611       foreach my $jobnum ( @jobnums ) {
 612         my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
 613         warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
 614           if $DEBUG;
 615         my $error = $queue->depend_insert($depend_jobnum);
 616         if ( $error ) {
 617           $dbh->rollback if $oldAutoCommit;
 618           return "error queuing job dependancy: $error";
 619         }
 620       }
 621     }
 622
 623   }
 624
 625   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 626   '';
 627 }
 628
 629 =item setfixed
 630
 631 Sets any fixed fields for this service (see L<FS::part_svc>).  If there is an
 632 error, returns the error, otherwise returns the FS::part_svc object (use ref()
 633 to test the return).  Usually called by the check method.
 634
 635 =cut
 636
 637 sub setfixed {
 638   my $self = shift;
 639   $self->setx('F', @_);
 640 }
 641
 642 =item setdefault
 643
 644 Sets all fields to their defaults (see L<FS::part_svc>), overriding their
 645 current values.  If there is an error, returns the error, otherwise returns
 646 the FS::part_svc object (use ref() to test the return).
 647
 648 =cut
 649
 650 sub setdefault {
 651   my $self = shift;
 652   $self->setx('D', @_ );
 653 }
 654
 655 =item set_default_and_fixed
 656
 657 =cut
 658
 659 sub set_default_and_fixed {
 660   my $self = shift;
 661   $self->setx( [ 'D', 'F' ], @_ );
 662 }
 663
 664 =item setx FLAG | FLAG_ARRAYREF , [ CALLBACK_HASHREF ]
 665
 666 Sets fields according to the passed in flag or arrayref of flags.
 667
 668 Optionally, a hashref of field names and callback coderefs can be passed.
 669 If a coderef exists for a given field name, instead of setting the field,
 670 the coderef is called with the column value (part_svc_column.columnvalue)
 671 as the single parameter.
 672
 673 =cut
 674
 675 sub setx {
 676   my $self = shift;
 677   my $x = shift;
 678   my @x = ref($x) ? @$x : ($x);
 679   my $coderef = scalar(@_) ? shift : $self->_fieldhandlers;
 680
 681   my $error =
 682     $self->ut_numbern('svcnum')
 683   ;
 684   return $error if $error;
 685
 686   my $part_svc = $self->part_svc;
 687   return "Unknown svcpart" unless $part_svc;
 688
 689   #set default/fixed/whatever fields from part_svc
 690
 691   foreach my $part_svc_column (
 692     grep { my $f = $_->columnflag; grep { $f eq $_ } @x } #columnflag in @x
 693     $part_svc->all_part_svc_column
 694   ) {
 695
 696     my $columnname  = $part_svc_column->columnname;
 697     my $columnvalue = $part_svc_column->columnvalue;
 698
 699     $columnvalue = &{ $coderef->{$columnname} }( $self, $columnvalue )
 700       if exists( $coderef->{$columnname} );
 701     $self->setfield( $columnname, $columnvalue );
 702
 703   }
 704
 705  $part_svc;
 706
 707 }
 708
 709 sub part_svc {
 710   my $self = shift;
 711
 712   #get part_svc
 713   my $svcpart;
 714   if ( $self->get('svcpart') ) {
 715     $svcpart = $self->get('svcpart');
 716   } elsif ( $self->svcnum && qsearchs('cust_svc', {'svcnum'=>$self->svcnum}) ) {
 717     my $cust_svc = $self->cust_svc;
 718     return "Unknown svcnum" unless $cust_svc;
 719     $svcpart = $cust_svc->svcpart;
 720   }
 721
 722   qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
 723
 724 }
 725
 726 =item svc_pbx
 727
 728 Returns the FS::svc_pbx record for this service, if any (see L<FS::svc_pbx>).
 729
 730 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
 731 svc_acct).
 732
 733 =cut
 734
 735 # XXX FS::h_svc_{acct,phone} could have a history-aware svc_pbx override
 736
 737 sub svc_pbx {
 738   my $self = shift;
 739   return '' unless $self->pbxsvc;
 740   qsearchs( 'svc_pbx', { 'svcnum' => $self->pbxsvc } );
 741 }
 742
 743 =item pbx_title
 744
 745 Returns the title of the FS::svc_pbx record associated with this service, if
 746 any.
 747
 748 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
 749 svc_acct).
 750
 751 =cut
 752
 753 sub pbx_title {
 754   my $self = shift;
 755   my $svc_pbx = $self->svc_pbx or return '';
 756   $svc_pbx->title;
 757 }
 758
 759 =item pbx_select_hash %OPTIONS
 760
 761 Can be called as an object method or a class method.
 762
 763 Returns a hash SVCNUM => TITLE ...  representing the PBXes this customer
 764 that may be associated with this service.
 765
 766 Currently available options are: I<pkgnum> I<svcpart>
 767
 768 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
 769 svc_acct).
 770
 771 =cut
 772
 773 #false laziness w/svc_acct::domain_select_hash
 774 sub pbx_select_hash {
 775   my ($self, %options) = @_;
 776   my %pbxes = ();
 777   my $part_svc;
 778   my $cust_pkg;
 779
 780   if (ref($self)) {
 781     $part_svc = $self->part_svc;
 782     $cust_pkg = $self->cust_svc->cust_pkg
 783       if $self->cust_svc;
 784   }
 785
 786   $part_svc = qsearchs('part_svc', { 'svcpart' => $options{svcpart} })
 787     if $options{'svcpart'};
 788
 789   $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $options{pkgnum} })
 790     if $options{'pkgnum'};
 791
 792   if ($part_svc && ( $part_svc->part_svc_column('pbxsvc')->columnflag eq 'S'
 793                   || $part_svc->part_svc_column('pbxsvc')->columnflag eq 'F')) {
 794     %pbxes = map { $_->svcnum => $_->title }
 795              map { qsearchs('svc_pbx', { 'svcnum' => $_ }) }
 796              split(',', $part_svc->part_svc_column('pbxsvc')->columnvalue);
 797   } elsif ($cust_pkg) { # && !$conf->exists('svc_acct-alldomains') ) {
 798     %pbxes = map { $_->svcnum => $_->title }
 799              map { qsearchs('svc_pbx', { 'svcnum' => $_->svcnum }) }
 800              map { qsearch('cust_svc', { 'pkgnum' => $_->pkgnum } ) }
 801              qsearch('cust_pkg', { 'custnum' => $cust_pkg->custnum });
 802   } else {
 803     #XXX agent-virt
 804     %pbxes = map { $_->svcnum => $_->title } qsearch('svc_pbx', {} );
 805   }
 806
 807   if ($part_svc && $part_svc->part_svc_column('pbxsvc')->columnflag eq 'D') {
 808     my $svc_pbx = qsearchs('svc_pbx',
 809       { 'svcnum' => $part_svc->part_svc_column('pbxsvc')->columnvalue } );
 810     if ( $svc_pbx ) {
 811       $pbxes{$svc_pbx->svcnum}  = $svc_pbx->title;
 812     } else {
 813       warn "unknown svc_pbx.svcnum for part_svc_column pbxsvc: ".
 814            $part_svc->part_svc_column('pbxsvc')->columnvalue;
 815
 816     }
 817   }
 818
 819   (%pbxes);
 820
 821 }
 822
 823 =item set_auto_inventory
 824
 825 Sets any fields which auto-populate from inventory (see L<FS::part_svc>), and
 826 also check any manually populated inventory fields.
 827
 828 If there is an error, returns the error, otherwise returns false.
 829
 830 =cut
 831
 832 sub set_auto_inventory {
 833   my $self = shift;
 834   my $old = @_ ? shift : '';
 835
 836   my $error =
 837     $self->ut_numbern('svcnum')
 838   ;
 839   return $error if $error;
 840
 841   my $part_svc = $self->part_svc;
 842   return "Unkonwn svcpart" unless $part_svc;
 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   #set default/fixed/whatever fields from part_svc
 856   my $table = $self->table;
 857   foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
 858
 859     my $part_svc_column = $part_svc->part_svc_column($field);
 860     my $columnflag = $part_svc_column->columnflag;
 861     next unless $columnflag =~ /^[AM]$/;
 862
 863     next if $columnflag eq 'A' && $self->$field() ne '';
 864
 865     my $classnum = $part_svc_column->columnvalue;
 866     my %hash = ( 'classnum' => $classnum );
 867
 868     if ( $columnflag eq 'A' && $self->$field() eq '' ) {
 869       $hash{'svcnum'} = '';
 870     } elsif ( $columnflag eq 'M' ) {
 871       return "Select inventory item for $field" unless $self->getfield($field);
 872       $hash{'item'} = $self->getfield($field);
 873     }
 874
 875     my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql(
 876       'null'  => 1,
 877       'table' => 'inventory_item',
 878     );
 879
 880     my $inventory_item = qsearchs({
 881       'table'     => 'inventory_item',
 882       'hashref'   => \%hash,
 883       'extra_sql' => "AND $agentnums_sql",
 884       'order_by'  => 'ORDER BY ( agentnum IS NULL ) '. #agent inventory first
 885                      ' LIMIT 1 FOR UPDATE',
 886     });
 887
 888     unless ( $inventory_item ) {
 889       $dbh->rollback if $oldAutoCommit;
 890       my $inventory_class =
 891         qsearchs('inventory_class', { 'classnum' => $classnum } );
 892       return "Can't find inventory_class.classnum $classnum"
 893         unless $inventory_class;
 894       return "Out of ". PL_N($inventory_class->classname);
 895     }
 896
 897     next if $columnflag eq 'M' && $inventory_item->svcnum == $self->svcnum;
 898
 899     $self->setfield( $field, $inventory_item->item );
 900       #if $columnflag eq 'A' && $self->$field() eq '';
 901
 902     if ( $old && $old->$field() && $old->$field() ne $self->$field() ) {
 903       my $old_inv = qsearchs({
 904         'table'     => 'inventory_item',
 905         'hashref'   => { 'classnum' => $classnum,
 906                          'svcnum'   => $old->svcnum,
 907                        },
 908         'extra_sql' => ' AND '.
 909           '( ( svc_field IS NOT NULL AND svc_field = '.$dbh->quote($field).' )'.
 910           '  OR ( svc_field IS NULL AND item = '. dbh->quote($old->$field).' )'.
 911           ')',
 912       });
 913       if ( $old_inv ) {
 914         $old_inv->svcnum('');
 915         $old_inv->svc_field('');
 916         my $oerror = $old_inv->replace;
 917         if ( $oerror ) {
 918           $dbh->rollback if $oldAutoCommit;
 919           return "Error unprovisioning inventory: $oerror";
 920         }
 921       } else {
 922         warn "old inventory_item not found for $field ". $self->$field;
 923       }
 924     }
 925
 926     $inventory_item->svcnum( $self->svcnum );
 927     $inventory_item->svc_field( $field );
 928     my $ierror = $inventory_item->replace();
 929     if ( $ierror ) {
 930       $dbh->rollback if $oldAutoCommit;
 931       return "Error provisioning inventory: $ierror";
 932     }
 933
 934   }
 935
 936  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 937
 938  '';
 939
 940 }
 941
 942 =item return_inventory
 943
 944 =cut
 945
 946 sub return_inventory {
 947   my $self = shift;
 948
 949   local $SIG{HUP} = 'IGNORE';
 950   local $SIG{INT} = 'IGNORE';
 951   local $SIG{QUIT} = 'IGNORE';
 952   local $SIG{TERM} = 'IGNORE';
 953   local $SIG{TSTP} = 'IGNORE';
 954   local $SIG{PIPE} = 'IGNORE';
 955
 956   my $oldAutoCommit = $FS::UID::AutoCommit;
 957   local $FS::UID::AutoCommit = 0;
 958   my $dbh = dbh;
 959
 960   foreach my $inventory_item ( $self->inventory_item ) {
 961     $inventory_item->svcnum('');
 962     $inventory_item->svc_field('');
 963     my $error = $inventory_item->replace();
 964     if ( $error ) {
 965       $dbh->rollback if $oldAutoCommit;
 966       return "Error returning inventory: $error";
 967     }
 968   }
 969
 970   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 971
 972   '';
 973 }
 974
 975 =item inventory_item
 976
 977 Returns the inventory items associated with this svc_ record, as
 978 FS::inventory_item objects (see L<FS::inventory_item>.
 979
 980 =cut
 981
 982 sub inventory_item {
 983   my $self = shift;
 984   qsearch({
 985     'table'     => 'inventory_item',
 986     'hashref'   => { 'svcnum' => $self->svcnum, },
 987   });
 988 }
 989
 990 =item cust_svc
 991
 992 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
 993 object (see L<FS::cust_svc>).
 994
 995 =cut
 996
 997 sub cust_svc {
 998   my $self = shift;
 999   qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
1000 }
1001
1002 =item suspend
1003
1004 Runs export_suspend callbacks.
1005
1006 =cut
1007
1008 sub suspend {
1009   my $self = shift;
1010   my %options = @_;
1011   my $export_args = $options{'export_args'} || [];
1012   $self->export('suspend', @$export_args);
1013 }
1014
1015 =item unsuspend
1016
1017 Runs export_unsuspend callbacks.
1018
1019 =cut
1020
1021 sub unsuspend {
1022   my $self = shift;
1023   my %options = @_;
1024   my $export_args = $options{'export_args'} || [];
1025   $self->export('unsuspend', @$export_args);
1026 }
1027
1028 =item export_links
1029
1030 Runs export_links callbacks and returns the links.
1031
1032 =cut
1033
1034 sub export_links {
1035   my $self = shift;
1036   my $return = [];
1037   $self->export('links', $return);
1038   $return;
1039 }
1040
1041 =item export_getsettings
1042
1043 Runs export_getsettings callbacks and returns the two hashrefs.
1044
1045 =cut
1046
1047 sub export_getsettings {
1048   my $self = shift;
1049   my %settings = ();
1050   my %defaults = ();
1051   my $error = $self->export('getsettings', \%settings, \%defaults);
1052   if ( $error ) {
1053     warn "error running export_getsetings: $error";
1054     return ( { 'error' => $error }, {} );
1055   }
1056   ( \%settings, \%defaults );
1057 }
1058
1059 =item export_getstatus
1060
1061 Runs export_getstatus callbacks and returns a two item list consisting of an
1062 HTML status and a status hashref.
1063
1064 =cut
1065
1066 sub export_getstatus {
1067   my $self = shift;
1068   my $html = '';
1069   my %hash = ();
1070   my $error = $self->export('getstatus', \$html, \%hash);
1071   if ( $error ) {
1072     warn "error running export_getstatus: $error";
1073     return ( '', { 'error' => $error } );
1074   }
1075   ( $html, \%hash );
1076 }
1077
1078 =item export_setstatus
1079
1080 Runs export_setstatus callbacks.  If there is an error, returns the error,
1081 otherwise returns false.
1082
1083 =cut
1084
1085 sub export_setstatus {
1086   my( $self, @args ) = @_;
1087   my $error = $self->export('setstatus', @args);
1088   if ( $error ) {
1089     warn "error running export_setstatus: $error";
1090     return $error;
1091   }
1092   '';
1093 }
1094
1095
1096 =item export HOOK [ EXPORT_ARGS ]
1097
1098 Runs the provided export hook (i.e. "suspend", "unsuspend") for this service.
1099
1100 =cut
1101
1102 sub export {
1103   my( $self, $method ) = ( shift, shift );
1104
1105   $method = "export_$method" unless $method =~ /^export_/;
1106
1107   local $SIG{HUP} = 'IGNORE';
1108   local $SIG{INT} = 'IGNORE';
1109   local $SIG{QUIT} = 'IGNORE';
1110   local $SIG{TERM} = 'IGNORE';
1111   local $SIG{TSTP} = 'IGNORE';
1112   local $SIG{PIPE} = 'IGNORE';
1113
1114   my $oldAutoCommit = $FS::UID::AutoCommit;
1115   local $FS::UID::AutoCommit = 0;
1116   my $dbh = dbh;
1117
1118   #new-style exports!
1119   unless ( $noexport_hack ) {
1120     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
1121       next unless $part_export->can($method);
1122       my $error = $part_export->$method($self, @_);
1123       if ( $error ) {
1124         $dbh->rollback if $oldAutoCommit;
1125         return "error exporting $method event to ". $part_export->exporttype.
1126                " (transaction rolled back): $error";
1127       }
1128     }
1129   }
1130
1131   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1132   '';
1133
1134 }
1135
1136 =item overlimit
1137
1138 Sets or retrieves overlimit date.
1139
1140 =cut
1141
1142 sub overlimit {
1143   my $self = shift;
1144   #$self->cust_svc->overlimit(@_);
1145   my $cust_svc = $self->cust_svc;
1146   unless ( $cust_svc ) { #wtf?
1147     my $error = "$me overlimit: missing cust_svc record for svc_acct svcnum ".
1148                 $self->svcnum;
1149     if ( $overlimit_missing_cust_svc_nonfatal_kludge ) {
1150       cluck "$error; continuing anyway as requested";
1151       return '';
1152     } else {
1153       confess $error;
1154     }
1155   }
1156   $cust_svc->overlimit(@_);
1157 }
1158
1159 =item cancel
1160
1161 Stub - returns false (no error) so derived classes don't need to define this
1162 methods.  Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
1163
1164 This method is called *before* the deletion step which actually deletes the
1165 services.  This method should therefore only be used for "pre-deletion"
1166 cancellation steps, if necessary.
1167
1168 =cut
1169
1170 sub cancel { ''; }
1171
1172 =item clone_suspended
1173
1174 Constructor used by FS::part_export::_export_suspend fallback.  Stub returning
1175 same object for svc_ classes which don't implement a suspension fallback
1176 (everything except svc_acct at the moment).  Document better.
1177
1178 =cut
1179
1180 sub clone_suspended {
1181   shift;
1182 }
1183
1184 =item clone_kludge_unsuspend
1185
1186 Constructor used by FS::part_export::_export_unsuspend fallback.  Stub returning
1187 same object for svc_ classes which don't implement a suspension fallback
1188 (everything except svc_acct at the moment).  Document better.
1189
1190 =cut
1191
1192 sub clone_kludge_unsuspend {
1193   shift;
1194 }
1195
1196 =item find_duplicates MODE FIELDS...
1197
1198 Method used by _check_duplicate routines to find services with duplicate
1199 values in specified fields.  Set MODE to 'global' to search across all
1200 services, or 'export' to limit to those that share one or more exports
1201 with this service.  FIELDS is a list of field names; only services
1202 matching in all fields will be returned.  Empty fields will be skipped.
1203
1204 =cut
1205
1206 sub find_duplicates {
1207   my $self = shift;
1208   my $mode = shift;
1209   my @fields = @_;
1210
1211   my %search = map { $_ => $self->getfield($_) }
1212                grep { length($self->getfield($_)) } @fields;
1213   return () if !%search;
1214   my @dup = grep { ! $self->svcnum or $_->svcnum != $self->svcnum }
1215             qsearch( $self->table, \%search );
1216   return () if !@dup;
1217   return @dup if $mode eq 'global';
1218   die "incorrect find_duplicates mode '$mode'" if $mode ne 'export';
1219
1220   my $exports = FS::part_export::export_info($self->table);
1221   my %conflict_svcparts;
1222   my $part_svc = $self->part_svc;
1223   foreach my $part_export ( $part_svc->part_export ) {
1224     %conflict_svcparts = map { $_->svcpart => 1 } $part_export->export_svc;
1225   }
1226   return grep { $conflict_svcparts{$_->cust_svc->svcpart} } @dup;
1227 }
1228
1229 =item getstatus_html
1230
1231 =cut
1232
1233 sub getstatus_html {
1234   my $self = shift;
1235
1236   my $part_svc = $self->cust_svc->part_svc;
1237
1238   my $html = '';
1239
1240   foreach my $export ( grep $_->can('export_getstatus'), $part_svc->part_export ) {
1241     my $export_html = '';
1242     my %hash = ();
1243     $export->export_getstatus( $self, \$export_html, \%hash );
1244     $html .= $export_html;
1245   }
1246
1247   $html;
1248
1249 }
1250
1251 =item nms_ip_insert
1252
1253 =cut
1254
1255 sub nms_ip_insert {
1256   my $self = shift;
1257   my $conf = new FS::Conf;
1258   return '' unless grep { $self->table eq $_ }
1259                      $conf->config('nms-auto_add-svc_ips');
1260   my $ip_field = $self->table_info->{'ip_field'};
1261
1262   my $queue = FS::queue->new( {
1263                 'job'    => 'FS::NetworkMonitoringSystem::queued_add_router',
1264                 'svcnum' => $self->svcnum,
1265   } );
1266   $queue->insert( 'FS::NetworkMonitoringSystem',
1267                   $self->$ip_field(),
1268                   $conf->config('nms-auto_add-community')
1269                 );
1270 }
1271
1272 =item nms_delip
1273
1274 =cut
1275
1276 sub nms_ip_delete {
1277 #XXX not yet implemented
1278 }
1279
1280 =back
1281
1282 =head1 BUGS
1283
1284 The setfixed method return value.
1285
1286 B<export> method isn't used by insert and replace methods yet.
1287
1288 =head1 SEE ALSO
1289
1290 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
1291 from the base documentation.
1292
1293 =cut
1294
1295 1;
1296