FS/FS/svc_Common.pm

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