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(%options)
 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   # don't try to do this during an upgrade
 811   return '' if $FS::CurrentUser::upgrade_hack;
 812
 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, "cust_pkg.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