FS/FS/svc_Common.pm

   1 package FS::svc_Common;
   2
   3 use strict;
   4 use vars qw( @ISA $noexport_hack $DEBUG $me
   5              $overlimit_missing_cust_svc_nonfatal_kludge );
   6 use Carp qw( cluck carp croak confess ); #specify cluck have to specify them all
   7 use Scalar::Util qw( blessed );
   8 use Lingua::EN::Inflect qw( PL_N );
   9 use FS::Conf;
  10 use FS::Record qw( qsearch qsearchs fields dbh );
  11 use FS::cust_main_Mixin;
  12 use FS::cust_svc;
  13 use FS::part_svc;
  14 use FS::queue;
  15 use FS::cust_main;
  16 use FS::inventory_item;
  17 use FS::inventory_class;
  18 use FS::NetworkMonitoringSystem;
  19
  20 @ISA = qw( FS::cust_main_Mixin FS::Record );
  21
  22 $me = '[FS::svc_Common]';
  23 $DEBUG = 0;
  24
  25 $overlimit_missing_cust_svc_nonfatal_kludge = 0;
  26
  27 =head1 NAME
  28
  29 FS::svc_Common - Object method for all svc_ records
  30
  31 =head1 SYNOPSIS
  32
  33 use FS::svc_Common;
  34
  35 @ISA = qw( FS::svc_Common );
  36
  37 =head1 DESCRIPTION
  38
  39 FS::svc_Common is intended as a base class for table-specific classes to
  40 inherit from, i.e. FS::svc_acct.  FS::svc_Common inherits from FS::Record.
  41
  42 =head1 METHODS
  43
  44 =over 4
  45
  46 =item new
  47
  48 =cut
  49
  50 sub new {
  51   my $proto = shift;
  52   my $class = ref($proto) || $proto;
  53   my $self = {};
  54   bless ($self, $class);
  55
  56   unless ( defined ( $self->table ) ) {
  57     $self->{'Table'} = shift;
  58     carp "warning: FS::Record::new called with table name ". $self->{'Table'};
  59   }
  60
  61   #$self->{'Hash'} = shift;
  62   my $newhash = shift;
  63   $self->{'Hash'} = { map { $_ => $newhash->{$_} } qw(svcnum svcpart) };
  64
  65   $self->setdefault( $self->_fieldhandlers )
  66     unless $self->svcnum;
  67
  68   $self->{'Hash'}{$_} = $newhash->{$_}
  69     foreach grep { defined($newhash->{$_}) && length($newhash->{$_}) }
  70                  keys %$newhash;
  71
  72   foreach my $field ( grep !defined($self->{'Hash'}{$_}), $self->fields ) {
  73     $self->{'Hash'}{$field}='';
  74   }
  75
  76   $self->_rebless if $self->can('_rebless');
  77
  78   $self->{'modified'} = 0;
  79
  80   $self->_cache($self->{'Hash'}, shift) if $self->can('_cache') && @_;
  81
  82   $self;
  83 }
  84
  85 #empty default
  86 sub _fieldhandlers { {}; }
  87
  88 sub virtual_fields {
  89
  90   # This restricts the fields based on part_svc_column and the svcpart of
  91   # the service.  There are four possible cases:
  92   # 1.  svcpart passed as part of the svc_x hash.
  93   # 2.  svcpart fetched via cust_svc based on svcnum.
  94   # 3.  No svcnum or svcpart.  In this case, return ALL the fields with
  95   #     dbtable eq $self->table.
  96   # 4.  Called via "fields('svc_acct')" or something similar.  In this case
  97   #     there is no $self object.
  98
  99   my $self = shift;
 100   my $svcpart;
 101   my @vfields = $self->SUPER::virtual_fields;
 102
 103   return @vfields unless (ref $self); # Case 4
 104
 105   if ($self->svcpart) { # Case 1
 106     $svcpart = $self->svcpart;
 107   } elsif ( $self->svcnum
 108             && qsearchs('cust_svc',{'svcnum'=>$self->svcnum} )
 109           ) { #Case 2
 110     $svcpart = $self->cust_svc->svcpart;
 111   } else { # Case 3
 112     $svcpart = '';
 113   }
 114
 115   if ($svcpart) { #Cases 1 and 2
 116     my %flags = map { $_->columnname, $_->columnflag } (
 117         qsearch ('part_svc_column', { svcpart => $svcpart } )
 118       );
 119     return grep { not ( defined($flags{$_}) && $flags{$_} eq 'X') } @vfields;
 120   } else { # Case 3
 121     return @vfields;
 122   }
 123   return ();
 124 }
 125
 126 =item label
 127
 128 svc_Common provides a fallback label subroutine that just returns the svcnum.
 129
 130 =cut
 131
 132 sub label {
 133   my $self = shift;
 134   cluck "warning: ". ref($self). " not loaded or missing label method; ".
 135         "using svcnum";
 136   $self->svcnum;
 137 }
 138
 139 sub label_long {
 140   my $self = shift;
 141   $self->label(@_);
 142 }
 143
 144 sub cust_main {
 145   my $self = shift;
 146   (($self->cust_svc || return)->cust_pkg || return)->cust_main || return
 147 }
 148
 149 sub cust_linked {
 150   my $self = shift;
 151   defined($self->cust_main);
 152 }
 153
 154 =item check
 155
 156 Checks the validity of fields in this record.
 157
 158 Only checks fields marked as required in table_info or
 159 part_svc_column definition.  Should be invoked by service-specific
 160 check using SUPER.  Invokes FS::Record::check using SUPER.
 161
 162 =cut
 163
 164 sub check {
 165   my $self = shift;
 166
 167   ## Checking required fields
 168
 169   # get fields marked as required in table_info
 170   my $required = {};
 171   my $labels = {};
 172   my $tinfo = $self->can('table_info') ? $self->table_info : {};
 173   if ($tinfo->{'manual_require'}) {
 174     my $fields = $tinfo->{'fields'} || {};
 175     foreach my $field (keys %$fields) {
 176       if (ref($fields->{$field}) && $fields->{$field}->{'required'}) {
 177         $required->{$field} = 1;
 178         $labels->{$field} = $fields->{$field}->{'label'};
 179       }
 180     }
 181     # add fields marked as required in database
 182     foreach my $column (
 183       qsearch('part_svc_column',{
 184         'svcpart' => $self->svcpart,
 185         'required' => 'Y'
 186       })
 187     ) {
 188       $required->{$column->columnname} = 1;
 189       $labels->{$column->columnname} = $column->columnlabel;
 190     }
 191     # do the actual checking
 192     foreach my $field (keys %$required) {
 193       unless (length($self->get($field)) > 0) {
 194         my $name = $labels->{$field} || $field;
 195         return "$name is required\n"
 196       }
 197     }
 198   }
 199
 200   $self->SUPER::check;
 201 }
 202
 203 =item insert [ , OPTION => VALUE ... ]
 204
 205 Adds this record to the database.  If there is an error, returns the error,
 206 otherwise returns false.
 207
 208 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
 209 defined.  An FS::cust_svc record will be created and inserted.
 210
 211 Currently available options are: I<jobnums>, I<child_objects> and
 212 I<depend_jobnum>.
 213
 214 If I<jobnum> is set to an array reference, the jobnums of any export jobs will
 215 be added to the referenced array.
 216
 217 If I<child_objects> is set to an array reference of FS::tablename objects
 218 (for example, FS::svc_export_machine or FS::acct_snarf objects), they
 219 will have their svcnum field set and will be inserted after this record,
 220 but before any exports are run.  Each element of the array can also
 221 optionally be a two-element array reference containing the child object
 222 and the name of an alternate field to be filled in with the newly-inserted
 223 svcnum, for example C<[ $svc_forward, 'srcsvc' ]>
 224
 225 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
 226 jobnums), all provisioning jobs will have a dependancy on the supplied
 227 jobnum(s) (they will not run until the specific job(s) complete(s)).
 228
 229 If I<export_args> is set to an array reference, the referenced list will be
 230 passed to export commands.
 231
 232 =cut
 233
 234 sub insert {
 235   my $self = shift;
 236   my %options = @_;
 237   warn "[$me] insert called with options ".
 238        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 239     if $DEBUG;
 240
 241   my @jobnums = ();
 242   local $FS::queue::jobnums = \@jobnums;
 243   warn "[$me] insert: set \$FS::queue::jobnums to $FS::queue::jobnums\n"
 244     if $DEBUG;
 245   my $objects = $options{'child_objects'} || [];
 246   my $depend_jobnums = $options{'depend_jobnum'} || [];
 247   $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
 248
 249   local $SIG{HUP} = 'IGNORE';
 250   local $SIG{INT} = 'IGNORE';
 251   local $SIG{QUIT} = 'IGNORE';
 252   local $SIG{TERM} = 'IGNORE';
 253   local $SIG{TSTP} = 'IGNORE';
 254   local $SIG{PIPE} = 'IGNORE';
 255
 256   my $oldAutoCommit = $FS::UID::AutoCommit;
 257   local $FS::UID::AutoCommit = 0;
 258   my $dbh = dbh;
 259
 260   my $svcnum = $self->svcnum;
 261   my $cust_svc = $svcnum ? qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) : '';
 262   my $inserted_cust_svc = 0;
 263   #unless ( $svcnum ) {
 264   if ( !$svcnum or !$cust_svc ) {
 265     $cust_svc = new FS::cust_svc ( {
 266       #hua?# 'svcnum'  => $svcnum,
 267       'svcnum'  => $self->svcnum,
 268       'pkgnum'  => $self->pkgnum,
 269       'svcpart' => $self->svcpart,
 270     } );
 271     my $error = $cust_svc->insert;
 272     if ( $error ) {
 273       $dbh->rollback if $oldAutoCommit;
 274       return $error;
 275     }
 276     $inserted_cust_svc  = 1;
 277     $svcnum = $self->svcnum($cust_svc->svcnum);
 278   } else {
 279     #$cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
 280     unless ( $cust_svc ) {
 281       $dbh->rollback if $oldAutoCommit;
 282       return "no cust_svc record found for svcnum ". $self->svcnum;
 283     }
 284     $self->pkgnum($cust_svc->pkgnum);
 285     $self->svcpart($cust_svc->svcpart);
 286   }
 287
 288   my $error =    $self->preinsert_hook_first(%options)
 289               || $self->set_auto_inventory
 290               || $self->check
 291               || $self->_check_duplicate
 292               || $self->preinsert_hook
 293               || $self->SUPER::insert;
 294   if ( $error ) {
 295     if ( $inserted_cust_svc ) {
 296       my $derror = $cust_svc->delete;
 297       die $derror if $derror;
 298     }
 299     $dbh->rollback if $oldAutoCommit;
 300     return $error;
 301   }
 302
 303   foreach my $object ( @$objects ) {
 304     my($field, $obj);
 305     if ( ref($object) eq 'ARRAY' ) {
 306       ($obj, $field) = @$object;
 307     } else {
 308       $obj = $object;
 309       $field = 'svcnum';
 310     }
 311     $obj->$field($self->svcnum);
 312     $error = $obj->insert;
 313     if ( $error ) {
 314       $dbh->rollback if $oldAutoCommit;
 315       return $error;
 316     }
 317   }
 318
 319   #new-style exports!
 320   unless ( $noexport_hack ) {
 321
 322     warn "[$me] insert: \$FS::queue::jobnums is $FS::queue::jobnums\n"
 323       if $DEBUG;
 324
 325     my $export_args = $options{'export_args'} || [];
 326
 327     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 328       my $error = $part_export->export_insert($self, @$export_args);
 329       if ( $error ) {
 330         $dbh->rollback if $oldAutoCommit;
 331         return "exporting to ". $part_export->exporttype.
 332                " (transaction rolled back): $error";
 333       }
 334     }
 335
 336     foreach my $depend_jobnum ( @$depend_jobnums ) {
 337       warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
 338         if $DEBUG;
 339       foreach my $jobnum ( @jobnums ) {
 340         my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
 341         warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
 342           if $DEBUG;
 343         my $error = $queue->depend_insert($depend_jobnum);
 344         if ( $error ) {
 345           $dbh->rollback if $oldAutoCommit;
 346           return "error queuing job dependancy: $error";
 347         }
 348       }
 349     }
 350
 351   }
 352
 353   my $nms_ip_error = $self->nms_ip_insert;
 354   if ( $nms_ip_error ) {
 355     $dbh->rollback if $oldAutoCommit;
 356     return "error queuing IP insert: $nms_ip_error";
 357   }
 358
 359   if ( exists $options{'jobnums'} ) {
 360     push @{ $options{'jobnums'} }, @jobnums;
 361   }
 362
 363   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 364
 365   '';
 366 }
 367
 368 #fallbacks
 369 sub preinsert_hook_first { ''; }
 370 sub _check_duplcate { ''; }
 371 sub preinsert_hook { ''; }
 372 sub table_dupcheck_fields { (); }
 373 sub prereplace_hook { ''; }
 374 sub prereplace_hook_first { ''; }
 375 sub predelete_hook { ''; }
 376 sub predelete_hook_first { ''; }
 377
 378 =item delete [ , OPTION => VALUE ... ]
 379
 380 Deletes this account from the database.  If there is an error, returns the
 381 error, otherwise returns false.
 382
 383 The corresponding FS::cust_svc record will be deleted as well.
 384
 385 =cut
 386
 387 sub delete {
 388   my $self = shift;
 389   my %options = @_;
 390   my $export_args = $options{'export_args'} || [];
 391
 392   local $SIG{HUP} = 'IGNORE';
 393   local $SIG{INT} = 'IGNORE';
 394   local $SIG{QUIT} = 'IGNORE';
 395   local $SIG{TERM} = 'IGNORE';
 396   local $SIG{TSTP} = 'IGNORE';
 397   local $SIG{PIPE} = 'IGNORE';
 398
 399   my $oldAutoCommit = $FS::UID::AutoCommit;
 400   local $FS::UID::AutoCommit = 0;
 401   my $dbh = dbh;
 402
 403   my $error =   $self->predelete_hook_first
 404               || $self->SUPER::delete
 405               || $self->export('delete', @$export_args)
 406               || $self->return_inventory
 407               || $self->release_router
 408               || $self->predelete_hook
 409               || $self->cust_svc->delete
 410   ;
 411   if ( $error ) {
 412     $dbh->rollback if $oldAutoCommit;
 413     return $error;
 414   }
 415
 416   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 417
 418   '';
 419 }
 420
 421 =item expire DATE
 422
 423 Currently this will only run expire exports if any are attached
 424
 425 =cut
 426
 427 sub expire {
 428   my($self,$date) = (shift,shift);
 429
 430   return 'Expire date must be specified' unless $date;
 431
 432   local $SIG{HUP} = 'IGNORE';
 433   local $SIG{INT} = 'IGNORE';
 434   local $SIG{QUIT} = 'IGNORE';
 435   local $SIG{TERM} = 'IGNORE';
 436   local $SIG{TSTP} = 'IGNORE';
 437   local $SIG{PIPE} = 'IGNORE';
 438
 439   my $oldAutoCommit = $FS::UID::AutoCommit;
 440   local $FS::UID::AutoCommit = 0;
 441   my $dbh = dbh;
 442
 443   my $export_args = [$date];
 444   my $error = $self->export('expire', @$export_args);
 445   if ( $error ) {
 446     $dbh->rollback if $oldAutoCommit;
 447     return $error;
 448   }
 449
 450   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 451
 452   '';
 453 }
 454
 455 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ]
 456
 457 Replaces OLD_RECORD with this one.  If there is an error, returns the error,
 458 otherwise returns false.
 459
 460 Currently available options are: I<child_objects>, I<export_args> and
 461 I<depend_jobnum>.
 462
 463 If I<child_objects> is set to an array reference of FS::tablename objects
 464 (for example, FS::svc_export_machine or FS::acct_snarf objects), they
 465 will have their svcnum field set and will be inserted or replaced after
 466 this record, but before any exports are run.  Each element of the array
 467 can also optionally be a two-element array reference containing the
 468 child object and the name of an alternate field to be filled in with
 469 the newly-inserted svcnum, for example C<[ $svc_forward, 'srcsvc' ]>
 470
 471 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
 472 jobnums), all provisioning jobs will have a dependancy on the supplied
 473 jobnum(s) (they will not run until the specific job(s) complete(s)).
 474
 475 If I<export_args> is set to an array reference, the referenced list will be
 476 passed to export commands.
 477
 478 =cut
 479
 480 sub replace {
 481   my $new = shift;
 482
 483   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
 484               ? shift
 485               : $new->replace_old;
 486
 487   my $options =
 488     ( ref($_[0]) eq 'HASH' )
 489       ? shift
 490       : { @_ };
 491
 492   my $objects = $options->{'child_objects'} || [];
 493
 494   my @jobnums = ();
 495   local $FS::queue::jobnums = \@jobnums;
 496   warn "[$me] replace: set \$FS::queue::jobnums to $FS::queue::jobnums\n"
 497     if $DEBUG;
 498   my $depend_jobnums = $options->{'depend_jobnum'} || [];
 499   $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
 500
 501   local $SIG{HUP} = 'IGNORE';
 502   local $SIG{INT} = 'IGNORE';
 503   local $SIG{QUIT} = 'IGNORE';
 504   local $SIG{TERM} = 'IGNORE';
 505   local $SIG{TSTP} = 'IGNORE';
 506   local $SIG{PIPE} = 'IGNORE';
 507
 508   my $oldAutoCommit = $FS::UID::AutoCommit;
 509   local $FS::UID::AutoCommit = 0;
 510   my $dbh = dbh;
 511
 512   my $error =  $new->prereplace_hook_first($old)
 513             || $new->set_auto_inventory($old)
 514             || $new->check; #redundant, but so any duplicate fields are
 515                             #maniuplated as appropriate (svc_phone.phonenum)
 516   if ( $error ) {
 517     $dbh->rollback if $oldAutoCommit;
 518     return $error;
 519   }
 520
 521   #if ( $old->username ne $new->username || $old->domsvc != $new->domsvc ) {
 522   if ( grep { $old->$_ ne $new->$_ } $new->table_dupcheck_fields ) {
 523
 524     $new->svcpart( $new->cust_svc->svcpart ) unless $new->svcpart;
 525     $error = $new->_check_duplicate;
 526     if ( $error ) {
 527       $dbh->rollback if $oldAutoCommit;
 528       return $error;
 529     }
 530   }
 531
 532   $error = $new->SUPER::replace($old);
 533   if ($error) {
 534     $dbh->rollback if $oldAutoCommit;
 535     return $error;
 536   }
 537
 538   foreach my $object ( @$objects ) {
 539     my($field, $obj);
 540     if ( ref($object) eq 'ARRAY' ) {
 541       ($obj, $field) = @$object;
 542     } else {
 543       $obj = $object;
 544       $field = 'svcnum';
 545     }
 546     $obj->$field($new->svcnum);
 547
 548     my $oldobj = qsearchs( $obj->table, {
 549                              $field => $new->svcnum,
 550                              map { $_ => $obj->$_ } $obj->_svc_child_partfields,
 551                          });
 552
 553     if ( $oldobj ) {
 554       my $pkey = $oldobj->primary_key;
 555       $obj->$pkey($oldobj->$pkey);
 556       $obj->replace($oldobj);
 557     } else {
 558       $error = $obj->insert;
 559     }
 560     if ( $error ) {
 561       $dbh->rollback if $oldAutoCommit;
 562       return $error;
 563     }
 564   }
 565
 566   #new-style exports!
 567   unless ( $noexport_hack ) {
 568
 569     warn "[$me] replace: \$FS::queue::jobnums is $FS::queue::jobnums\n"
 570       if $DEBUG;
 571
 572     my $export_args = $options->{'export_args'} || [];
 573
 574     #not quite false laziness, but same pattern as FS::svc_acct::replace and
 575     #FS::part_export::sqlradius::_export_replace.  List::Compare or something
 576     #would be useful but too much of a pain in the ass to deploy
 577
 578     my @old_part_export = $old->cust_svc->part_svc->part_export;
 579     my %old_exportnum = map { $_->exportnum => 1 } @old_part_export;
 580     my @new_part_export =
 581       $new->svcpart
 582         ? qsearchs('part_svc', { svcpart=>$new->svcpart } )->part_export
 583         : $new->cust_svc->part_svc->part_export;
 584     my %new_exportnum = map { $_->exportnum => 1 } @new_part_export;
 585
 586     foreach my $delete_part_export (
 587       grep { ! $new_exportnum{$_->exportnum} } @old_part_export
 588     ) {
 589       my $error = $delete_part_export->export_delete($old, @$export_args);
 590       if ( $error ) {
 591         $dbh->rollback if $oldAutoCommit;
 592         return "error deleting, export to ". $delete_part_export->exporttype.
 593                " (transaction rolled back): $error";
 594       }
 595     }
 596
 597     foreach my $replace_part_export (
 598       grep { $old_exportnum{$_->exportnum} } @new_part_export
 599     ) {
 600       my $error =
 601         $replace_part_export->export_replace( $new, $old, @$export_args);
 602       if ( $error ) {
 603         $dbh->rollback if $oldAutoCommit;
 604         return "error exporting to ". $replace_part_export->exporttype.
 605                " (transaction rolled back): $error";
 606       }
 607     }
 608
 609     foreach my $insert_part_export (
 610       grep { ! $old_exportnum{$_->exportnum} } @new_part_export
 611     ) {
 612       my $error = $insert_part_export->export_insert($new, @$export_args );
 613       if ( $error ) {
 614         $dbh->rollback if $oldAutoCommit;
 615         return "error inserting export to ". $insert_part_export->exporttype.
 616                " (transaction rolled back): $error";
 617       }
 618     }
 619
 620     foreach my $depend_jobnum ( @$depend_jobnums ) {
 621       warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
 622         if $DEBUG;
 623       foreach my $jobnum ( @jobnums ) {
 624         my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
 625         warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
 626           if $DEBUG;
 627         my $error = $queue->depend_insert($depend_jobnum);
 628         if ( $error ) {
 629           $dbh->rollback if $oldAutoCommit;
 630           return "error queuing job dependancy: $error";
 631         }
 632       }
 633     }
 634
 635   }
 636
 637   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 638   '';
 639 }
 640
 641 =item setfixed
 642
 643 Sets any fixed fields for this service (see L<FS::part_svc>).  If there is an
 644 error, returns the error, otherwise returns the FS::part_svc object (use ref()
 645 to test the return).  Usually called by the check method.
 646
 647 =cut
 648
 649 sub setfixed {
 650   my $self = shift;
 651   $self->setx('F', @_);
 652 }
 653
 654 =item setdefault
 655
 656 Sets all fields to their defaults (see L<FS::part_svc>), overriding their
 657 current values.  If there is an error, returns the error, otherwise returns
 658 the FS::part_svc object (use ref() to test the return).
 659
 660 =cut
 661
 662 sub setdefault {
 663   my $self = shift;
 664   $self->setx('D', @_ );
 665 }
 666
 667 =item set_default_and_fixed
 668
 669 =cut
 670
 671 sub set_default_and_fixed {
 672   my $self = shift;
 673   $self->setx( [ 'D', 'F' ], @_ );
 674 }
 675
 676 =item setx FLAG | FLAG_ARRAYREF , [ CALLBACK_HASHREF ]
 677
 678 Sets fields according to the passed in flag or arrayref of flags.
 679
 680 Optionally, a hashref of field names and callback coderefs can be passed.
 681 If a coderef exists for a given field name, instead of setting the field,
 682 the coderef is called with the column value (part_svc_column.columnvalue)
 683 as the single parameter.
 684
 685 =cut
 686
 687 sub setx {
 688   my $self = shift;
 689   my $x = shift;
 690   my @x = ref($x) ? @$x : ($x);
 691   my $coderef = scalar(@_) ? shift : $self->_fieldhandlers;
 692
 693   my $error =
 694     $self->ut_numbern('svcnum')
 695   ;
 696   return $error if $error;
 697
 698   my $part_svc = $self->part_svc;
 699   return "Unknown svcpart" unless $part_svc;
 700
 701   #set default/fixed/whatever fields from part_svc
 702
 703   foreach my $part_svc_column (
 704     grep { my $f = $_->columnflag; grep { $f eq $_ } @x } #columnflag in @x
 705     $part_svc->all_part_svc_column
 706   ) {
 707
 708     my $columnname  = $part_svc_column->columnname;
 709     my $columnvalue = $part_svc_column->columnvalue;
 710
 711     $columnvalue = &{ $coderef->{$columnname} }( $self, $columnvalue )
 712       if exists( $coderef->{$columnname} );
 713     $self->setfield( $columnname, $columnvalue );
 714
 715   }
 716
 717  $part_svc;
 718
 719 }
 720
 721 sub part_svc {
 722   my $self = shift;
 723
 724   #get part_svc
 725   my $svcpart;
 726   if ( $self->get('svcpart') ) {
 727     $svcpart = $self->get('svcpart');
 728   } elsif ( $self->svcnum && qsearchs('cust_svc', {'svcnum'=>$self->svcnum}) ) {
 729     my $cust_svc = $self->cust_svc;
 730     return "Unknown svcnum" unless $cust_svc;
 731     $svcpart = $cust_svc->svcpart;
 732   }
 733
 734   qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
 735
 736 }
 737
 738 =item svc_pbx
 739
 740 Returns the FS::svc_pbx record for this service, if any (see L<FS::svc_pbx>).
 741
 742 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
 743 svc_acct).
 744
 745 =cut
 746
 747 # XXX FS::h_svc_{acct,phone} could have a history-aware svc_pbx override
 748
 749 sub svc_pbx {
 750   my $self = shift;
 751   return '' unless $self->pbxsvc;
 752   qsearchs( 'svc_pbx', { 'svcnum' => $self->pbxsvc } );
 753 }
 754
 755 =item pbx_title
 756
 757 Returns the title of the FS::svc_pbx record associated with this service, if
 758 any.
 759
 760 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
 761 svc_acct).
 762
 763 =cut
 764
 765 sub pbx_title {
 766   my $self = shift;
 767   my $svc_pbx = $self->svc_pbx or return '';
 768   $svc_pbx->title;
 769 }
 770
 771 =item pbx_select_hash %OPTIONS
 772
 773 Can be called as an object method or a class method.
 774
 775 Returns a hash SVCNUM => TITLE ...  representing the PBXes this customer
 776 that may be associated with this service.
 777
 778 Currently available options are: I<pkgnum> I<svcpart>
 779
 780 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
 781 svc_acct).
 782
 783 =cut
 784
 785 #false laziness w/svc_acct::domain_select_hash
 786 sub pbx_select_hash {
 787   my ($self, %options) = @_;
 788   my %pbxes = ();
 789   my $part_svc;
 790   my $cust_pkg;
 791
 792   if (ref($self)) {
 793     $part_svc = $self->part_svc;
 794     $cust_pkg = $self->cust_svc->cust_pkg
 795       if $self->cust_svc;
 796   }
 797
 798   $part_svc = qsearchs('part_svc', { 'svcpart' => $options{svcpart} })
 799     if $options{'svcpart'};
 800
 801   $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $options{pkgnum} })
 802     if $options{'pkgnum'};
 803
 804   if ($part_svc && ( $part_svc->part_svc_column('pbxsvc')->columnflag eq 'S'
 805                   || $part_svc->part_svc_column('pbxsvc')->columnflag eq 'F')) {
 806     %pbxes = map { $_->svcnum => $_->title }
 807              map { qsearchs('svc_pbx', { 'svcnum' => $_ }) }
 808              split(',', $part_svc->part_svc_column('pbxsvc')->columnvalue);
 809   } elsif ($cust_pkg) { # && !$conf->exists('svc_acct-alldomains') ) {
 810     %pbxes = map { $_->svcnum => $_->title }
 811              map { qsearchs('svc_pbx', { 'svcnum' => $_->svcnum }) }
 812              map { qsearch('cust_svc', { 'pkgnum' => $_->pkgnum } ) }
 813              qsearch('cust_pkg', { 'custnum' => $cust_pkg->custnum });
 814   } else {
 815     #XXX agent-virt
 816     %pbxes = map { $_->svcnum => $_->title } qsearch('svc_pbx', {} );
 817   }
 818
 819   if ($part_svc && $part_svc->part_svc_column('pbxsvc')->columnflag eq 'D') {
 820     my $svc_pbx = qsearchs('svc_pbx',
 821       { 'svcnum' => $part_svc->part_svc_column('pbxsvc')->columnvalue } );
 822     if ( $svc_pbx ) {
 823       $pbxes{$svc_pbx->svcnum}  = $svc_pbx->title;
 824     } else {
 825       warn "unknown svc_pbx.svcnum for part_svc_column pbxsvc: ".
 826            $part_svc->part_svc_column('pbxsvc')->columnvalue;
 827
 828     }
 829   }
 830
 831   (%pbxes);
 832
 833 }
 834
 835 =item set_auto_inventory
 836
 837 Sets any fields which auto-populate from inventory (see L<FS::part_svc>), and
 838 also check any manually populated inventory fields.
 839
 840 If there is an error, returns the error, otherwise returns false.
 841
 842 =cut
 843
 844 sub set_auto_inventory {
 845   # don't try to do this during an upgrade
 846   return '' if $FS::CurrentUser::upgrade_hack;
 847
 848   my $self = shift;
 849   my $old = @_ ? shift : '';
 850
 851   my $error =
 852     $self->ut_numbern('svcnum')
 853   ;
 854   return $error if $error;
 855
 856   my $part_svc = $self->part_svc;
 857   return "Unkonwn svcpart" unless $part_svc;
 858
 859   local $SIG{HUP} = 'IGNORE';
 860   local $SIG{INT} = 'IGNORE';
 861   local $SIG{QUIT} = 'IGNORE';
 862   local $SIG{TERM} = 'IGNORE';
 863   local $SIG{TSTP} = 'IGNORE';
 864   local $SIG{PIPE} = 'IGNORE';
 865
 866   my $oldAutoCommit = $FS::UID::AutoCommit;
 867   local $FS::UID::AutoCommit = 0;
 868   my $dbh = dbh;
 869
 870   #set default/fixed/whatever fields from part_svc
 871   my $table = $self->table;
 872   foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
 873
 874     my $part_svc_column = $part_svc->part_svc_column($field);
 875     my $columnflag = $part_svc_column->columnflag;
 876     next unless $columnflag =~ /^[AM]$/;
 877
 878     next if $columnflag eq 'A' && $self->$field() ne '';
 879
 880     my $classnum = $part_svc_column->columnvalue;
 881     my %hash;
 882
 883     if ( $columnflag eq 'A' && $self->$field() eq '' ) {
 884       $hash{'svcnum'} = '';
 885     } elsif ( $columnflag eq 'M' ) {
 886       return "Select inventory item for $field" unless $self->getfield($field);
 887       $hash{'item'} = $self->getfield($field);
 888       my $chosen_classnum = $self->getfield($field.'_classnum');
 889       if ( grep {$_ == $chosen_classnum} split(',', $classnum) ) {
 890         $classnum = $chosen_classnum;
 891       }
 892       # otherwise the chosen classnum is either (all), or somehow not on
 893       # the list, so ignore it and choose the first item that's in any
 894       # class on the list
 895     }
 896
 897     my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql(
 898       'null'  => 1,
 899       'table' => 'inventory_item',
 900     );
 901
 902     my $inventory_item = qsearchs({
 903       'table'     => 'inventory_item',
 904       'hashref'   => \%hash,
 905       'extra_sql' => "AND classnum IN ($classnum) AND $agentnums_sql",
 906       'order_by'  => 'ORDER BY ( agentnum IS NULL ) '. #agent inventory first
 907                      ' LIMIT 1 FOR UPDATE',
 908     });
 909
 910     unless ( $inventory_item ) {
 911       # should really only be shown if columnflag eq 'A'...
 912       $dbh->rollback if $oldAutoCommit;
 913       my $message = 'Out of ';
 914       my @classnums = split(',', $classnum);
 915       foreach ( @classnums ) {
 916         my $class = FS::inventory_class->by_key($_)
 917           or return "Can't find inventory_class.classnum $_";
 918         $message .= PL_N($class->classname);
 919         if ( scalar(@classnums) > 2 ) { # english is hard
 920           if ( $_ != $classnums[-1] ) {
 921             $message .= ', ';
 922           }
 923         }
 924         if ( scalar(@classnums) > 1 and $_ == $classnums[-2] ) {
 925           $message .= 'and ';
 926         }
 927       }
 928       return $message;
 929     }
 930
 931     next if $columnflag eq 'M' && $inventory_item->svcnum == $self->svcnum;
 932
 933     $self->setfield( $field, $inventory_item->item );
 934       #if $columnflag eq 'A' && $self->$field() eq '';
 935
 936     # release the old inventory item, if there was one
 937     if ( $old && $old->$field() && $old->$field() ne $self->$field() ) {
 938       my $old_inv = qsearchs({
 939         'table'     => 'inventory_item',
 940         'hashref'   => {
 941                          'svcnum'   => $old->svcnum,
 942                        },
 943         'extra_sql' => "AND classnum IN ($classnum) AND ".
 944           '( ( svc_field IS NOT NULL AND svc_field = '.$dbh->quote($field).' )'.
 945           '  OR ( svc_field IS NULL AND item = '. dbh->quote($old->$field).' )'.
 946           ')',
 947       });
 948       if ( $old_inv ) {
 949         $old_inv->svcnum('');
 950         $old_inv->svc_field('');
 951         my $oerror = $old_inv->replace;
 952         if ( $oerror ) {
 953           $dbh->rollback if $oldAutoCommit;
 954           return "Error unprovisioning inventory: $oerror";
 955         }
 956       } else {
 957         warn "old inventory_item not found for $field ". $self->$field;
 958       }
 959     }
 960
 961     $inventory_item->svcnum( $self->svcnum );
 962     $inventory_item->svc_field( $field );
 963     my $ierror = $inventory_item->replace();
 964     if ( $ierror ) {
 965       $dbh->rollback if $oldAutoCommit;
 966       return "Error provisioning inventory: $ierror";
 967     }
 968
 969   }
 970
 971  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 972
 973  '';
 974
 975 }
 976
 977 =item return_inventory
 978
 979 Release all inventory items attached to this service's fields.  Call
 980 when unprovisioning the service.
 981
 982 =cut
 983
 984 sub return_inventory {
 985   my $self = shift;
 986
 987   local $SIG{HUP} = 'IGNORE';
 988   local $SIG{INT} = 'IGNORE';
 989   local $SIG{QUIT} = 'IGNORE';
 990   local $SIG{TERM} = 'IGNORE';
 991   local $SIG{TSTP} = 'IGNORE';
 992   local $SIG{PIPE} = 'IGNORE';
 993
 994   my $oldAutoCommit = $FS::UID::AutoCommit;
 995   local $FS::UID::AutoCommit = 0;
 996   my $dbh = dbh;
 997
 998   foreach my $inventory_item ( $self->inventory_item ) {
 999     $inventory_item->svcnum('');
1000     $inventory_item->svc_field('');
1001     my $error = $inventory_item->replace();
1002     if ( $error ) {
1003       $dbh->rollback if $oldAutoCommit;
1004       return "Error returning inventory: $error";
1005     }
1006   }
1007
1008   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1009
1010   '';
1011 }
1012
1013 =item inventory_item
1014
1015 Returns the inventory items associated with this svc_ record, as
1016 FS::inventory_item objects (see L<FS::inventory_item>.
1017
1018 =cut
1019
1020 sub inventory_item {
1021   my $self = shift;
1022   qsearch({
1023     'table'     => 'inventory_item',
1024     'hashref'   => { 'svcnum' => $self->svcnum, },
1025   });
1026 }
1027
1028 =item release_router
1029
1030 Delete any routers associated with this service.  This will release their
1031 address blocks, also.
1032
1033 =cut
1034
1035 sub release_router {
1036   my $self = shift;
1037   my @routers = qsearch('router', { svcnum => $self->svcnum });
1038   foreach (@routers) {
1039     my $error = $_->delete;
1040     return "$error (removing router '".$_->routername."')" if $error;
1041   }
1042   '';
1043 }
1044
1045
1046 =item cust_svc
1047
1048 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
1049 object (see L<FS::cust_svc>).
1050
1051 =cut
1052
1053 sub cust_svc {
1054   my $self = shift;
1055   qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
1056 }
1057
1058 =item suspend
1059
1060 Runs export_suspend callbacks.
1061
1062 =cut
1063
1064 sub suspend {
1065   my $self = shift;
1066   my %options = @_;
1067   my $export_args = $options{'export_args'} || [];
1068   $self->export('suspend', @$export_args);
1069 }
1070
1071 =item unsuspend
1072
1073 Runs export_unsuspend callbacks.
1074
1075 =cut
1076
1077 sub unsuspend {
1078   my $self = shift;
1079   my %options = @_;
1080   my $export_args = $options{'export_args'} || [];
1081   $self->export('unsuspend', @$export_args);
1082 }
1083
1084 =item export_links
1085
1086 Runs export_links callbacks and returns the links.
1087
1088 =cut
1089
1090 sub export_links {
1091   my $self = shift;
1092   my $return = [];
1093   $self->export('links', $return);
1094   $return;
1095 }
1096
1097 =item export_getsettings
1098
1099 Runs export_getsettings callbacks and returns the two hashrefs.
1100
1101 =cut
1102
1103 sub export_getsettings {
1104   my $self = shift;
1105   my %settings = ();
1106   my %defaults = ();
1107   my $error = $self->export('getsettings', \%settings, \%defaults);
1108   if ( $error ) {
1109     warn "error running export_getsetings: $error";
1110     return ( { 'error' => $error }, {} );
1111   }
1112   ( \%settings, \%defaults );
1113 }
1114
1115 =item export_getstatus
1116
1117 Runs export_getstatus callbacks and returns a two item list consisting of an
1118 HTML status and a status hashref.
1119
1120 =cut
1121
1122 sub export_getstatus {
1123   my $self = shift;
1124   my $html = '';
1125   my %hash = ();
1126   my $error = $self->export('getstatus', \$html, \%hash);
1127   if ( $error ) {
1128     warn "error running export_getstatus: $error";
1129     return ( '', { 'error' => $error } );
1130   }
1131   ( $html, \%hash );
1132 }
1133
1134 =item export_setstatus
1135
1136 Runs export_setstatus callbacks.  If there is an error, returns the error,
1137 otherwise returns false.
1138
1139 =cut
1140
1141 sub export_setstatus { shift->_export_setstatus_X('setstatus', @_) }
1142 sub export_setstatus_listadd { shift->_export_setstatus_X('setstatus_listadd', @_) }
1143 sub export_setstatus_listdel { shift->_export_setstatus_X('setstatus_listdel', @_) }
1144 sub export_setstatus_vacationadd { shift->_export_setstatus_X('setstatus_vacationadd', @_) }
1145 sub export_setstatus_vacationdel { shift->_export_setstatus_X('setstatus_vacationdel', @_) }
1146
1147 sub _export_setstatus_X {
1148   my( $self, $method, @args ) = @_;
1149   my $error = $self->export($method, @args);
1150   if ( $error ) {
1151     warn "error running export_$method: $error";
1152     return $error;
1153   }
1154   '';
1155 }
1156
1157 =item export HOOK [ EXPORT_ARGS ]
1158
1159 Runs the provided export hook (i.e. "suspend", "unsuspend") for this service.
1160
1161 =cut
1162
1163 sub export {
1164   my( $self, $method ) = ( shift, shift );
1165
1166   # $method must start with export_, $action must be the part after that
1167   $method = "export_$method" unless $method =~ /^export_/;
1168   my ($action) = $method =~ /^export_(\w+)/;
1169
1170   local $SIG{HUP} = 'IGNORE';
1171   local $SIG{INT} = 'IGNORE';
1172   local $SIG{QUIT} = 'IGNORE';
1173   local $SIG{TERM} = 'IGNORE';
1174   local $SIG{TSTP} = 'IGNORE';
1175   local $SIG{PIPE} = 'IGNORE';
1176
1177   my $oldAutoCommit = $FS::UID::AutoCommit;
1178   local $FS::UID::AutoCommit = 0;
1179   my $dbh = dbh;
1180
1181   #new-style exports!
1182   unless ( $noexport_hack ) {
1183     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
1184       next unless $part_export->can($method);
1185       next if $part_export->get("no_$action"); # currently only 'no_suspend'
1186       my $error = $part_export->$method($self, @_);
1187       if ( $error ) {
1188         $dbh->rollback if $oldAutoCommit;
1189         return "error exporting $method event to ". $part_export->exporttype.
1190                " (transaction rolled back): $error";
1191       }
1192     }
1193   }
1194
1195   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1196   '';
1197
1198 }
1199
1200 =item overlimit
1201
1202 Sets or retrieves overlimit date.
1203
1204 =cut
1205
1206 sub overlimit {
1207   my $self = shift;
1208   #$self->cust_svc->overlimit(@_);
1209   my $cust_svc = $self->cust_svc;
1210   unless ( $cust_svc ) { #wtf?
1211     my $error = "$me overlimit: missing cust_svc record for svc_acct svcnum ".
1212                 $self->svcnum;
1213     if ( $overlimit_missing_cust_svc_nonfatal_kludge ) {
1214       cluck "$error; continuing anyway as requested";
1215       return '';
1216     } else {
1217       confess $error;
1218     }
1219   }
1220   $cust_svc->overlimit(@_);
1221 }
1222
1223 =item cancel
1224
1225 Stub - returns false (no error) so derived classes don't need to define this
1226 methods.  Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
1227
1228 This method is called *before* the deletion step which actually deletes the
1229 services.  This method should therefore only be used for "pre-deletion"
1230 cancellation steps, if necessary.
1231
1232 =cut
1233
1234 sub cancel { ''; }
1235
1236 =item clone_suspended
1237
1238 Constructor used by FS::part_export::_export_suspend fallback.  Stub returning
1239 same object for svc_ classes which don't implement a suspension fallback
1240 (everything except svc_acct at the moment).  Document better.
1241
1242 =cut
1243
1244 sub clone_suspended {
1245   shift;
1246 }
1247
1248 =item clone_kludge_unsuspend
1249
1250 Constructor used by FS::part_export::_export_unsuspend fallback.  Stub returning
1251 same object for svc_ classes which don't implement a suspension fallback
1252 (everything except svc_acct at the moment).  Document better.
1253
1254 =cut
1255
1256 sub clone_kludge_unsuspend {
1257   shift;
1258 }
1259
1260 =item find_duplicates MODE FIELDS...
1261
1262 Method used by _check_duplicate routines to find services with duplicate
1263 values in specified fields.  Set MODE to 'global' to search across all
1264 services, or 'export' to limit to those that share one or more exports
1265 with this service.  FIELDS is a list of field names; only services
1266 matching in all fields will be returned.  Empty fields will be skipped.
1267
1268 =cut
1269
1270 sub find_duplicates {
1271   my $self = shift;
1272   my $mode = shift;
1273   my @fields = @_;
1274
1275   my %search = map { $_ => $self->getfield($_) }
1276                grep { length($self->getfield($_)) } @fields;
1277   return () if !%search;
1278   my @dup = grep { ! $self->svcnum or $_->svcnum != $self->svcnum }
1279             qsearch( $self->table, \%search );
1280   return () if !@dup;
1281   return @dup if $mode eq 'global';
1282   die "incorrect find_duplicates mode '$mode'" if $mode ne 'export';
1283
1284   my $exports = FS::part_export::export_info($self->table);
1285   my %conflict_svcparts;
1286   my $part_svc = $self->part_svc;
1287   foreach my $part_export ( $part_svc->part_export ) {
1288     %conflict_svcparts = map { $_->svcpart => 1 } $part_export->export_svc;
1289   }
1290   return grep { $conflict_svcparts{$_->cust_svc->svcpart} } @dup;
1291 }
1292
1293 =item getstatus_html
1294
1295 =cut
1296
1297 sub getstatus_html {
1298   my $self = shift;
1299
1300   my $part_svc = $self->cust_svc->part_svc;
1301
1302   my $html = '';
1303
1304   foreach my $export ( grep $_->can('export_getstatus'), $part_svc->part_export ) {
1305     my $export_html = '';
1306     my %hash = ();
1307     $export->export_getstatus( $self, \$export_html, \%hash );
1308     $html .= $export_html;
1309   }
1310
1311   $html;
1312
1313 }
1314
1315 =item nms_ip_insert
1316
1317 =cut
1318
1319 sub nms_ip_insert {
1320   my $self = shift;
1321   my $conf = new FS::Conf;
1322   return '' unless grep { $self->table eq $_ }
1323                      $conf->config('nms-auto_add-svc_ips');
1324   my $ip_field = $self->table_info->{'ip_field'};
1325
1326   my $queue = FS::queue->new( {
1327                 'job'    => 'FS::NetworkMonitoringSystem::queued_add_router',
1328                 'svcnum' => $self->svcnum,
1329   } );
1330   $queue->insert( 'FS::NetworkMonitoringSystem',
1331                   $self->$ip_field(),
1332                   $conf->config('nms-auto_add-community')
1333                 );
1334 }
1335
1336 =item nms_delip
1337
1338 =cut
1339
1340 sub nms_ip_delete {
1341 #XXX not yet implemented
1342 }
1343
1344 =item search_sql_field FIELD STRING
1345
1346 Class method which returns an SQL fragment to search for STRING in FIELD.
1347
1348 It is now case-insensitive by default.
1349
1350 =cut
1351
1352 sub search_sql_field {
1353   my( $class, $field, $string ) = @_;
1354   my $table = $class->table;
1355   my $q_string = dbh->quote($string);
1356   "LOWER($table.$field) = LOWER($q_string)";
1357 }
1358
1359 #fallback for services that don't provide a search...
1360 sub search_sql {
1361   #my( $class, $string ) = @_;
1362   '1 = 0'; #false
1363 }
1364 sub search_sql_addl_from {
1365   '';
1366 }
1367
1368 =item search HASHREF
1369
1370 Class method which returns a qsearch hash expression to search for parameters
1371 specified in HASHREF.
1372
1373 Parameters:
1374
1375 =over 4
1376
1377 =item unlinked - set to search for all unlinked services.  Overrides all other options.
1378
1379 =item agentnum
1380
1381 =item custnum
1382
1383 =item svcpart
1384
1385 =item ip_addr
1386
1387 =item pkgpart - arrayref
1388
1389 =item routernum - arrayref
1390
1391 =item sectornum - arrayref
1392
1393 =item towernum - arrayref
1394
1395 =item order_by
1396
1397 =item cancelled - if true, only returns svcs attached to cancelled pkgs;
1398 if defined and false, only returns svcs not attached to cancelled packages
1399
1400 =back
1401
1402 =cut
1403
1404 ### Don't call the 'cancelled' option 'Service Status'
1405 ### There is no such thing
1406 ### See cautionary note in httemplate/browse/part_svc.cgi
1407
1408 sub search {
1409   my ($class, $params) = @_;
1410
1411   my @from = (
1412     'LEFT JOIN cust_svc  USING ( svcnum  )',
1413     'LEFT JOIN part_svc  USING ( svcpart )',
1414     'LEFT JOIN cust_pkg  USING ( pkgnum  )',
1415     FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg'),
1416   );
1417
1418   my @where = ();
1419
1420   $class->_search_svc($params, \@from, \@where) if $class->can('_search_svc');
1421
1422 #  # domain
1423 #  if ( $params->{'domain'} ) {
1424 #    my $svc_domain = qsearchs('svc_domain', { 'domain'=>$params->{'domain'} } );
1425 #    #preserve previous behavior & bubble up an error if $svc_domain not found?
1426 #    push @where, 'domsvc = '. $svc_domain->svcnum if $svc_domain;
1427 #  }
1428 #
1429 #  # domsvc
1430 #  if ( $params->{'domsvc'} =~ /^(\d+)$/ ) {
1431 #    push @where, "domsvc = $1";
1432 #  }
1433
1434   #unlinked
1435   push @where, 'pkgnum IS NULL' if $params->{'unlinked'};
1436
1437   #agentnum
1438   if ( $params->{'agentnum'} =~ /^(\d+)$/ && $1 ) {
1439     push @where, "cust_main.agentnum = $1";
1440   }
1441
1442   #custnum
1443   if ( $params->{'custnum'} =~ /^(\d+)$/ && $1 ) {
1444     push @where, "cust_pkg.custnum = $1";
1445   }
1446
1447   #customer status
1448   if ( $params->{'cust_status'} =~ /^([a-z]+)$/ ) {
1449     push @where, FS::cust_main->cust_status_sql . " = '$1'";
1450   }
1451
1452   #customer balance
1453   if ( $params->{'balance'} =~ /^\s*(\-?\d*(\.\d{1,2})?)\s*$/ && length($1) ) {
1454     my $balance = $1;
1455
1456     my $age = '';
1457     if ( $params->{'balance_days'} =~ /^\s*(\d*(\.\d{1,3})?)\s*$/ && length($1) ) {
1458       $age = time - 86400 * $1;
1459     }
1460     push @where, FS::cust_main->balance_date_sql($age) . " > $balance";
1461   }
1462
1463   #payby
1464   if ( $params->{'payby'} && scalar(@{ $params->{'payby'} }) ) {
1465     my @payby = map "'$_'", grep /^(\w+)$/, @{ $params->{'payby'} };
1466     push @where, 'payby IN ('. join(',', @payby ). ')';
1467   }
1468
1469   #pkgpart
1470   ##pkgpart, now properly untainted, can be arrayref
1471   #for my $pkgpart ( $params->{'pkgpart'} ) {
1472   #  if ( ref $pkgpart ) {
1473   #    my $where = join(',', map { /^(\d+)$/ ? $1 : () } @$pkgpart );
1474   #    push @where, "cust_pkg.pkgpart IN ($where)" if $where;
1475   #  }
1476   #  elsif ( $pkgpart =~ /^(\d+)$/ ) {
1477   #    push @where, "cust_pkg.pkgpart = $1";
1478   #  }
1479   #}
1480   if ( $params->{'pkgpart'} ) {
1481     my @pkgpart = ref( $params->{'pkgpart'} )
1482                     ? @{ $params->{'pkgpart'} }
1483                     : $params->{'pkgpart'}
1484                       ? ( $params->{'pkgpart'} )
1485                       : ();
1486     @pkgpart = grep /^(\d+)$/, @pkgpart;
1487     push @where, 'cust_pkg.pkgpart IN ('. join(',', @pkgpart ). ')' if @pkgpart;
1488   }
1489
1490   #svcnum
1491   if ( $params->{'svcnum'} ) {
1492     my @svcnum = ref( $params->{'svcnum'} )
1493                  ? @{ $params->{'svcnum'} }
1494                  : $params->{'svcnum'};
1495     @svcnum = grep /^\d+$/, @svcnum;
1496     push @where, 'svcnum IN ('. join(',', @svcnum) . ')' if @svcnum;
1497   }
1498
1499   # svcpart
1500   if ( $params->{'svcpart'} ) {
1501     my @svcpart = ref( $params->{'svcpart'} )
1502                     ? @{ $params->{'svcpart'} }
1503                     : $params->{'svcpart'}
1504                       ? ( $params->{'svcpart'} )
1505                       : ();
1506     @svcpart = grep /^(\d+)$/, @svcpart;
1507     push @where, 'svcpart IN ('. join(',', @svcpart ). ')' if @svcpart;
1508   }
1509
1510   if ( $params->{'exportnum'} =~ /^(\d+)$/ ) {
1511     push @from, ' LEFT JOIN export_svc USING ( svcpart )';
1512     push @where, "exportnum = $1";
1513   }
1514
1515   if ( defined($params->{'cancelled'}) ) {
1516     if ($params->{'cancelled'}) {
1517       push @where, "cust_pkg.cancel IS NOT NULL";
1518     } else {
1519       push @where, "cust_pkg.cancel IS NULL";
1520     }
1521   }
1522
1523 #  # sector and tower
1524 #  my @where_sector = $class->tower_sector_sql($params);
1525 #  if ( @where_sector ) {
1526 #    push @where, @where_sector;
1527 #    push @from, ' LEFT JOIN tower_sector USING ( sectornum )';
1528 #  }
1529
1530   # here is the agent virtualization
1531   #if ($params->{CurrentUser}) {
1532   #  my $access_user =
1533   #    qsearchs('access_user', { username => $params->{CurrentUser} });
1534   #
1535   #  if ($access_user) {
1536   #    push @where, $access_user->agentnums_sql('table'=>'cust_main');
1537   #  }else{
1538   #    push @where, "1=0";
1539   #  }
1540   #} else {
1541     push @where, $FS::CurrentUser::CurrentUser->agentnums_sql(
1542                    'table'      => 'cust_main',
1543                    'null_right' => 'View/link unlinked services',
1544                  );
1545   #}
1546
1547   push @where, @{ $params->{'where'} } if $params->{'where'};
1548
1549   my $addl_from = join(' ', @from);
1550   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
1551
1552   my $table = $class->table;
1553
1554   my $count_query = "SELECT COUNT(*) FROM $table $addl_from $extra_sql";
1555   #if ( keys %svc_X ) {
1556   #  $count_query .= ' WHERE '.
1557   #                    join(' AND ', map "$_ = ". dbh->quote($svc_X{$_}),
1558   #                                      keys %svc_X
1559   #                        );
1560   #}
1561
1562   {
1563     'table'       => $table,
1564     'hashref'     => {},
1565     'select'      => join(', ',
1566                        "$table.*",
1567                        'part_svc.svc',
1568                        'cust_main.custnum',
1569                        @{ $params->{'addl_select'} || [] },
1570                        FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
1571                      ),
1572     'addl_from'   => $addl_from,
1573     'extra_sql'   => $extra_sql,
1574     'order_by'    => $params->{'order_by'},
1575     'count_query' => $count_query,
1576   };
1577
1578 }
1579
1580 =back
1581
1582 =head1 BUGS
1583
1584 The setfixed method return value.
1585
1586 B<export> method isn't used by insert and replace methods yet.
1587
1588 =head1 SEE ALSO
1589
1590 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
1591 from the base documentation.
1592
1593 =cut
1594
1595 1;
1596