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