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