FS/FS/svc_Common.pm

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