fix interaction of percentage discount and quantity, #19354, etc.
[freeside.git] / 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   #get part_svc
723   my $svcpart;
724   if ( $self->get('svcpart') ) {
725     $svcpart = $self->get('svcpart');
726   } elsif ( $self->svcnum && qsearchs('cust_svc', {'svcnum'=>$self->svcnum}) ) {
727     my $cust_svc = $self->cust_svc;
728     return "Unknown svcnum" unless $cust_svc; 
729     $svcpart = $cust_svc->svcpart;
730   }
731
732   qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
733
734 }
735
736 =item svc_pbx
737
738 Returns the FS::svc_pbx record for this service, if any (see L<FS::svc_pbx>).
739
740 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
741 svc_acct).
742
743 =cut
744
745 # XXX FS::h_svc_{acct,phone} could have a history-aware svc_pbx override
746
747 sub svc_pbx {
748   my $self = shift;
749   return '' unless $self->pbxsvc;
750   qsearchs( 'svc_pbx', { 'svcnum' => $self->pbxsvc } );
751 }
752
753 =item pbx_title
754
755 Returns the title of the FS::svc_pbx record associated with this service, if
756 any.
757
758 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
759 svc_acct).
760
761 =cut
762
763 sub pbx_title {
764   my $self = shift;
765   my $svc_pbx = $self->svc_pbx or return '';
766   $svc_pbx->title;
767 }
768
769 =item pbx_select_hash %OPTIONS
770
771 Can be called as an object method or a class method.
772
773 Returns a hash SVCNUM => TITLE ...  representing the PBXes this customer
774 that may be associated with this service.
775
776 Currently available options are: I<pkgnum> I<svcpart>
777
778 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
779 svc_acct).
780
781 =cut
782
783 #false laziness w/svc_acct::domain_select_hash
784 sub pbx_select_hash {
785   my ($self, %options) = @_;
786   my %pbxes = ();
787   my $part_svc;
788   my $cust_pkg;
789
790   if (ref($self)) {
791     $part_svc = $self->part_svc;
792     $cust_pkg = $self->cust_svc->cust_pkg
793       if $self->cust_svc;
794   }
795
796   $part_svc = qsearchs('part_svc', { 'svcpart' => $options{svcpart} })
797     if $options{'svcpart'};
798
799   $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $options{pkgnum} })
800     if $options{'pkgnum'};
801
802   if ($part_svc && ( $part_svc->part_svc_column('pbxsvc')->columnflag eq 'S'
803                   || $part_svc->part_svc_column('pbxsvc')->columnflag eq 'F')) {
804     %pbxes = map { $_->svcnum => $_->title }
805              map { qsearchs('svc_pbx', { 'svcnum' => $_ }) }
806              split(',', $part_svc->part_svc_column('pbxsvc')->columnvalue);
807   } elsif ($cust_pkg) { # && !$conf->exists('svc_acct-alldomains') ) {
808     %pbxes = map { $_->svcnum => $_->title }
809              map { qsearchs('svc_pbx', { 'svcnum' => $_->svcnum }) }
810              map { qsearch('cust_svc', { 'pkgnum' => $_->pkgnum } ) }
811              qsearch('cust_pkg', { 'custnum' => $cust_pkg->custnum });
812   } else {
813     #XXX agent-virt
814     %pbxes = map { $_->svcnum => $_->title } qsearch('svc_pbx', {} );
815   }
816
817   if ($part_svc && $part_svc->part_svc_column('pbxsvc')->columnflag eq 'D') {
818     my $svc_pbx = qsearchs('svc_pbx',
819       { 'svcnum' => $part_svc->part_svc_column('pbxsvc')->columnvalue } );
820     if ( $svc_pbx ) {
821       $pbxes{$svc_pbx->svcnum}  = $svc_pbx->title;
822     } else {
823       warn "unknown svc_pbx.svcnum for part_svc_column pbxsvc: ".
824            $part_svc->part_svc_column('pbxsvc')->columnvalue;
825
826     }
827   }
828
829   (%pbxes);
830
831 }
832
833 =item set_auto_inventory
834
835 Sets any fields which auto-populate from inventory (see L<FS::part_svc>), and
836 also check any manually populated inventory fields.
837
838 If there is an error, returns the error, otherwise returns false.
839
840 =cut
841
842 sub set_auto_inventory {
843   # don't try to do this during an upgrade
844   return '' if $FS::CurrentUser::upgrade_hack;
845
846   my $self = shift;
847   my $old = @_ ? shift : '';
848
849   my $error =
850     $self->ut_numbern('svcnum')
851   ;
852   return $error if $error;
853
854   my $part_svc = $self->part_svc;
855   return "Unkonwn svcpart" unless $part_svc;
856
857   local $SIG{HUP} = 'IGNORE';
858   local $SIG{INT} = 'IGNORE';
859   local $SIG{QUIT} = 'IGNORE';
860   local $SIG{TERM} = 'IGNORE';
861   local $SIG{TSTP} = 'IGNORE';
862   local $SIG{PIPE} = 'IGNORE';
863
864   my $oldAutoCommit = $FS::UID::AutoCommit;
865   local $FS::UID::AutoCommit = 0;
866   my $dbh = dbh;
867
868   #set default/fixed/whatever fields from part_svc
869   my $table = $self->table;
870   foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
871
872     my $part_svc_column = $part_svc->part_svc_column($field);
873     my $columnflag = $part_svc_column->columnflag;
874     next unless $columnflag =~ /^[AM]$/;
875
876     next if $columnflag eq 'A' && $self->$field() ne '';
877
878     my $classnum = $part_svc_column->columnvalue;
879     my %hash;
880
881     if ( $columnflag eq 'A' && $self->$field() eq '' ) {
882       $hash{'svcnum'} = '';
883     } elsif ( $columnflag eq 'M' ) {
884       return "Select inventory item for $field" unless $self->getfield($field);
885       $hash{'item'} = $self->getfield($field);
886       my $chosen_classnum = $self->getfield($field.'_classnum');
887       if ( grep {$_ == $chosen_classnum} split(',', $classnum) ) {
888         $classnum = $chosen_classnum;
889       }
890       # otherwise the chosen classnum is either (all), or somehow not on 
891       # the list, so ignore it and choose the first item that's in any
892       # class on the list
893     }
894
895     my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql(
896       'null'  => 1,
897       'table' => 'inventory_item',
898     );
899
900     my $inventory_item = qsearchs({
901       'table'     => 'inventory_item',
902       'hashref'   => \%hash,
903       'extra_sql' => "AND classnum IN ($classnum) AND $agentnums_sql",
904       'order_by'  => 'ORDER BY ( agentnum IS NULL ) '. #agent inventory first
905                      ' LIMIT 1 FOR UPDATE',
906     });
907
908     unless ( $inventory_item ) {
909       # should really only be shown if columnflag eq 'A'...
910       $dbh->rollback if $oldAutoCommit;
911       my $message = 'Out of ';
912       my @classnums = split(',', $classnum);
913       foreach ( @classnums ) {
914         my $class = FS::inventory_class->by_key($_)
915           or return "Can't find inventory_class.classnum $_";
916         $message .= PL_N($class->classname);
917         if ( scalar(@classnums) > 2 ) { # english is hard
918           if ( $_ != $classnums[-1] ) {
919             $message .= ', ';
920           }
921         }
922         if ( scalar(@classnums) > 1 and $_ == $classnums[-2] ) {
923           $message .= 'and ';
924         }
925       }
926       return $message;
927     }
928
929     next if $columnflag eq 'M' && $inventory_item->svcnum == $self->svcnum;
930
931     $self->setfield( $field, $inventory_item->item );
932       #if $columnflag eq 'A' && $self->$field() eq '';
933
934     # release the old inventory item, if there was one
935     if ( $old && $old->$field() && $old->$field() ne $self->$field() ) {
936       my $old_inv = qsearchs({
937         'table'     => 'inventory_item',
938         'hashref'   => { 
939                          'svcnum'   => $old->svcnum,
940                        },
941         'extra_sql' => "AND classnum IN ($classnum) AND ".
942           '( ( svc_field IS NOT NULL AND svc_field = '.$dbh->quote($field).' )'.
943           '  OR ( svc_field IS NULL AND item = '. dbh->quote($old->$field).' )'.
944           ')',
945       });
946       if ( $old_inv ) {
947         $old_inv->svcnum('');
948         $old_inv->svc_field('');
949         my $oerror = $old_inv->replace;
950         if ( $oerror ) {
951           $dbh->rollback if $oldAutoCommit;
952           return "Error unprovisioning inventory: $oerror";
953         }
954       } else {
955         warn "old inventory_item not found for $field ". $self->$field;
956       }
957     }
958
959     $inventory_item->svcnum( $self->svcnum );
960     $inventory_item->svc_field( $field );
961     my $ierror = $inventory_item->replace();
962     if ( $ierror ) {
963       $dbh->rollback if $oldAutoCommit;
964       return "Error provisioning inventory: $ierror";
965     }
966
967   }
968
969  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
970
971  '';
972
973 }
974
975 =item return_inventory
976
977 Release all inventory items attached to this service's fields.  Call
978 when unprovisioning the service.
979
980 =cut
981
982 sub return_inventory {
983   my $self = shift;
984
985   local $SIG{HUP} = 'IGNORE';
986   local $SIG{INT} = 'IGNORE';
987   local $SIG{QUIT} = 'IGNORE';
988   local $SIG{TERM} = 'IGNORE';
989   local $SIG{TSTP} = 'IGNORE';
990   local $SIG{PIPE} = 'IGNORE';
991
992   my $oldAutoCommit = $FS::UID::AutoCommit;
993   local $FS::UID::AutoCommit = 0;
994   my $dbh = dbh;
995
996   foreach my $inventory_item ( $self->inventory_item ) {
997     $inventory_item->svcnum('');
998     $inventory_item->svc_field('');
999     my $error = $inventory_item->replace();
1000     if ( $error ) {
1001       $dbh->rollback if $oldAutoCommit;
1002       return "Error returning inventory: $error";
1003     }
1004   }
1005
1006   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1007
1008   '';
1009 }
1010
1011 =item inventory_item
1012
1013 Returns the inventory items associated with this svc_ record, as
1014 FS::inventory_item objects (see L<FS::inventory_item>.
1015
1016 =cut
1017
1018 sub inventory_item {
1019   my $self = shift;
1020   qsearch({
1021     'table'     => 'inventory_item',
1022     'hashref'   => { 'svcnum' => $self->svcnum, },
1023   });
1024 }
1025
1026 =item release_router 
1027
1028 Delete any routers associated with this service.  This will release their
1029 address blocks, also.
1030
1031 =cut
1032
1033 sub release_router {
1034   my $self = shift;
1035   my @routers = qsearch('router', { svcnum => $self->svcnum });
1036   foreach (@routers) {
1037     my $error = $_->delete;
1038     return "$error (removing router '".$_->routername."')" if $error;
1039   }
1040   '';
1041 }
1042
1043
1044 =item cust_svc
1045
1046 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
1047 object (see L<FS::cust_svc>).
1048
1049 =item suspend
1050
1051 Runs export_suspend callbacks.
1052
1053 =cut
1054
1055 sub suspend {
1056   my $self = shift;
1057   my %options = @_;
1058   my $export_args = $options{'export_args'} || [];
1059   $self->export('suspend', @$export_args);
1060 }
1061
1062 =item unsuspend
1063
1064 Runs export_unsuspend callbacks.
1065
1066 =cut
1067
1068 sub unsuspend {
1069   my $self = shift;
1070   my %options = @_;
1071   my $export_args = $options{'export_args'} || [];
1072   $self->export('unsuspend', @$export_args);
1073 }
1074
1075 =item export_links
1076
1077 Runs export_links callbacks and returns the links.
1078
1079 =cut
1080
1081 sub export_links {
1082   my $self = shift;
1083   my $return = [];
1084   $self->export('links', $return);
1085   $return;
1086 }
1087
1088 =item export_getsettings
1089
1090 Runs export_getsettings callbacks and returns the two hashrefs.
1091
1092 =cut
1093
1094 sub export_getsettings {
1095   my $self = shift;
1096   my %settings = ();
1097   my %defaults = ();
1098   my $error = $self->export('getsettings', \%settings, \%defaults);
1099   if ( $error ) {
1100     warn "error running export_getsetings: $error";
1101     return ( { 'error' => $error }, {} );
1102   }
1103   ( \%settings, \%defaults );
1104 }
1105
1106 =item export_getstatus
1107
1108 Runs export_getstatus callbacks and returns a two item list consisting of an
1109 HTML status and a status hashref.
1110
1111 =cut
1112
1113 sub export_getstatus {
1114   my $self = shift;
1115   my $html = '';
1116   my %hash = ();
1117   my $error = $self->export('getstatus', \$html, \%hash);
1118   if ( $error ) {
1119     warn "error running export_getstatus: $error";
1120     return ( '', { 'error' => $error } );
1121   }
1122   ( $html, \%hash );
1123 }
1124
1125 =item export_setstatus
1126
1127 Runs export_setstatus callbacks.  If there is an error, returns the error,
1128 otherwise returns false.
1129
1130 =cut
1131
1132 sub export_setstatus { shift->_export_setstatus_X('setstatus', @_) }
1133 sub export_setstatus_listadd { shift->_export_setstatus_X('setstatus_listadd', @_) }
1134 sub export_setstatus_listdel { shift->_export_setstatus_X('setstatus_listdel', @_) }
1135 sub export_setstatus_vacationadd { shift->_export_setstatus_X('setstatus_vacationadd', @_) }
1136 sub export_setstatus_vacationdel { shift->_export_setstatus_X('setstatus_vacationdel', @_) }
1137
1138 sub _export_setstatus_X {
1139   my( $self, $method, @args ) = @_;
1140   my $error = $self->export($method, @args);
1141   if ( $error ) {
1142     warn "error running export_$method: $error";
1143     return $error;
1144   }
1145   '';
1146 }
1147
1148 =item export HOOK [ EXPORT_ARGS ]
1149
1150 Runs the provided export hook (i.e. "suspend", "unsuspend") for this service.
1151
1152 =cut
1153
1154 sub export {
1155   my( $self, $method ) = ( shift, shift );
1156
1157   $method = "export_$method" unless $method =~ /^export_/;
1158
1159   local $SIG{HUP} = 'IGNORE';
1160   local $SIG{INT} = 'IGNORE';
1161   local $SIG{QUIT} = 'IGNORE';
1162   local $SIG{TERM} = 'IGNORE';
1163   local $SIG{TSTP} = 'IGNORE';
1164   local $SIG{PIPE} = 'IGNORE';
1165
1166   my $oldAutoCommit = $FS::UID::AutoCommit;
1167   local $FS::UID::AutoCommit = 0;
1168   my $dbh = dbh;
1169
1170   #new-style exports!
1171   unless ( $noexport_hack ) {
1172     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
1173       next unless $part_export->can($method);
1174       my $error = $part_export->$method($self, @_);
1175       if ( $error ) {
1176         $dbh->rollback if $oldAutoCommit;
1177         return "error exporting $method event to ". $part_export->exporttype.
1178                " (transaction rolled back): $error";
1179       }
1180     }
1181   }
1182
1183   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1184   '';
1185
1186 }
1187
1188 =item overlimit
1189
1190 Sets or retrieves overlimit date.
1191
1192 =cut
1193
1194 sub overlimit {
1195   my $self = shift;
1196   #$self->cust_svc->overlimit(@_);
1197   my $cust_svc = $self->cust_svc;
1198   unless ( $cust_svc ) { #wtf?
1199     my $error = "$me overlimit: missing cust_svc record for svc_acct svcnum ".
1200                 $self->svcnum;
1201     if ( $overlimit_missing_cust_svc_nonfatal_kludge ) {
1202       cluck "$error; continuing anyway as requested";
1203       return '';
1204     } else {
1205       confess $error;
1206     }
1207   }
1208   $cust_svc->overlimit(@_);
1209 }
1210
1211 =item cancel
1212
1213 Stub - returns false (no error) so derived classes don't need to define this
1214 methods.  Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
1215
1216 This method is called *before* the deletion step which actually deletes the
1217 services.  This method should therefore only be used for "pre-deletion"
1218 cancellation steps, if necessary.
1219
1220 =cut
1221
1222 sub cancel { ''; }
1223
1224 =item clone_suspended
1225
1226 Constructor used by FS::part_export::_export_suspend fallback.  Stub returning
1227 same object for svc_ classes which don't implement a suspension fallback
1228 (everything except svc_acct at the moment).  Document better.
1229
1230 =cut
1231
1232 sub clone_suspended {
1233   shift;
1234 }
1235
1236 =item clone_kludge_unsuspend 
1237
1238 Constructor used by FS::part_export::_export_unsuspend fallback.  Stub returning
1239 same object for svc_ classes which don't implement a suspension fallback
1240 (everything except svc_acct at the moment).  Document better.
1241
1242 =cut
1243
1244 sub clone_kludge_unsuspend {
1245   shift;
1246 }
1247
1248 =item find_duplicates MODE FIELDS...
1249
1250 Method used by _check_duplicate routines to find services with duplicate 
1251 values in specified fields.  Set MODE to 'global' to search across all 
1252 services, or 'export' to limit to those that share one or more exports 
1253 with this service.  FIELDS is a list of field names; only services 
1254 matching in all fields will be returned.  Empty fields will be skipped.
1255
1256 =cut
1257
1258 sub find_duplicates {
1259   my $self = shift;
1260   my $mode = shift;
1261   my @fields = @_;
1262
1263   my %search = map { $_ => $self->getfield($_) } 
1264                grep { length($self->getfield($_)) } @fields;
1265   return () if !%search;
1266   my @dup = grep { ! $self->svcnum or $_->svcnum != $self->svcnum }
1267             qsearch( $self->table, \%search );
1268   return () if !@dup;
1269   return @dup if $mode eq 'global';
1270   die "incorrect find_duplicates mode '$mode'" if $mode ne 'export';
1271
1272   my $exports = FS::part_export::export_info($self->table);
1273   my %conflict_svcparts;
1274   my $part_svc = $self->part_svc;
1275   foreach my $part_export ( $part_svc->part_export ) {
1276     %conflict_svcparts = map { $_->svcpart => 1 } $part_export->export_svc;
1277   }
1278   return grep { $conflict_svcparts{$_->cust_svc->svcpart} } @dup;
1279 }
1280
1281 =item getstatus_html
1282
1283 =cut
1284
1285 sub getstatus_html {
1286   my $self = shift;
1287
1288   my $part_svc = $self->cust_svc->part_svc;
1289
1290   my $html = '';
1291
1292   foreach my $export ( grep $_->can('export_getstatus'), $part_svc->part_export ) {
1293     my $export_html = '';
1294     my %hash = ();
1295     $export->export_getstatus( $self, \$export_html, \%hash );
1296     $html .= $export_html;
1297   }
1298
1299   $html;
1300
1301 }
1302
1303 =item nms_ip_insert
1304
1305 =cut
1306
1307 sub nms_ip_insert {
1308   my $self = shift;
1309   my $conf = new FS::Conf;
1310   return '' unless grep { $self->table eq $_ }
1311                      $conf->config('nms-auto_add-svc_ips');
1312   my $ip_field = $self->table_info->{'ip_field'};
1313
1314   my $queue = FS::queue->new( {
1315                 'job'    => 'FS::NetworkMonitoringSystem::queued_add_router',
1316                 'svcnum' => $self->svcnum,
1317   } );
1318   $queue->insert( 'FS::NetworkMonitoringSystem',
1319                   $self->$ip_field(),
1320                   $conf->config('nms-auto_add-community')
1321                 );
1322 }
1323
1324 =item nms_delip
1325
1326 =cut
1327
1328 sub nms_ip_delete {
1329 #XXX not yet implemented
1330 }
1331
1332 =item search_sql_field FIELD STRING
1333
1334 Class method which returns an SQL fragment to search for STRING in FIELD.
1335
1336 It is now case-insensitive by default.
1337
1338 =cut
1339
1340 sub search_sql_field {
1341   my( $class, $field, $string ) = @_;
1342   my $table = $class->table;
1343   my $q_string = dbh->quote($string);
1344   "LOWER($table.$field) = LOWER($q_string)";
1345 }
1346
1347 #fallback for services that don't provide a search... 
1348 sub search_sql {
1349   #my( $class, $string ) = @_;
1350   '1 = 0'; #false
1351 }
1352
1353 =item search HASHREF
1354
1355 Class method which returns a qsearch hash expression to search for parameters
1356 specified in HASHREF.
1357
1358 Parameters:
1359
1360 =over 4
1361
1362 =item unlinked - set to search for all unlinked services.  Overrides all other options.
1363
1364 =item agentnum
1365
1366 =item custnum
1367
1368 =item svcpart
1369
1370 =item ip_addr
1371
1372 =item pkgpart - arrayref
1373
1374 =item routernum - arrayref
1375
1376 =item sectornum - arrayref
1377
1378 =item towernum - arrayref
1379
1380 =item order_by
1381
1382 =back
1383
1384 =cut
1385
1386 # svc_broadband::search should eventually use this instead
1387 sub search {
1388   my ($class, $params) = @_;
1389
1390   my @from = (
1391     'LEFT JOIN cust_svc  USING ( svcnum  )',
1392     'LEFT JOIN part_svc  USING ( svcpart )',
1393     'LEFT JOIN cust_pkg  USING ( pkgnum  )',
1394     FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg'),
1395   );
1396
1397   my @where = ();
1398
1399   $class->_search_svc($params, \@from, \@where) if $class->can('_search_svc');
1400
1401 #  # domain
1402 #  if ( $params->{'domain'} ) { 
1403 #    my $svc_domain = qsearchs('svc_domain', { 'domain'=>$params->{'domain'} } );
1404 #    #preserve previous behavior & bubble up an error if $svc_domain not found?
1405 #    push @where, 'domsvc = '. $svc_domain->svcnum if $svc_domain;
1406 #  }
1407 #
1408 #  # domsvc
1409 #  if ( $params->{'domsvc'} =~ /^(\d+)$/ ) { 
1410 #    push @where, "domsvc = $1";
1411 #  }
1412
1413   #unlinked
1414   push @where, 'pkgnum IS NULL' if $params->{'unlinked'};
1415
1416   #agentnum
1417   if ( $params->{'agentnum'} =~ /^(\d+)$/ && $1 ) {
1418     push @where, "cust_main.agentnum = $1";
1419   }
1420
1421   #custnum
1422   if ( $params->{'custnum'} =~ /^(\d+)$/ && $1 ) {
1423     push @where, "cust_pkg.custnum = $1";
1424   }
1425
1426   #customer status
1427   if ( $params->{'cust_status'} =~ /^([a-z]+)$/ ) {
1428     push @where, FS::cust_main->cust_status_sql . " = '$1'";
1429   }
1430
1431   #customer balance
1432   if ( $params->{'balance'} =~ /^\s*(\-?\d*(\.\d{1,2})?)\s*$/ && length($1) ) {
1433     my $balance = $1;
1434
1435     my $age = '';
1436     if ( $params->{'balance_days'} =~ /^\s*(\d*(\.\d{1,3})?)\s*$/ && length($1) ) {
1437       $age = time - 86400 * $1;
1438     }
1439     push @where, FS::cust_main->balance_date_sql($age) . " > $balance";
1440   }
1441
1442   #payby
1443   if ( $params->{'payby'} && scalar(@{ $params->{'payby'} }) ) {
1444     my @payby = map "'$_'", grep /^(\w+)$/, @{ $params->{'payby'} };
1445     push @where, 'payby IN ('. join(',', @payby ). ')';
1446   }
1447
1448   #pkgpart
1449   ##pkgpart, now properly untainted, can be arrayref
1450   #for my $pkgpart ( $params->{'pkgpart'} ) {
1451   #  if ( ref $pkgpart ) {
1452   #    my $where = join(',', map { /^(\d+)$/ ? $1 : () } @$pkgpart );
1453   #    push @where, "cust_pkg.pkgpart IN ($where)" if $where;
1454   #  }
1455   #  elsif ( $pkgpart =~ /^(\d+)$/ ) {
1456   #    push @where, "cust_pkg.pkgpart = $1";
1457   #  }
1458   #}
1459   if ( $params->{'pkgpart'} ) {
1460     my @pkgpart = ref( $params->{'pkgpart'} )
1461                     ? @{ $params->{'pkgpart'} }
1462                     : $params->{'pkgpart'}
1463                       ? ( $params->{'pkgpart'} )
1464                       : ();
1465     @pkgpart = grep /^(\d+)$/, @pkgpart;
1466     push @where, 'cust_pkg.pkgpart IN ('. join(',', @pkgpart ). ')' if @pkgpart;
1467   }
1468
1469   #svcnum
1470   if ( $params->{'svcnum'} =~ /^(\d+)$/ ) {
1471     push @where, "svcnum = $1";
1472   }
1473
1474   # svcpart
1475   if ( $params->{'svcpart'} ) {
1476     my @svcpart = ref( $params->{'svcpart'} )
1477                     ? @{ $params->{'svcpart'} }
1478                     : $params->{'svcpart'}
1479                       ? ( $params->{'svcpart'} )
1480                       : ();
1481     @svcpart = grep /^(\d+)$/, @svcpart;
1482     push @where, 'svcpart IN ('. join(',', @svcpart ). ')' if @svcpart;
1483   }
1484
1485   if ( $params->{'exportnum'} =~ /^(\d+)$/ ) {
1486     push @from, ' LEFT JOIN export_svc USING ( svcpart )';
1487     push @where, "exportnum = $1";
1488   }
1489
1490 #  # sector and tower
1491 #  my @where_sector = $class->tower_sector_sql($params);
1492 #  if ( @where_sector ) {
1493 #    push @where, @where_sector;
1494 #    push @from, ' LEFT JOIN tower_sector USING ( sectornum )';
1495 #  }
1496
1497   # here is the agent virtualization
1498   #if ($params->{CurrentUser}) {
1499   #  my $access_user =
1500   #    qsearchs('access_user', { username => $params->{CurrentUser} });
1501   #
1502   #  if ($access_user) {
1503   #    push @where, $access_user->agentnums_sql('table'=>'cust_main');
1504   #  }else{
1505   #    push @where, "1=0";
1506   #  }
1507   #} else {
1508     push @where, $FS::CurrentUser::CurrentUser->agentnums_sql(
1509                    'table'      => 'cust_main',
1510                    'null_right' => 'View/link unlinked services',
1511                  );
1512   #}
1513
1514   push @where, @{ $params->{'where'} } if $params->{'where'};
1515
1516   my $addl_from = join(' ', @from);
1517   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
1518
1519   my $table = $class->table;
1520
1521   my $count_query = "SELECT COUNT(*) FROM $table $addl_from $extra_sql";
1522   #if ( keys %svc_X ) {
1523   #  $count_query .= ' WHERE '.
1524   #                    join(' AND ', map "$_ = ". dbh->quote($svc_X{$_}),
1525   #                                      keys %svc_X
1526   #                        );
1527   #}
1528
1529   {
1530     'table'       => $table,
1531     'hashref'     => {},
1532     'select'      => join(', ',
1533                        "$table.*",
1534                        'part_svc.svc',
1535                        'cust_main.custnum',
1536                        @{ $params->{'addl_select'} || [] },
1537                        FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
1538                      ),
1539     'addl_from'   => $addl_from,
1540     'extra_sql'   => $extra_sql,
1541     'order_by'    => $params->{'order_by'},
1542     'count_query' => $count_query,
1543   };
1544
1545 }
1546
1547 =back
1548
1549 =head1 BUGS
1550
1551 The setfixed method return value.
1552
1553 B<export> method isn't used by insert and replace methods yet.
1554
1555 =head1 SEE ALSO
1556
1557 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
1558 from the base documentation.
1559
1560 =cut
1561
1562 1;
1563