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