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