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