FS/FS/svc_Common.pm

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