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 {
1046   my( $self, @args ) = @_;
1047   my $error = $self->export('setstatus', @args);
1048   if ( $error ) {
1049     warn "error running export_setstatus: $error";
1050     return $error;
1051   }
1052   '';
1053 }
1054
1055
1056 =item export HOOK [ EXPORT_ARGS ]
1057
1058 Runs the provided export hook (i.e. "suspend", "unsuspend") for this service.
1059
1060 =cut
1061
1062 sub export {
1063   my( $self, $method ) = ( shift, shift );
1064
1065   $method = "export_$method" unless $method =~ /^export_/;
1066
1067   local $SIG{HUP} = 'IGNORE';
1068   local $SIG{INT} = 'IGNORE';
1069   local $SIG{QUIT} = 'IGNORE';
1070   local $SIG{TERM} = 'IGNORE';
1071   local $SIG{TSTP} = 'IGNORE';
1072   local $SIG{PIPE} = 'IGNORE';
1073
1074   my $oldAutoCommit = $FS::UID::AutoCommit;
1075   local $FS::UID::AutoCommit = 0;
1076   my $dbh = dbh;
1077
1078   #new-style exports!
1079   unless ( $noexport_hack ) {
1080     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
1081       next unless $part_export->can($method);
1082       my $error = $part_export->$method($self, @_);
1083       if ( $error ) {
1084         $dbh->rollback if $oldAutoCommit;
1085         return "error exporting $method event to ". $part_export->exporttype.
1086                " (transaction rolled back): $error";
1087       }
1088     }
1089   }
1090
1091   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1092   '';
1093
1094 }
1095
1096 =item overlimit
1097
1098 Sets or retrieves overlimit date.
1099
1100 =cut
1101
1102 sub overlimit {
1103   my $self = shift;
1104   #$self->cust_svc->overlimit(@_);
1105   my $cust_svc = $self->cust_svc;
1106   unless ( $cust_svc ) { #wtf?
1107     my $error = "$me overlimit: missing cust_svc record for svc_acct svcnum ".
1108                 $self->svcnum;
1109     if ( $overlimit_missing_cust_svc_nonfatal_kludge ) {
1110       cluck "$error; continuing anyway as requested";
1111       return '';
1112     } else {
1113       confess $error;
1114     }
1115   }
1116   $cust_svc->overlimit(@_);
1117 }
1118
1119 =item cancel
1120
1121 Stub - returns false (no error) so derived classes don't need to define this
1122 methods.  Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
1123
1124 This method is called *before* the deletion step which actually deletes the
1125 services.  This method should therefore only be used for "pre-deletion"
1126 cancellation steps, if necessary.
1127
1128 =cut
1129
1130 sub cancel { ''; }
1131
1132 =item clone_suspended
1133
1134 Constructor used by FS::part_export::_export_suspend fallback.  Stub returning
1135 same object for svc_ classes which don't implement a suspension fallback
1136 (everything except svc_acct at the moment).  Document better.
1137
1138 =cut
1139
1140 sub clone_suspended {
1141   shift;
1142 }
1143
1144 =item clone_kludge_unsuspend
1145
1146 Constructor used by FS::part_export::_export_unsuspend fallback.  Stub returning
1147 same object for svc_ classes which don't implement a suspension fallback
1148 (everything except svc_acct at the moment).  Document better.
1149
1150 =cut
1151
1152 sub clone_kludge_unsuspend {
1153   shift;
1154 }
1155
1156 =item find_duplicates MODE FIELDS...
1157
1158 Method used by _check_duplicate routines to find services with duplicate
1159 values in specified fields.  Set MODE to 'global' to search across all
1160 services, or 'export' to limit to those that share one or more exports
1161 with this service.  FIELDS is a list of field names; only services
1162 matching in all fields will be returned.  Empty fields will be skipped.
1163
1164 =cut
1165
1166 sub find_duplicates {
1167   my $self = shift;
1168   my $mode = shift;
1169   my @fields = @_;
1170
1171   my %search = map { $_ => $self->getfield($_) }
1172                grep { length($self->getfield($_)) } @fields;
1173   return () if !%search;
1174   my @dup = grep { ! $self->svcnum or $_->svcnum != $self->svcnum }
1175             qsearch( $self->table, \%search );
1176   return () if !@dup;
1177   return @dup if $mode eq 'global';
1178   die "incorrect find_duplicates mode '$mode'" if $mode ne 'export';
1179
1180   my $exports = FS::part_export::export_info($self->table);
1181   my %conflict_svcparts;
1182   my $part_svc = $self->part_svc;
1183   foreach my $part_export ( $part_svc->part_export ) {
1184     %conflict_svcparts = map { $_->svcpart => 1 } $part_export->export_svc;
1185   }
1186   return grep { $conflict_svcparts{$_->cust_svc->svcpart} } @dup;
1187 }
1188
1189 =item getstatus_html
1190
1191 =cut
1192
1193 sub getstatus_html {
1194   my $self = shift;
1195
1196   my $part_svc = $self->cust_svc->part_svc;
1197
1198   my $html = '';
1199
1200   foreach my $export ( grep $_->can('export_getstatus'), $part_svc->part_export ) {
1201     my $export_html = '';
1202     my %hash = ();
1203     $export->export_getstatus( $self, \$export_html, \%hash );
1204     $html .= $export_html;
1205   }
1206
1207   $html;
1208
1209 }
1210
1211 =item nms_ip_insert
1212
1213 =cut
1214
1215 sub nms_ip_insert {
1216   my $self = shift;
1217   my $conf = new FS::Conf;
1218   return '' unless grep { $self->table eq $_ }
1219                      $conf->config('nms-auto_add-svc_ips');
1220   my $ip_field = $self->table_info->{'ip_field'};
1221
1222   my $queue = FS::queue->new( {
1223                 'job'    => 'FS::NetworkMonitoringSystem::queued_add_router',
1224                 'svcnum' => $self->svcnum,
1225   } );
1226   $queue->insert( 'FS::NetworkMonitoringSystem',
1227                   $self->$ip_field(),
1228                   $conf->config('nms-auto_add-community')
1229                 );
1230 }
1231
1232 =item nms_delip
1233
1234 =cut
1235
1236 sub nms_ip_delete {
1237 #XXX not yet implemented
1238 }
1239
1240 =back
1241
1242 =head1 BUGS
1243
1244 The setfixed method return value.
1245
1246 B<export> method isn't used by insert and replace methods yet.
1247
1248 =head1 SEE ALSO
1249
1250 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
1251 from the base documentation.
1252
1253 =cut
1254
1255 1;
1256