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