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