FS/FS/svc_Common.pm

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