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