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