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