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