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   $noexport_hack = $new->no_export if $new->no_export;
 483
 484   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
 485               ? shift
 486               : $new->replace_old;
 487
 488   my $options =
 489     ( ref($_[0]) eq 'HASH' )
 490       ? shift
 491       : { @_ };
 492
 493   my $objects = $options->{'child_objects'} || [];
 494
 495   my @jobnums = ();
 496   local $FS::queue::jobnums = \@jobnums;
 497   warn "[$me] replace: set \$FS::queue::jobnums to $FS::queue::jobnums\n"
 498     if $DEBUG;
 499   my $depend_jobnums = $options->{'depend_jobnum'} || [];
 500   $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
 501
 502   local $SIG{HUP} = 'IGNORE';
 503   local $SIG{INT} = 'IGNORE';
 504   local $SIG{QUIT} = 'IGNORE';
 505   local $SIG{TERM} = 'IGNORE';
 506   local $SIG{TSTP} = 'IGNORE';
 507   local $SIG{PIPE} = 'IGNORE';
 508
 509   my $oldAutoCommit = $FS::UID::AutoCommit;
 510   local $FS::UID::AutoCommit = 0;
 511   my $dbh = dbh;
 512
 513   my $error =  $new->prereplace_hook_first($old)
 514             || $new->set_auto_inventory($old)
 515             || $new->check; #redundant, but so any duplicate fields are
 516                             #maniuplated as appropriate (svc_phone.phonenum)
 517   if ( $error ) {
 518     $dbh->rollback if $oldAutoCommit;
 519     return $error;
 520   }
 521
 522   #if ( $old->username ne $new->username || $old->domsvc != $new->domsvc ) {
 523   if ( grep { $old->$_ ne $new->$_ } $new->table_dupcheck_fields ) {
 524
 525     $new->svcpart( $new->cust_svc->svcpart ) unless $new->svcpart;
 526     $error = $new->_check_duplicate;
 527     if ( $error ) {
 528       $dbh->rollback if $oldAutoCommit;
 529       return $error;
 530     }
 531   }
 532
 533   $error = $new->SUPER::replace($old);
 534   if ($error) {
 535     $dbh->rollback if $oldAutoCommit;
 536     return $error;
 537   }
 538
 539   foreach my $object ( @$objects ) {
 540     my($field, $obj);
 541     if ( ref($object) eq 'ARRAY' ) {
 542       ($obj, $field) = @$object;
 543     } else {
 544       $obj = $object;
 545       $field = 'svcnum';
 546     }
 547     $obj->$field($new->svcnum);
 548
 549     my $oldobj = qsearchs( $obj->table, {
 550                              $field => $new->svcnum,
 551                              map { $_ => $obj->$_ } $obj->_svc_child_partfields,
 552                          });
 553
 554     if ( $oldobj ) {
 555       my $pkey = $oldobj->primary_key;
 556       $obj->$pkey($oldobj->$pkey);
 557       $obj->replace($oldobj);
 558     } else {
 559       $error = $obj->insert;
 560     }
 561     if ( $error ) {
 562       $dbh->rollback if $oldAutoCommit;
 563       return $error;
 564     }
 565   }
 566
 567   #new-style exports!
 568   unless ( $noexport_hack ) {
 569
 570     warn "[$me] replace: \$FS::queue::jobnums is $FS::queue::jobnums\n"
 571       if $DEBUG;
 572
 573     my $export_args = $options->{'export_args'} || [];
 574
 575     #not quite false laziness, but same pattern as FS::svc_acct::replace and
 576     #FS::part_export::sqlradius::_export_replace.  List::Compare or something
 577     #would be useful but too much of a pain in the ass to deploy
 578
 579     my @old_part_export = $old->cust_svc->part_svc->part_export;
 580     my %old_exportnum = map { $_->exportnum => 1 } @old_part_export;
 581     my @new_part_export =
 582       $new->svcpart
 583         ? qsearchs('part_svc', { svcpart=>$new->svcpart } )->part_export
 584         : $new->cust_svc->part_svc->part_export;
 585     my %new_exportnum = map { $_->exportnum => 1 } @new_part_export;
 586
 587     foreach my $delete_part_export (
 588       grep { ! $new_exportnum{$_->exportnum} } @old_part_export
 589     ) {
 590       my $error = $delete_part_export->export_delete($old, @$export_args);
 591       if ( $error ) {
 592         $dbh->rollback if $oldAutoCommit;
 593         return "error deleting, export to ". $delete_part_export->exporttype.
 594                " (transaction rolled back): $error";
 595       }
 596     }
 597
 598     foreach my $replace_part_export (
 599       grep { $old_exportnum{$_->exportnum} } @new_part_export
 600     ) {
 601       my $error =
 602         $replace_part_export->export_replace( $new, $old, @$export_args);
 603       if ( $error ) {
 604         $dbh->rollback if $oldAutoCommit;
 605         return "error exporting to ". $replace_part_export->exporttype.
 606                " (transaction rolled back): $error";
 607       }
 608     }
 609
 610     foreach my $insert_part_export (
 611       grep { ! $old_exportnum{$_->exportnum} } @new_part_export
 612     ) {
 613       my $error = $insert_part_export->export_insert($new, @$export_args );
 614       if ( $error ) {
 615         $dbh->rollback if $oldAutoCommit;
 616         return "error inserting export to ". $insert_part_export->exporttype.
 617                " (transaction rolled back): $error";
 618       }
 619     }
 620
 621     foreach my $depend_jobnum ( @$depend_jobnums ) {
 622       warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
 623         if $DEBUG;
 624       foreach my $jobnum ( @jobnums ) {
 625         my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
 626         warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
 627           if $DEBUG;
 628         my $error = $queue->depend_insert($depend_jobnum);
 629         if ( $error ) {
 630           $dbh->rollback if $oldAutoCommit;
 631           return "error queuing job dependancy: $error";
 632         }
 633       }
 634     }
 635
 636   }
 637
 638   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 639   '';
 640 }
 641
 642 =item setfixed
 643
 644 Sets any fixed fields for this service (see L<FS::part_svc>).  If there is an
 645 error, returns the error, otherwise returns the FS::part_svc object (use ref()
 646 to test the return).  Usually called by the check method.
 647
 648 =cut
 649
 650 sub setfixed {
 651   my $self = shift;
 652   $self->setx('F', @_);
 653 }
 654
 655 =item setdefault
 656
 657 Sets all fields to their defaults (see L<FS::part_svc>), overriding their
 658 current values.  If there is an error, returns the error, otherwise returns
 659 the FS::part_svc object (use ref() to test the return).
 660
 661 =cut
 662
 663 sub setdefault {
 664   my $self = shift;
 665   $self->setx('D', @_ );
 666 }
 667
 668 =item set_default_and_fixed
 669
 670 =cut
 671
 672 sub set_default_and_fixed {
 673   my $self = shift;
 674   $self->setx( [ 'D', 'F' ], @_ );
 675 }
 676
 677 =item setx FLAG | FLAG_ARRAYREF , [ CALLBACK_HASHREF ]
 678
 679 Sets fields according to the passed in flag or arrayref of flags.
 680
 681 Optionally, a hashref of field names and callback coderefs can be passed.
 682 If a coderef exists for a given field name, instead of setting the field,
 683 the coderef is called with the column value (part_svc_column.columnvalue)
 684 as the single parameter.
 685
 686 =cut
 687
 688 sub setx {
 689   my $self = shift;
 690   my $x = shift;
 691   my @x = ref($x) ? @$x : ($x);
 692   my $coderef = scalar(@_) ? shift : $self->_fieldhandlers;
 693
 694   my $error =
 695     $self->ut_numbern('svcnum')
 696   ;
 697   return $error if $error;
 698
 699   my $part_svc = $self->part_svc;
 700   return "Unknown svcpart" unless $part_svc;
 701
 702   #set default/fixed/whatever fields from part_svc
 703
 704   foreach my $part_svc_column (
 705     grep { my $f = $_->columnflag; grep { $f eq $_ } @x } #columnflag in @x
 706     $part_svc->all_part_svc_column
 707   ) {
 708
 709     my $columnname  = $part_svc_column->columnname;
 710     my $columnvalue = $part_svc_column->columnvalue;
 711
 712     $columnvalue = &{ $coderef->{$columnname} }( $self, $columnvalue )
 713       if exists( $coderef->{$columnname} );
 714     $self->setfield( $columnname, $columnvalue );
 715
 716   }
 717
 718  $part_svc;
 719
 720 }
 721
 722 sub part_svc {
 723   my $self = shift;
 724
 725   #get part_svc
 726   my $svcpart;
 727   if ( $self->get('svcpart') ) {
 728     $svcpart = $self->get('svcpart');
 729   } elsif ( $self->svcnum && qsearchs('cust_svc', {'svcnum'=>$self->svcnum}) ) {
 730     my $cust_svc = $self->cust_svc;
 731     return "Unknown svcnum" unless $cust_svc;
 732     $svcpart = $cust_svc->svcpart;
 733   }
 734
 735   qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
 736
 737 }
 738
 739 =item svc_pbx
 740
 741 Returns the FS::svc_pbx record for this service, if any (see L<FS::svc_pbx>).
 742
 743 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
 744 svc_acct).
 745
 746 =cut
 747
 748 # XXX FS::h_svc_{acct,phone} could have a history-aware svc_pbx override
 749
 750 sub svc_pbx {
 751   my $self = shift;
 752   return '' unless $self->pbxsvc;
 753   qsearchs( 'svc_pbx', { 'svcnum' => $self->pbxsvc } );
 754 }
 755
 756 =item pbx_title
 757
 758 Returns the title of the FS::svc_pbx record associated with this service, if
 759 any.
 760
 761 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
 762 svc_acct).
 763
 764 =cut
 765
 766 sub pbx_title {
 767   my $self = shift;
 768   my $svc_pbx = $self->svc_pbx or return '';
 769   $svc_pbx->title;
 770 }
 771
 772 =item pbx_select_hash %OPTIONS
 773
 774 Can be called as an object method or a class method.
 775
 776 Returns a hash SVCNUM => TITLE ...  representing the PBXes this customer
 777 that may be associated with this service.
 778
 779 Currently available options are: I<pkgnum> I<svcpart>
 780
 781 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
 782 svc_acct).
 783
 784 =cut
 785
 786 #false laziness w/svc_acct::domain_select_hash
 787 sub pbx_select_hash {
 788   my ($self, %options) = @_;
 789   my %pbxes = ();
 790   my $part_svc;
 791   my $cust_pkg;
 792
 793   if (ref($self)) {
 794     $part_svc = $self->part_svc;
 795     $cust_pkg = $self->cust_svc->cust_pkg
 796       if $self->cust_svc;
 797   }
 798
 799   $part_svc = qsearchs('part_svc', { 'svcpart' => $options{svcpart} })
 800     if $options{'svcpart'};
 801
 802   $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $options{pkgnum} })
 803     if $options{'pkgnum'};
 804
 805   if ($part_svc && ( $part_svc->part_svc_column('pbxsvc')->columnflag eq 'S'
 806                   || $part_svc->part_svc_column('pbxsvc')->columnflag eq 'F')) {
 807     %pbxes = map { $_->svcnum => $_->title }
 808              map { qsearchs('svc_pbx', { 'svcnum' => $_ }) }
 809              split(',', $part_svc->part_svc_column('pbxsvc')->columnvalue);
 810   } elsif ($cust_pkg) { # && !$conf->exists('svc_acct-alldomains') ) {
 811     %pbxes = map { $_->svcnum => $_->title }
 812              map { qsearchs('svc_pbx', { 'svcnum' => $_->svcnum }) }
 813              map { qsearch('cust_svc', { 'pkgnum' => $_->pkgnum } ) }
 814              qsearch('cust_pkg', { 'custnum' => $cust_pkg->custnum });
 815   } else {
 816     #XXX agent-virt
 817     %pbxes = map { $_->svcnum => $_->title } qsearch('svc_pbx', {} );
 818   }
 819
 820   if ($part_svc && $part_svc->part_svc_column('pbxsvc')->columnflag eq 'D') {
 821     my $svc_pbx = qsearchs('svc_pbx',
 822       { 'svcnum' => $part_svc->part_svc_column('pbxsvc')->columnvalue } );
 823     if ( $svc_pbx ) {
 824       $pbxes{$svc_pbx->svcnum}  = $svc_pbx->title;
 825     } else {
 826       warn "unknown svc_pbx.svcnum for part_svc_column pbxsvc: ".
 827            $part_svc->part_svc_column('pbxsvc')->columnvalue;
 828
 829     }
 830   }
 831
 832   (%pbxes);
 833
 834 }
 835
 836 =item set_auto_inventory
 837
 838 Sets any fields which auto-populate from inventory (see L<FS::part_svc>), and
 839 also check any manually populated inventory fields.
 840
 841 If there is an error, returns the error, otherwise returns false.
 842
 843 =cut
 844
 845 sub set_auto_inventory {
 846   # don't try to do this during an upgrade
 847   return '' if $FS::CurrentUser::upgrade_hack;
 848
 849   my $self = shift;
 850   my $old = @_ ? shift : '';
 851
 852   my $error =
 853     $self->ut_numbern('svcnum')
 854   ;
 855   return $error if $error;
 856
 857   my $part_svc = $self->part_svc;
 858   return "Unkonwn svcpart" unless $part_svc;
 859
 860   local $SIG{HUP} = 'IGNORE';
 861   local $SIG{INT} = 'IGNORE';
 862   local $SIG{QUIT} = 'IGNORE';
 863   local $SIG{TERM} = 'IGNORE';
 864   local $SIG{TSTP} = 'IGNORE';
 865   local $SIG{PIPE} = 'IGNORE';
 866
 867   my $oldAutoCommit = $FS::UID::AutoCommit;
 868   local $FS::UID::AutoCommit = 0;
 869   my $dbh = dbh;
 870
 871   #set default/fixed/whatever fields from part_svc
 872   my $table = $self->table;
 873   foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
 874
 875     my $part_svc_column = $part_svc->part_svc_column($field);
 876     my $columnflag = $part_svc_column->columnflag;
 877     next unless $columnflag =~ /^[AM]$/;
 878
 879     next if $columnflag eq 'A' && $self->$field() ne '';
 880
 881     my $classnum = $part_svc_column->columnvalue;
 882     my %hash;
 883
 884     if ( $columnflag eq 'A' && $self->$field() eq '' ) {
 885       $hash{'svcnum'} = '';
 886     } elsif ( $columnflag eq 'M' ) {
 887       return "Select inventory item for $field" unless $self->getfield($field);
 888       $hash{'item'} = $self->getfield($field);
 889       my $chosen_classnum = $self->getfield($field.'_classnum');
 890       if ( grep {$_ == $chosen_classnum} split(',', $classnum) ) {
 891         $classnum = $chosen_classnum;
 892       }
 893       # otherwise the chosen classnum is either (all), or somehow not on
 894       # the list, so ignore it and choose the first item that's in any
 895       # class on the list
 896     }
 897
 898     my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql(
 899       'null'  => 1,
 900       'table' => 'inventory_item',
 901     );
 902
 903     my $inventory_item = qsearchs({
 904       'table'     => 'inventory_item',
 905       'hashref'   => \%hash,
 906       'extra_sql' => "AND classnum IN ($classnum) AND $agentnums_sql",
 907       'order_by'  => 'ORDER BY ( agentnum IS NULL ) '. #agent inventory first
 908                      ' LIMIT 1 FOR UPDATE',
 909     });
 910
 911     unless ( $inventory_item ) {
 912       # should really only be shown if columnflag eq 'A'...
 913       $dbh->rollback if $oldAutoCommit;
 914       my $message = 'Out of ';
 915       my @classnums = split(',', $classnum);
 916       foreach ( @classnums ) {
 917         my $class = FS::inventory_class->by_key($_)
 918           or return "Can't find inventory_class.classnum $_";
 919         $message .= PL_N($class->classname);
 920         if ( scalar(@classnums) > 2 ) { # english is hard
 921           if ( $_ != $classnums[-1] ) {
 922             $message .= ', ';
 923           }
 924         }
 925         if ( scalar(@classnums) > 1 and $_ == $classnums[-2] ) {
 926           $message .= 'and ';
 927         }
 928       }
 929       return $message;
 930     }
 931
 932     next if $columnflag eq 'M' && $inventory_item->svcnum == $self->svcnum;
 933
 934     $self->setfield( $field, $inventory_item->item );
 935       #if $columnflag eq 'A' && $self->$field() eq '';
 936
 937     # release the old inventory item, if there was one
 938     if ( $old && $old->$field() && $old->$field() ne $self->$field() ) {
 939       my $old_inv = qsearchs({
 940         'table'     => 'inventory_item',
 941         'hashref'   => {
 942                          'svcnum'   => $old->svcnum,
 943                        },
 944         'extra_sql' => "AND classnum IN ($classnum) AND ".
 945           '( ( svc_field IS NOT NULL AND svc_field = '.$dbh->quote($field).' )'.
 946           '  OR ( svc_field IS NULL AND item = '. dbh->quote($old->$field).' )'.
 947           ')',
 948       });
 949       if ( $old_inv ) {
 950         $old_inv->svcnum('');
 951         $old_inv->svc_field('');
 952         my $oerror = $old_inv->replace;
 953         if ( $oerror ) {
 954           $dbh->rollback if $oldAutoCommit;
 955           return "Error unprovisioning inventory: $oerror";
 956         }
 957       } else {
 958         warn "old inventory_item not found for $field ". $self->$field;
 959       }
 960     }
 961
 962     $inventory_item->svcnum( $self->svcnum );
 963     $inventory_item->svc_field( $field );
 964     my $ierror = $inventory_item->replace();
 965     if ( $ierror ) {
 966       $dbh->rollback if $oldAutoCommit;
 967       return "Error provisioning inventory: $ierror";
 968     }
 969
 970   }
 971
 972  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 973
 974  '';
 975
 976 }
 977
 978 =item return_inventory
 979
 980 Release all inventory items attached to this service's fields.  Call
 981 when unprovisioning the service.
 982
 983 =cut
 984
 985 sub return_inventory {
 986   my $self = shift;
 987
 988   local $SIG{HUP} = 'IGNORE';
 989   local $SIG{INT} = 'IGNORE';
 990   local $SIG{QUIT} = 'IGNORE';
 991   local $SIG{TERM} = 'IGNORE';
 992   local $SIG{TSTP} = 'IGNORE';
 993   local $SIG{PIPE} = 'IGNORE';
 994
 995   my $oldAutoCommit = $FS::UID::AutoCommit;
 996   local $FS::UID::AutoCommit = 0;
 997   my $dbh = dbh;
 998
 999   foreach my $inventory_item ( $self->inventory_item ) {
1000     $inventory_item->svcnum('');
1001     $inventory_item->svc_field('');
1002     my $error = $inventory_item->replace();
1003     if ( $error ) {
1004       $dbh->rollback if $oldAutoCommit;
1005       return "Error returning inventory: $error";
1006     }
1007   }
1008
1009   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1010
1011   '';
1012 }
1013
1014 =item inventory_item
1015
1016 Returns the inventory items associated with this svc_ record, as
1017 FS::inventory_item objects (see L<FS::inventory_item>.
1018
1019 =cut
1020
1021 sub inventory_item {
1022   my $self = shift;
1023   qsearch({
1024     'table'     => 'inventory_item',
1025     'hashref'   => { 'svcnum' => $self->svcnum, },
1026   });
1027 }
1028
1029 =item release_router
1030
1031 Delete any routers associated with this service.  This will release their
1032 address blocks, also.
1033
1034 =cut
1035
1036 sub release_router {
1037   my $self = shift;
1038   my @routers = qsearch('router', { svcnum => $self->svcnum });
1039   foreach (@routers) {
1040     my $error = $_->delete;
1041     return "$error (removing router '".$_->routername."')" if $error;
1042   }
1043   '';
1044 }
1045
1046
1047 =item cust_svc
1048
1049 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
1050 object (see L<FS::cust_svc>).
1051
1052 =cut
1053
1054 sub cust_svc {
1055   my $self = shift;
1056   qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
1057 }
1058
1059 =item suspend
1060
1061 Runs export_suspend callbacks.
1062
1063 =cut
1064
1065 sub suspend {
1066   my $self = shift;
1067   my %options = @_;
1068   my $export_args = $options{'export_args'} || [];
1069   $self->export('suspend', @$export_args);
1070 }
1071
1072 =item unsuspend
1073
1074 Runs export_unsuspend callbacks.
1075
1076 =cut
1077
1078 sub unsuspend {
1079   my $self = shift;
1080   my %options = @_;
1081   my $export_args = $options{'export_args'} || [];
1082   $self->export('unsuspend', @$export_args);
1083 }
1084
1085 =item export_links
1086
1087 Runs export_links callbacks and returns the links.
1088
1089 =cut
1090
1091 sub export_links {
1092   my $self = shift;
1093   my $return = [];
1094   $self->export('links', $return);
1095   $return;
1096 }
1097
1098 =item export_getsettings
1099
1100 Runs export_getsettings callbacks and returns the two hashrefs.
1101
1102 =cut
1103
1104 sub export_getsettings {
1105   my $self = shift;
1106   my %settings = ();
1107   my %defaults = ();
1108   my $error = $self->export('getsettings', \%settings, \%defaults);
1109   if ( $error ) {
1110     warn "error running export_getsetings: $error";
1111     return ( { 'error' => $error }, {} );
1112   }
1113   ( \%settings, \%defaults );
1114 }
1115
1116 =item export_getstatus
1117
1118 Runs export_getstatus callbacks and returns a two item list consisting of an
1119 HTML status and a status hashref.
1120
1121 =cut
1122
1123 sub export_getstatus {
1124   my $self = shift;
1125   my $html = '';
1126   my %hash = ();
1127   my $error = $self->export('getstatus', \$html, \%hash);
1128   if ( $error ) {
1129     warn "error running export_getstatus: $error";
1130     return ( '', { 'error' => $error } );
1131   }
1132   ( $html, \%hash );
1133 }
1134
1135 =item export_setstatus
1136
1137 Runs export_setstatus callbacks.  If there is an error, returns the error,
1138 otherwise returns false.
1139
1140 =cut
1141
1142 sub export_setstatus { shift->_export_setstatus_X('setstatus', @_) }
1143 sub export_setstatus_listadd { shift->_export_setstatus_X('setstatus_listadd', @_) }
1144 sub export_setstatus_listdel { shift->_export_setstatus_X('setstatus_listdel', @_) }
1145 sub export_setstatus_vacationadd { shift->_export_setstatus_X('setstatus_vacationadd', @_) }
1146 sub export_setstatus_vacationdel { shift->_export_setstatus_X('setstatus_vacationdel', @_) }
1147
1148 sub _export_setstatus_X {
1149   my( $self, $method, @args ) = @_;
1150   my $error = $self->export($method, @args);
1151   if ( $error ) {
1152     warn "error running export_$method: $error";
1153     return $error;
1154   }
1155   '';
1156 }
1157
1158 =item export HOOK [ EXPORT_ARGS ]
1159
1160 Runs the provided export hook (i.e. "suspend", "unsuspend") for this service.
1161
1162 =cut
1163
1164 sub export {
1165   my( $self, $method ) = ( shift, shift );
1166
1167   # $method must start with export_, $action must be the part after that
1168   $method = "export_$method" unless $method =~ /^export_/;
1169   my ($action) = $method =~ /^export_(\w+)/;
1170
1171   local $SIG{HUP} = 'IGNORE';
1172   local $SIG{INT} = 'IGNORE';
1173   local $SIG{QUIT} = 'IGNORE';
1174   local $SIG{TERM} = 'IGNORE';
1175   local $SIG{TSTP} = 'IGNORE';
1176   local $SIG{PIPE} = 'IGNORE';
1177
1178   my $oldAutoCommit = $FS::UID::AutoCommit;
1179   local $FS::UID::AutoCommit = 0;
1180   my $dbh = dbh;
1181
1182   #new-style exports!
1183   unless ( $noexport_hack ) {
1184     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
1185       next unless $part_export->can($method);
1186       next if $part_export->get("no_$action"); # currently only 'no_suspend'
1187       my $error = $part_export->$method($self, @_);
1188       if ( $error ) {
1189         $dbh->rollback if $oldAutoCommit;
1190         return "error exporting $method event to ". $part_export->exporttype.
1191                " (transaction rolled back): $error";
1192       }
1193     }
1194   }
1195
1196   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1197   '';
1198
1199 }
1200
1201 =item overlimit
1202
1203 Sets or retrieves overlimit date.
1204
1205 =cut
1206
1207 sub overlimit {
1208   my $self = shift;
1209   #$self->cust_svc->overlimit(@_);
1210   my $cust_svc = $self->cust_svc;
1211   unless ( $cust_svc ) { #wtf?
1212     my $error = "$me overlimit: missing cust_svc record for svc_acct svcnum ".
1213                 $self->svcnum;
1214     if ( $overlimit_missing_cust_svc_nonfatal_kludge ) {
1215       cluck "$error; continuing anyway as requested";
1216       return '';
1217     } else {
1218       confess $error;
1219     }
1220   }
1221   $cust_svc->overlimit(@_);
1222 }
1223
1224 =item cancel
1225
1226 Stub - returns false (no error) so derived classes don't need to define this
1227 methods.  Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
1228
1229 This method is called *before* the deletion step which actually deletes the
1230 services.  This method should therefore only be used for "pre-deletion"
1231 cancellation steps, if necessary.
1232
1233 =cut
1234
1235 sub cancel { ''; }
1236
1237 =item clone_suspended
1238
1239 Constructor used by FS::part_export::_export_suspend fallback.  Stub returning
1240 same object for svc_ classes which don't implement a suspension fallback
1241 (everything except svc_acct at the moment).  Document better.
1242
1243 =cut
1244
1245 sub clone_suspended {
1246   shift;
1247 }
1248
1249 =item clone_kludge_unsuspend
1250
1251 Constructor used by FS::part_export::_export_unsuspend fallback.  Stub returning
1252 same object for svc_ classes which don't implement a suspension fallback
1253 (everything except svc_acct at the moment).  Document better.
1254
1255 =cut
1256
1257 sub clone_kludge_unsuspend {
1258   shift;
1259 }
1260
1261 =item find_duplicates MODE FIELDS...
1262
1263 Method used by _check_duplicate routines to find services with duplicate
1264 values in specified fields.  Set MODE to 'global' to search across all
1265 services, or 'export' to limit to those that share one or more exports
1266 with this service.  FIELDS is a list of field names; only services
1267 matching in all fields will be returned.  Empty fields will be skipped.
1268
1269 =cut
1270
1271 sub find_duplicates {
1272   my $self = shift;
1273   my $mode = shift;
1274   my @fields = @_;
1275
1276   my %search = map { $_ => $self->getfield($_) }
1277                grep { length($self->getfield($_)) } @fields;
1278   return () if !%search;
1279   my @dup = grep { ! $self->svcnum or $_->svcnum != $self->svcnum }
1280             qsearch( $self->table, \%search );
1281   return () if !@dup;
1282   return @dup if $mode eq 'global';
1283   die "incorrect find_duplicates mode '$mode'" if $mode ne 'export';
1284
1285   my $exports = FS::part_export::export_info($self->table);
1286   my %conflict_svcparts;
1287   my $part_svc = $self->part_svc;
1288   foreach my $part_export ( $part_svc->part_export ) {
1289     %conflict_svcparts = map { $_->svcpart => 1 } $part_export->export_svc;
1290   }
1291   return grep { $conflict_svcparts{$_->cust_svc->svcpart} } @dup;
1292 }
1293
1294 =item getstatus_html
1295
1296 =cut
1297
1298 sub getstatus_html {
1299   my $self = shift;
1300
1301   my $part_svc = $self->cust_svc->part_svc;
1302
1303   my $html = '';
1304
1305   foreach my $export ( grep $_->can('export_getstatus'), $part_svc->part_export ) {
1306     my $export_html = '';
1307     my %hash = ();
1308     $export->export_getstatus( $self, \$export_html, \%hash );
1309     $html .= $export_html;
1310   }
1311
1312   $html;
1313
1314 }
1315
1316 =item nms_ip_insert
1317
1318 =cut
1319
1320 sub nms_ip_insert {
1321   my $self = shift;
1322   my $conf = new FS::Conf;
1323   return '' unless grep { $self->table eq $_ }
1324                      $conf->config('nms-auto_add-svc_ips');
1325   my $ip_field = $self->table_info->{'ip_field'};
1326
1327   my $queue = FS::queue->new( {
1328                 'job'    => 'FS::NetworkMonitoringSystem::queued_add_router',
1329                 'svcnum' => $self->svcnum,
1330   } );
1331   $queue->insert( 'FS::NetworkMonitoringSystem',
1332                   $self->$ip_field(),
1333                   $conf->config('nms-auto_add-community')
1334                 );
1335 }
1336
1337 =item nms_delip
1338
1339 =cut
1340
1341 sub nms_ip_delete {
1342 #XXX not yet implemented
1343 }
1344
1345 =item search_sql_field FIELD STRING
1346
1347 Class method which returns an SQL fragment to search for STRING in FIELD.
1348
1349 It is now case-insensitive by default.
1350
1351 =cut
1352
1353 sub search_sql_field {
1354   my( $class, $field, $string ) = @_;
1355   my $table = $class->table;
1356   my $q_string = dbh->quote($string);
1357   "LOWER($table.$field) = LOWER($q_string)";
1358 }
1359
1360 #fallback for services that don't provide a search...
1361 sub search_sql {
1362   #my( $class, $string ) = @_;
1363   '1 = 0'; #false
1364 }
1365 sub search_sql_addl_from {
1366   '';
1367 }
1368
1369 =item search HASHREF
1370
1371 Class method which returns a qsearch hash expression to search for parameters
1372 specified in HASHREF.
1373
1374 Parameters:
1375
1376 =over 4
1377
1378 =item unlinked - set to search for all unlinked services.  Overrides all other options.
1379
1380 =item agentnum
1381
1382 =item custnum
1383
1384 =item svcpart
1385
1386 =item ip_addr
1387
1388 =item pkgpart - arrayref
1389
1390 =item routernum - arrayref
1391
1392 =item sectornum - arrayref
1393
1394 =item towernum - arrayref
1395
1396 =item order_by
1397
1398 =item cancelled - if true, only returns svcs attached to cancelled pkgs;
1399 if defined and false, only returns svcs not attached to cancelled packages
1400
1401 =back
1402
1403 =cut
1404
1405 ### Don't call the 'cancelled' option 'Service Status'
1406 ### There is no such thing
1407 ### See cautionary note in httemplate/browse/part_svc.cgi
1408
1409 sub search {
1410   my ($class, $params) = @_;
1411
1412   my @from = (
1413     'LEFT JOIN cust_svc  USING ( svcnum  )',
1414     'LEFT JOIN part_svc  USING ( svcpart )',
1415     'LEFT JOIN cust_pkg  USING ( pkgnum  )',
1416     FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg'),
1417   );
1418
1419   my @where = ();
1420
1421   $class->_search_svc($params, \@from, \@where) if $class->can('_search_svc');
1422
1423 #  # domain
1424 #  if ( $params->{'domain'} ) {
1425 #    my $svc_domain = qsearchs('svc_domain', { 'domain'=>$params->{'domain'} } );
1426 #    #preserve previous behavior & bubble up an error if $svc_domain not found?
1427 #    push @where, 'domsvc = '. $svc_domain->svcnum if $svc_domain;
1428 #  }
1429 #
1430 #  # domsvc
1431 #  if ( $params->{'domsvc'} =~ /^(\d+)$/ ) {
1432 #    push @where, "domsvc = $1";
1433 #  }
1434
1435   #unlinked
1436   push @where, 'pkgnum IS NULL' if $params->{'unlinked'};
1437
1438   #agentnum
1439   if ( $params->{'agentnum'} =~ /^(\d+)$/ && $1 ) {
1440     push @where, "cust_main.agentnum = $1";
1441   }
1442
1443   #custnum
1444   if ( $params->{'custnum'} =~ /^(\d+)$/ && $1 ) {
1445     push @where, "cust_pkg.custnum = $1";
1446   }
1447
1448   #customer status
1449   if ( $params->{'cust_status'} =~ /^([a-z]+)$/ ) {
1450     push @where, FS::cust_main->cust_status_sql . " = '$1'";
1451   }
1452
1453   #customer balance
1454   if ( $params->{'balance'} =~ /^\s*(\-?\d*(\.\d{1,2})?)\s*$/ && length($1) ) {
1455     my $balance = $1;
1456
1457     my $age = '';
1458     if ( $params->{'balance_days'} =~ /^\s*(\d*(\.\d{1,3})?)\s*$/ && length($1) ) {
1459       $age = time - 86400 * $1;
1460     }
1461     push @where, FS::cust_main->balance_date_sql($age) . " > $balance";
1462   }
1463
1464   #payby
1465   if ( $params->{'payby'} && scalar(@{ $params->{'payby'} }) ) {
1466     my @payby = map "'$_'", grep /^(\w+)$/, @{ $params->{'payby'} };
1467     push @where, 'payby IN ('. join(',', @payby ). ')';
1468   }
1469
1470   #pkgpart
1471   ##pkgpart, now properly untainted, can be arrayref
1472   #for my $pkgpart ( $params->{'pkgpart'} ) {
1473   #  if ( ref $pkgpart ) {
1474   #    my $where = join(',', map { /^(\d+)$/ ? $1 : () } @$pkgpart );
1475   #    push @where, "cust_pkg.pkgpart IN ($where)" if $where;
1476   #  }
1477   #  elsif ( $pkgpart =~ /^(\d+)$/ ) {
1478   #    push @where, "cust_pkg.pkgpart = $1";
1479   #  }
1480   #}
1481   if ( $params->{'pkgpart'} ) {
1482     my @pkgpart = ref( $params->{'pkgpart'} )
1483                     ? @{ $params->{'pkgpart'} }
1484                     : $params->{'pkgpart'}
1485                       ? ( $params->{'pkgpart'} )
1486                       : ();
1487     @pkgpart = grep /^(\d+)$/, @pkgpart;
1488     push @where, 'cust_pkg.pkgpart IN ('. join(',', @pkgpart ). ')' if @pkgpart;
1489   }
1490
1491   #svcnum
1492   if ( $params->{'svcnum'} ) {
1493     my @svcnum = ref( $params->{'svcnum'} )
1494                  ? @{ $params->{'svcnum'} }
1495                  : $params->{'svcnum'};
1496     @svcnum = grep /^\d+$/, @svcnum;
1497     push @where, 'svcnum IN ('. join(',', @svcnum) . ')' if @svcnum;
1498   }
1499
1500   # svcpart
1501   if ( $params->{'svcpart'} ) {
1502     my @svcpart = ref( $params->{'svcpart'} )
1503                     ? @{ $params->{'svcpart'} }
1504                     : $params->{'svcpart'}
1505                       ? ( $params->{'svcpart'} )
1506                       : ();
1507     @svcpart = grep /^(\d+)$/, @svcpart;
1508     push @where, 'svcpart IN ('. join(',', @svcpart ). ')' if @svcpart;
1509   }
1510
1511   if ( $params->{'exportnum'} =~ /^(\d+)$/ ) {
1512     push @from, ' LEFT JOIN export_svc USING ( svcpart )';
1513     push @where, "exportnum = $1";
1514   }
1515
1516   if ( defined($params->{'cancelled'}) ) {
1517     if ($params->{'cancelled'}) {
1518       push @where, "cust_pkg.cancel IS NOT NULL";
1519     } else {
1520       push @where, "cust_pkg.cancel IS NULL";
1521     }
1522   }
1523
1524 #  # sector and tower
1525 #  my @where_sector = $class->tower_sector_sql($params);
1526 #  if ( @where_sector ) {
1527 #    push @where, @where_sector;
1528 #    push @from, ' LEFT JOIN tower_sector USING ( sectornum )';
1529 #  }
1530
1531   # here is the agent virtualization
1532   #if ($params->{CurrentUser}) {
1533   #  my $access_user =
1534   #    qsearchs('access_user', { username => $params->{CurrentUser} });
1535   #
1536   #  if ($access_user) {
1537   #    push @where, $access_user->agentnums_sql('table'=>'cust_main');
1538   #  }else{
1539   #    push @where, "1=0";
1540   #  }
1541   #} else {
1542     push @where, $FS::CurrentUser::CurrentUser->agentnums_sql(
1543                    'table'      => 'cust_main',
1544                    'null_right' => 'View/link unlinked services',
1545                  );
1546   #}
1547
1548   push @where, @{ $params->{'where'} } if $params->{'where'};
1549
1550   my $addl_from = join(' ', @from);
1551   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
1552
1553   my $table = $class->table;
1554
1555   my $count_query = "SELECT COUNT(*) FROM $table $addl_from $extra_sql";
1556   #if ( keys %svc_X ) {
1557   #  $count_query .= ' WHERE '.
1558   #                    join(' AND ', map "$_ = ". dbh->quote($svc_X{$_}),
1559   #                                      keys %svc_X
1560   #                        );
1561   #}
1562
1563   {
1564     'table'       => $table,
1565     'hashref'     => {},
1566     'select'      => join(', ',
1567                        "$table.*",
1568                        'part_svc.svc',
1569                        'cust_main.custnum',
1570                        @{ $params->{'addl_select'} || [] },
1571                        FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
1572                      ),
1573     'addl_from'   => $addl_from,
1574     'extra_sql'   => $extra_sql,
1575     'order_by'    => $params->{'order_by'},
1576     'count_query' => $count_query,
1577   };
1578
1579 }
1580
1581 =back
1582
1583 =head1 BUGS
1584
1585 The setfixed method return value.
1586
1587 B<export> method isn't used by insert and replace methods yet.
1588
1589 =head1 SEE ALSO
1590
1591 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
1592 from the base documentation.
1593
1594 =cut
1595
1596 1;
1597