FS/FS/svc_Common.pm

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