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