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