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