FS/FS/svc_Common.pm

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