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   # don't try to do this during an upgrade
 808   return '' if $FS::CurrentUser::upgrade_hack;
 809
 810   my $self = shift;
 811   my $old = @_ ? shift : '';
 812
 813   my $error =
 814     $self->ut_numbern('svcnum')
 815   ;
 816   return $error if $error;
 817
 818   my $part_svc = $self->part_svc;
 819   return "Unkonwn svcpart" unless $part_svc;
 820
 821   local $SIG{HUP} = 'IGNORE';
 822   local $SIG{INT} = 'IGNORE';
 823   local $SIG{QUIT} = 'IGNORE';
 824   local $SIG{TERM} = 'IGNORE';
 825   local $SIG{TSTP} = 'IGNORE';
 826   local $SIG{PIPE} = 'IGNORE';
 827
 828   my $oldAutoCommit = $FS::UID::AutoCommit;
 829   local $FS::UID::AutoCommit = 0;
 830   my $dbh = dbh;
 831
 832   #set default/fixed/whatever fields from part_svc
 833   my $table = $self->table;
 834   foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
 835
 836     my $part_svc_column = $part_svc->part_svc_column($field);
 837     my $columnflag = $part_svc_column->columnflag;
 838     next unless $columnflag =~ /^[AM]$/;
 839
 840     next if $columnflag eq 'A' && $self->$field() ne '';
 841
 842     my $classnum = $part_svc_column->columnvalue;
 843     my %hash;
 844
 845     if ( $columnflag eq 'A' && $self->$field() eq '' ) {
 846       $hash{'svcnum'} = '';
 847     } elsif ( $columnflag eq 'M' ) {
 848       return "Select inventory item for $field" unless $self->getfield($field);
 849       $hash{'item'} = $self->getfield($field);
 850       my $chosen_classnum = $self->getfield($field.'_classnum');
 851       if ( grep {$_ == $chosen_classnum} split(',', $classnum) ) {
 852         $classnum = $chosen_classnum;
 853       }
 854       # otherwise the chosen classnum is either (all), or somehow not on
 855       # the list, so ignore it and choose the first item that's in any
 856       # class on the list
 857     }
 858
 859     my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql(
 860       'null'  => 1,
 861       'table' => 'inventory_item',
 862     );
 863
 864     my $inventory_item = qsearchs({
 865       'table'     => 'inventory_item',
 866       'hashref'   => \%hash,
 867       'extra_sql' => "AND classnum IN ($classnum) AND $agentnums_sql",
 868       'order_by'  => 'ORDER BY ( agentnum IS NULL ) '. #agent inventory first
 869                      ' LIMIT 1 FOR UPDATE',
 870     });
 871
 872     unless ( $inventory_item ) {
 873       # should really only be shown if columnflag eq 'A'...
 874       $dbh->rollback if $oldAutoCommit;
 875       my $message = 'Out of ';
 876       my @classnums = split(',', $classnum);
 877       foreach ( @classnums ) {
 878         my $class = FS::inventory_class->by_key($_)
 879           or return "Can't find inventory_class.classnum $_";
 880         $message .= PL_N($class->classname);
 881         if ( scalar(@classnums) > 2 ) { # english is hard
 882           if ( $_ != $classnums[-1] ) {
 883             $message .= ', ';
 884           }
 885         }
 886         if ( scalar(@classnums) > 1 and $_ == $classnums[-2] ) {
 887           $message .= 'and ';
 888         }
 889       }
 890       return $message;
 891     }
 892
 893     next if $columnflag eq 'M' && $inventory_item->svcnum == $self->svcnum;
 894
 895     $self->setfield( $field, $inventory_item->item );
 896       #if $columnflag eq 'A' && $self->$field() eq '';
 897
 898     # release the old inventory item, if there was one
 899     if ( $old && $old->$field() && $old->$field() ne $self->$field() ) {
 900       my $old_inv = qsearchs({
 901         'table'     => 'inventory_item',
 902         'hashref'   => {
 903                          'svcnum'   => $old->svcnum,
 904                        },
 905         'extra_sql' => "AND classnum IN ($classnum) AND ".
 906           '( ( svc_field IS NOT NULL AND svc_field = '.$dbh->quote($field).' )'.
 907           '  OR ( svc_field IS NULL AND item = '. dbh->quote($old->$field).' )'.
 908           ')',
 909       });
 910       if ( $old_inv ) {
 911         $old_inv->svcnum('');
 912         $old_inv->svc_field('');
 913         my $oerror = $old_inv->replace;
 914         if ( $oerror ) {
 915           $dbh->rollback if $oldAutoCommit;
 916           return "Error unprovisioning inventory: $oerror";
 917         }
 918       } else {
 919         warn "old inventory_item not found for $field ". $self->$field;
 920       }
 921     }
 922
 923     $inventory_item->svcnum( $self->svcnum );
 924     $inventory_item->svc_field( $field );
 925     my $ierror = $inventory_item->replace();
 926     if ( $ierror ) {
 927       $dbh->rollback if $oldAutoCommit;
 928       return "Error provisioning inventory: $ierror";
 929     }
 930
 931   }
 932
 933  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 934
 935  '';
 936
 937 }
 938
 939 =item return_inventory
 940
 941 Release all inventory items attached to this service's fields.  Call
 942 when unprovisioning the service.
 943
 944 =cut
 945
 946 sub return_inventory {
 947   my $self = shift;
 948
 949   local $SIG{HUP} = 'IGNORE';
 950   local $SIG{INT} = 'IGNORE';
 951   local $SIG{QUIT} = 'IGNORE';
 952   local $SIG{TERM} = 'IGNORE';
 953   local $SIG{TSTP} = 'IGNORE';
 954   local $SIG{PIPE} = 'IGNORE';
 955
 956   my $oldAutoCommit = $FS::UID::AutoCommit;
 957   local $FS::UID::AutoCommit = 0;
 958   my $dbh = dbh;
 959
 960   foreach my $inventory_item ( $self->inventory_item ) {
 961     $inventory_item->svcnum('');
 962     $inventory_item->svc_field('');
 963     my $error = $inventory_item->replace();
 964     if ( $error ) {
 965       $dbh->rollback if $oldAutoCommit;
 966       return "Error returning inventory: $error";
 967     }
 968   }
 969
 970   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 971
 972   '';
 973 }
 974
 975 =item inventory_item
 976
 977 Returns the inventory items associated with this svc_ record, as
 978 FS::inventory_item objects (see L<FS::inventory_item>.
 979
 980 =cut
 981
 982 sub inventory_item {
 983   my $self = shift;
 984   qsearch({
 985     'table'     => 'inventory_item',
 986     'hashref'   => { 'svcnum' => $self->svcnum, },
 987   });
 988 }
 989
 990 =item release_router
 991
 992 Delete any routers associated with this service.  This will release their
 993 address blocks, also.
 994
 995 =cut
 996
 997 sub release_router {
 998   my $self = shift;
 999   my @routers = qsearch('router', { svcnum => $self->svcnum });
1000   foreach (@routers) {
1001     my $error = $_->delete;
1002     return "$error (removing router '".$_->routername."')" if $error;
1003   }
1004   '';
1005 }
1006
1007
1008 =item cust_svc
1009
1010 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
1011 object (see L<FS::cust_svc>).
1012
1013 =item suspend
1014
1015 Runs export_suspend callbacks.
1016
1017 =cut
1018
1019 sub suspend {
1020   my $self = shift;
1021   my %options = @_;
1022   my $export_args = $options{'export_args'} || [];
1023   $self->export('suspend', @$export_args);
1024 }
1025
1026 =item unsuspend
1027
1028 Runs export_unsuspend callbacks.
1029
1030 =cut
1031
1032 sub unsuspend {
1033   my $self = shift;
1034   my %options = @_;
1035   my $export_args = $options{'export_args'} || [];
1036   $self->export('unsuspend', @$export_args);
1037 }
1038
1039 =item export_links
1040
1041 Runs export_links callbacks and returns the links.
1042
1043 =cut
1044
1045 sub export_links {
1046   my $self = shift;
1047   my $return = [];
1048   $self->export('links', $return);
1049   $return;
1050 }
1051
1052 =item export_getsettings
1053
1054 Runs export_getsettings callbacks and returns the two hashrefs.
1055
1056 =cut
1057
1058 sub export_getsettings {
1059   my $self = shift;
1060   my %settings = ();
1061   my %defaults = ();
1062   my $error = $self->export('getsettings', \%settings, \%defaults);
1063   if ( $error ) {
1064     warn "error running export_getsetings: $error";
1065     return ( { 'error' => $error }, {} );
1066   }
1067   ( \%settings, \%defaults );
1068 }
1069
1070 =item export_getstatus
1071
1072 Runs export_getstatus callbacks and returns a two item list consisting of an
1073 HTML status and a status hashref.
1074
1075 =cut
1076
1077 sub export_getstatus {
1078   my $self = shift;
1079   my $html = '';
1080   my %hash = ();
1081   my $error = $self->export('getstatus', \$html, \%hash);
1082   if ( $error ) {
1083     warn "error running export_getstatus: $error";
1084     return ( '', { 'error' => $error } );
1085   }
1086   ( $html, \%hash );
1087 }
1088
1089 =item export_setstatus
1090
1091 Runs export_setstatus callbacks.  If there is an error, returns the error,
1092 otherwise returns false.
1093
1094 =cut
1095
1096 sub export_setstatus { shift->_export_setstatus_X('setstatus', @_) }
1097 sub export_setstatus_listadd { shift->_export_setstatus_X('setstatus_listadd', @_) }
1098 sub export_setstatus_listdel { shift->_export_setstatus_X('setstatus_listdel', @_) }
1099 sub export_setstatus_vacationadd { shift->_export_setstatus_X('setstatus_vacationadd', @_) }
1100 sub export_setstatus_vacationdel { shift->_export_setstatus_X('setstatus_vacationdel', @_) }
1101
1102 sub _export_setstatus_X {
1103   my( $self, $method, @args ) = @_;
1104   my $error = $self->export($method, @args);
1105   if ( $error ) {
1106     warn "error running export_$method: $error";
1107     return $error;
1108   }
1109   '';
1110 }
1111
1112 =item export HOOK [ EXPORT_ARGS ]
1113
1114 Runs the provided export hook (i.e. "suspend", "unsuspend") for this service.
1115
1116 =cut
1117
1118 sub export {
1119   my( $self, $method ) = ( shift, shift );
1120
1121   $method = "export_$method" unless $method =~ /^export_/;
1122
1123   local $SIG{HUP} = 'IGNORE';
1124   local $SIG{INT} = 'IGNORE';
1125   local $SIG{QUIT} = 'IGNORE';
1126   local $SIG{TERM} = 'IGNORE';
1127   local $SIG{TSTP} = 'IGNORE';
1128   local $SIG{PIPE} = 'IGNORE';
1129
1130   my $oldAutoCommit = $FS::UID::AutoCommit;
1131   local $FS::UID::AutoCommit = 0;
1132   my $dbh = dbh;
1133
1134   #new-style exports!
1135   unless ( $noexport_hack ) {
1136     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
1137       next unless $part_export->can($method);
1138       my $error = $part_export->$method($self, @_);
1139       if ( $error ) {
1140         $dbh->rollback if $oldAutoCommit;
1141         return "error exporting $method event to ". $part_export->exporttype.
1142                " (transaction rolled back): $error";
1143       }
1144     }
1145   }
1146
1147   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1148   '';
1149
1150 }
1151
1152 =item overlimit
1153
1154 Sets or retrieves overlimit date.
1155
1156 =cut
1157
1158 sub overlimit {
1159   my $self = shift;
1160   #$self->cust_svc->overlimit(@_);
1161   my $cust_svc = $self->cust_svc;
1162   unless ( $cust_svc ) { #wtf?
1163     my $error = "$me overlimit: missing cust_svc record for svc_acct svcnum ".
1164                 $self->svcnum;
1165     if ( $overlimit_missing_cust_svc_nonfatal_kludge ) {
1166       cluck "$error; continuing anyway as requested";
1167       return '';
1168     } else {
1169       confess $error;
1170     }
1171   }
1172   $cust_svc->overlimit(@_);
1173 }
1174
1175 =item cancel
1176
1177 Stub - returns false (no error) so derived classes don't need to define this
1178 methods.  Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
1179
1180 This method is called *before* the deletion step which actually deletes the
1181 services.  This method should therefore only be used for "pre-deletion"
1182 cancellation steps, if necessary.
1183
1184 =cut
1185
1186 sub cancel { ''; }
1187
1188 =item clone_suspended
1189
1190 Constructor used by FS::part_export::_export_suspend fallback.  Stub returning
1191 same object for svc_ classes which don't implement a suspension fallback
1192 (everything except svc_acct at the moment).  Document better.
1193
1194 =cut
1195
1196 sub clone_suspended {
1197   shift;
1198 }
1199
1200 =item clone_kludge_unsuspend
1201
1202 Constructor used by FS::part_export::_export_unsuspend fallback.  Stub returning
1203 same object for svc_ classes which don't implement a suspension fallback
1204 (everything except svc_acct at the moment).  Document better.
1205
1206 =cut
1207
1208 sub clone_kludge_unsuspend {
1209   shift;
1210 }
1211
1212 =item find_duplicates MODE FIELDS...
1213
1214 Method used by _check_duplicate routines to find services with duplicate
1215 values in specified fields.  Set MODE to 'global' to search across all
1216 services, or 'export' to limit to those that share one or more exports
1217 with this service.  FIELDS is a list of field names; only services
1218 matching in all fields will be returned.  Empty fields will be skipped.
1219
1220 =cut
1221
1222 sub find_duplicates {
1223   my $self = shift;
1224   my $mode = shift;
1225   my @fields = @_;
1226
1227   my %search = map { $_ => $self->getfield($_) }
1228                grep { length($self->getfield($_)) } @fields;
1229   return () if !%search;
1230   my @dup = grep { ! $self->svcnum or $_->svcnum != $self->svcnum }
1231             qsearch( $self->table, \%search );
1232   return () if !@dup;
1233   return @dup if $mode eq 'global';
1234   die "incorrect find_duplicates mode '$mode'" if $mode ne 'export';
1235
1236   my $exports = FS::part_export::export_info($self->table);
1237   my %conflict_svcparts;
1238   my $part_svc = $self->part_svc;
1239   foreach my $part_export ( $part_svc->part_export ) {
1240     %conflict_svcparts = map { $_->svcpart => 1 } $part_export->export_svc;
1241   }
1242   return grep { $conflict_svcparts{$_->cust_svc->svcpart} } @dup;
1243 }
1244
1245 =item getstatus_html
1246
1247 =cut
1248
1249 sub getstatus_html {
1250   my $self = shift;
1251
1252   my $part_svc = $self->cust_svc->part_svc;
1253
1254   my $html = '';
1255
1256   foreach my $export ( grep $_->can('export_getstatus'), $part_svc->part_export ) {
1257     my $export_html = '';
1258     my %hash = ();
1259     $export->export_getstatus( $self, \$export_html, \%hash );
1260     $html .= $export_html;
1261   }
1262
1263   $html;
1264
1265 }
1266
1267 =item nms_ip_insert
1268
1269 =cut
1270
1271 sub nms_ip_insert {
1272   my $self = shift;
1273   my $conf = new FS::Conf;
1274   return '' unless grep { $self->table eq $_ }
1275                      $conf->config('nms-auto_add-svc_ips');
1276   my $ip_field = $self->table_info->{'ip_field'};
1277
1278   my $queue = FS::queue->new( {
1279                 'job'    => 'FS::NetworkMonitoringSystem::queued_add_router',
1280                 'svcnum' => $self->svcnum,
1281   } );
1282   $queue->insert( 'FS::NetworkMonitoringSystem',
1283                   $self->$ip_field(),
1284                   $conf->config('nms-auto_add-community')
1285                 );
1286 }
1287
1288 =item nms_delip
1289
1290 =cut
1291
1292 sub nms_ip_delete {
1293 #XXX not yet implemented
1294 }
1295
1296 =item search_sql_field FIELD STRING
1297
1298 Class method which returns an SQL fragment to search for STRING in FIELD.
1299
1300 It is now case-insensitive by default.
1301
1302 =cut
1303
1304 sub search_sql_field {
1305   my( $class, $field, $string ) = @_;
1306   my $table = $class->table;
1307   my $q_string = dbh->quote($string);
1308   "LOWER($table.$field) = LOWER($q_string)";
1309 }
1310
1311 #fallback for services that don't provide a search...
1312 sub search_sql {
1313   #my( $class, $string ) = @_;
1314   '1 = 0'; #false
1315 }
1316
1317 =item search HASHREF
1318
1319 Class method which returns a qsearch hash expression to search for parameters
1320 specified in HASHREF.
1321
1322 Parameters:
1323
1324 =over 4
1325
1326 =item unlinked - set to search for all unlinked services.  Overrides all other options.
1327
1328 =item agentnum
1329
1330 =item custnum
1331
1332 =item svcpart
1333
1334 =item ip_addr
1335
1336 =item pkgpart - arrayref
1337
1338 =item routernum - arrayref
1339
1340 =item sectornum - arrayref
1341
1342 =item towernum - arrayref
1343
1344 =item order_by
1345
1346 =back
1347
1348 =cut
1349
1350 # svc_broadband::search should eventually use this instead
1351 sub search {
1352   my ($class, $params) = @_;
1353
1354   my @from = (
1355     'LEFT JOIN cust_svc  USING ( svcnum  )',
1356     'LEFT JOIN part_svc  USING ( svcpart )',
1357     'LEFT JOIN cust_pkg  USING ( pkgnum  )',
1358     FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg'),
1359   );
1360
1361   my @where = ();
1362
1363   $class->_search_svc($params, \@from, \@where) if $class->can('_search_svc');
1364
1365 #  # domain
1366 #  if ( $params->{'domain'} ) {
1367 #    my $svc_domain = qsearchs('svc_domain', { 'domain'=>$params->{'domain'} } );
1368 #    #preserve previous behavior & bubble up an error if $svc_domain not found?
1369 #    push @where, 'domsvc = '. $svc_domain->svcnum if $svc_domain;
1370 #  }
1371 #
1372 #  # domsvc
1373 #  if ( $params->{'domsvc'} =~ /^(\d+)$/ ) {
1374 #    push @where, "domsvc = $1";
1375 #  }
1376
1377   #unlinked
1378   push @where, 'pkgnum IS NULL' if $params->{'unlinked'};
1379
1380   #agentnum
1381   if ( $params->{'agentnum'} =~ /^(\d+)$/ && $1 ) {
1382     push @where, "cust_main.agentnum = $1";
1383   }
1384
1385   #custnum
1386   if ( $params->{'custnum'} =~ /^(\d+)$/ && $1 ) {
1387     push @where, "cust_pkg.custnum = $1";
1388   }
1389
1390   #customer status
1391   if ( $params->{'cust_status'} =~ /^([a-z]+)$/ ) {
1392     push @where, FS::cust_main->cust_status_sql . " = '$1'";
1393   }
1394
1395   #customer balance
1396   if ( $params->{'balance'} =~ /^\s*(\-?\d*(\.\d{1,2})?)\s*$/ && length($1) ) {
1397     my $balance = $1;
1398
1399     my $age = '';
1400     if ( $params->{'balance_days'} =~ /^\s*(\d*(\.\d{1,3})?)\s*$/ && length($1) ) {
1401       $age = time - 86400 * $1;
1402     }
1403     push @where, FS::cust_main->balance_date_sql($age) . " > $balance";
1404   }
1405
1406   #payby
1407   if ( $params->{'payby'} && scalar(@{ $params->{'payby'} }) ) {
1408     my @payby = map "'$_'", grep /^(\w+)$/, @{ $params->{'payby'} };
1409     push @where, 'payby IN ('. join(',', @payby ). ')';
1410   }
1411
1412   #pkgpart
1413   ##pkgpart, now properly untainted, can be arrayref
1414   #for my $pkgpart ( $params->{'pkgpart'} ) {
1415   #  if ( ref $pkgpart ) {
1416   #    my $where = join(',', map { /^(\d+)$/ ? $1 : () } @$pkgpart );
1417   #    push @where, "cust_pkg.pkgpart IN ($where)" if $where;
1418   #  }
1419   #  elsif ( $pkgpart =~ /^(\d+)$/ ) {
1420   #    push @where, "cust_pkg.pkgpart = $1";
1421   #  }
1422   #}
1423   if ( $params->{'pkgpart'} ) {
1424     my @pkgpart = ref( $params->{'pkgpart'} )
1425                     ? @{ $params->{'pkgpart'} }
1426                     : $params->{'pkgpart'}
1427                       ? ( $params->{'pkgpart'} )
1428                       : ();
1429     @pkgpart = grep /^(\d+)$/, @pkgpart;
1430     push @where, 'cust_pkg.pkgpart IN ('. join(',', @pkgpart ). ')' if @pkgpart;
1431   }
1432
1433   #svcnum
1434   if ( $params->{'svcnum'} =~ /^(\d+)$/ ) {
1435     push @where, "svcnum = $1";
1436   }
1437
1438   # svcpart
1439   if ( $params->{'svcpart'} ) {
1440     my @svcpart = ref( $params->{'svcpart'} )
1441                     ? @{ $params->{'svcpart'} }
1442                     : $params->{'svcpart'}
1443                       ? ( $params->{'svcpart'} )
1444                       : ();
1445     @svcpart = grep /^(\d+)$/, @svcpart;
1446     push @where, 'svcpart IN ('. join(',', @svcpart ). ')' if @svcpart;
1447   }
1448
1449   if ( $params->{'exportnum'} =~ /^(\d+)$/ ) {
1450     push @from, ' LEFT JOIN export_svc USING ( svcpart )';
1451     push @where, "exportnum = $1";
1452   }
1453
1454 #  # sector and tower
1455 #  my @where_sector = $class->tower_sector_sql($params);
1456 #  if ( @where_sector ) {
1457 #    push @where, @where_sector;
1458 #    push @from, ' LEFT JOIN tower_sector USING ( sectornum )';
1459 #  }
1460
1461   # here is the agent virtualization
1462   #if ($params->{CurrentUser}) {
1463   #  my $access_user =
1464   #    qsearchs('access_user', { username => $params->{CurrentUser} });
1465   #
1466   #  if ($access_user) {
1467   #    push @where, $access_user->agentnums_sql('table'=>'cust_main');
1468   #  }else{
1469   #    push @where, "1=0";
1470   #  }
1471   #} else {
1472     push @where, $FS::CurrentUser::CurrentUser->agentnums_sql(
1473                    'table'      => 'cust_main',
1474                    'null_right' => 'View/link unlinked services',
1475                  );
1476   #}
1477
1478   push @where, @{ $params->{'where'} } if $params->{'where'};
1479
1480   my $addl_from = join(' ', @from);
1481   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
1482
1483   my $table = $class->table;
1484
1485   my $count_query = "SELECT COUNT(*) FROM $table $addl_from $extra_sql";
1486   #if ( keys %svc_X ) {
1487   #  $count_query .= ' WHERE '.
1488   #                    join(' AND ', map "$_ = ". dbh->quote($svc_X{$_}),
1489   #                                      keys %svc_X
1490   #                        );
1491   #}
1492
1493   {
1494     'table'       => $table,
1495     'hashref'     => {},
1496     'select'      => join(', ',
1497                        "$table.*",
1498                        'part_svc.svc',
1499                        'cust_main.custnum',
1500                        @{ $params->{'addl_select'} || [] },
1501                        FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
1502                      ),
1503     'addl_from'   => $addl_from,
1504     'extra_sql'   => $extra_sql,
1505     'order_by'    => $params->{'order_by'},
1506     'count_query' => $count_query,
1507   };
1508
1509 }
1510
1511 =back
1512
1513 =head1 BUGS
1514
1515 The setfixed method return value.
1516
1517 B<export> method isn't used by insert and replace methods yet.
1518
1519 =head1 SEE ALSO
1520
1521 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
1522 from the base documentation.
1523
1524 =cut
1525
1526 1;
1527