1 package FS::svc_Common;
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 );
10 use FS::Record qw( qsearch qsearchs fields dbh );
11 use FS::cust_main_Mixin;
16 use FS::inventory_item;
17 use FS::inventory_class;
18 use FS::NetworkMonitoringSystem;
20 @ISA = qw( FS::cust_main_Mixin FS::Record );
22 $me = '[FS::svc_Common]';
25 $overlimit_missing_cust_svc_nonfatal_kludge = 0;
29 FS::svc_Common - Object method for all svc_ records
35 @ISA = qw( FS::svc_Common );
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.
52 my $class = ref($proto) || $proto;
54 bless ($self, $class);
56 unless ( defined ( $self->table ) ) {
57 $self->{'Table'} = shift;
58 carp "warning: FS::Record::new called with table name ". $self->{'Table'};
61 #$self->{'Hash'} = shift;
63 $self->{'Hash'} = { map { $_ => $newhash->{$_} } qw(svcnum svcpart) };
65 $self->setdefault( $self->_fieldhandlers )
68 $self->{'Hash'}{$_} = $newhash->{$_}
69 foreach grep { defined($newhash->{$_}) && length($newhash->{$_}) }
72 foreach my $field ( grep !defined($self->{'Hash'}{$_}), $self->fields ) {
73 $self->{'Hash'}{$field}='';
76 $self->_rebless if $self->can('_rebless');
78 $self->{'modified'} = 0;
80 $self->_cache($self->{'Hash'}, shift) if $self->can('_cache') && @_;
86 sub _fieldhandlers { {}; }
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.
101 my @vfields = $self->SUPER::virtual_fields;
103 return @vfields unless (ref $self); # Case 4
105 if ($self->svcpart) { # Case 1
106 $svcpart = $self->svcpart;
107 } elsif ( $self->svcnum
108 && qsearchs('cust_svc',{'svcnum'=>$self->svcnum} )
110 $svcpart = $self->cust_svc->svcpart;
115 if ($svcpart) { #Cases 1 and 2
116 my %flags = map { $_->columnname, $_->columnflag } (
117 qsearch ('part_svc_column', { svcpart => $svcpart } )
119 return grep { not ( defined($flags{$_}) && $flags{$_} eq 'X') } @vfields;
128 svc_Common provides a fallback label subroutine that just returns the svcnum.
134 cluck "warning: ". ref($self). " not loaded or missing label method; ".
146 (($self->cust_svc || return)->cust_pkg || return)->cust_main || return
151 defined($self->cust_main);
156 Checks the validity of fields in this record.
158 At present, this does nothing but call FS::Record::check (which, in turn,
159 does nothing but run virtual field checks).
168 =item insert [ , OPTION => VALUE ... ]
170 Adds this record to the database. If there is an error, returns the error,
171 otherwise returns false.
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.
176 Currently available options are: I<jobnums>, I<child_objects> and
179 If I<jobnum> is set to an array reference, the jobnums of any export jobs will
180 be added to the referenced array.
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' ]>
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)).
194 If I<export_args> is set to an array reference, the referenced list will be
195 passed to export commands.
202 warn "[$me] insert called with options ".
203 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
207 local $FS::queue::jobnums = \@jobnums;
208 warn "[$me] insert: set \$FS::queue::jobnums to $FS::queue::jobnums\n"
210 my $objects = $options{'child_objects'} || [];
211 my $depend_jobnums = $options{'depend_jobnum'} || [];
212 $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
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';
221 my $oldAutoCommit = $FS::UID::AutoCommit;
222 local $FS::UID::AutoCommit = 0;
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,
236 my $error = $cust_svc->insert;
238 $dbh->rollback if $oldAutoCommit;
241 $inserted_cust_svc = 1;
242 $svcnum = $self->svcnum($cust_svc->svcnum);
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;
249 $self->pkgnum($cust_svc->pkgnum);
250 $self->svcpart($cust_svc->svcpart);
253 my $error = $self->preinsert_hook_first
254 || $self->set_auto_inventory
256 || $self->_check_duplicate
257 || $self->preinsert_hook
258 || $self->SUPER::insert;
260 if ( $inserted_cust_svc ) {
261 my $derror = $cust_svc->delete;
262 die $derror if $derror;
264 $dbh->rollback if $oldAutoCommit;
268 foreach my $object ( @$objects ) {
270 if ( ref($object) eq 'ARRAY' ) {
271 ($obj, $field) = @$object;
276 $obj->$field($self->svcnum);
277 $error = $obj->insert;
279 $dbh->rollback if $oldAutoCommit;
285 unless ( $noexport_hack ) {
287 warn "[$me] insert: \$FS::queue::jobnums is $FS::queue::jobnums\n"
290 my $export_args = $options{'export_args'} || [];
292 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
293 my $error = $part_export->export_insert($self, @$export_args);
295 $dbh->rollback if $oldAutoCommit;
296 return "exporting to ". $part_export->exporttype.
297 " (transaction rolled back): $error";
301 foreach my $depend_jobnum ( @$depend_jobnums ) {
302 warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
304 foreach my $jobnum ( @jobnums ) {
305 my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
306 warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
308 my $error = $queue->depend_insert($depend_jobnum);
310 $dbh->rollback if $oldAutoCommit;
311 return "error queuing job dependancy: $error";
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";
324 if ( exists $options{'jobnums'} ) {
325 push @{ $options{'jobnums'} }, @jobnums;
328 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
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 { ''; }
341 =item delete [ , OPTION => VALUE ... ]
343 Deletes this account from the database. If there is an error, returns the
344 error, otherwise returns false.
346 The corresponding FS::cust_svc record will be deleted as well.
353 my $export_args = $options{'export_args'} || [];
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';
362 my $oldAutoCommit = $FS::UID::AutoCommit;
363 local $FS::UID::AutoCommit = 0;
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
374 $dbh->rollback if $oldAutoCommit;
378 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
385 Currently this will only run expire exports if any are attached
390 my($self,$date) = (shift,shift);
392 return 'Expire date must be specified' unless $date;
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';
401 my $oldAutoCommit = $FS::UID::AutoCommit;
402 local $FS::UID::AutoCommit = 0;
405 my $export_args = [$date];
406 my $error = $self->export('expire', @$export_args);
408 $dbh->rollback if $oldAutoCommit;
412 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
417 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ]
419 Replaces OLD_RECORD with this one. If there is an error, returns the error,
420 otherwise returns false.
422 Currently available options are: I<child_objects>, I<export_args> and
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' ]>
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)).
437 If I<export_args> is set to an array reference, the referenced list will be
438 passed to export commands.
445 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
450 ( ref($_[0]) eq 'HASH' )
454 my $objects = $options->{'child_objects'} || [];
457 local $FS::queue::jobnums = \@jobnums;
458 warn "[$me] replace: set \$FS::queue::jobnums to $FS::queue::jobnums\n"
460 my $depend_jobnums = $options->{'depend_jobnum'} || [];
461 $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
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';
470 my $oldAutoCommit = $FS::UID::AutoCommit;
471 local $FS::UID::AutoCommit = 0;
474 my $error = $new->set_auto_inventory($old);
476 $dbh->rollback if $oldAutoCommit;
480 #redundant, but so any duplicate fields are maniuplated as appropriate
481 # (svc_phone.phonenum)
482 $error = $new->check;
484 $dbh->rollback if $oldAutoCommit;
488 #if ( $old->username ne $new->username || $old->domsvc != $new->domsvc ) {
489 if ( grep { $old->$_ ne $new->$_ } $new->table_dupcheck_fields ) {
491 $new->svcpart( $new->cust_svc->svcpart ) unless $new->svcpart;
492 $error = $new->_check_duplicate;
494 $dbh->rollback if $oldAutoCommit;
499 $error = $new->SUPER::replace($old);
501 $dbh->rollback if $oldAutoCommit;
505 foreach my $object ( @$objects ) {
507 if ( ref($object) eq 'ARRAY' ) {
508 ($obj, $field) = @$object;
513 $obj->$field($new->svcnum);
515 my $oldobj = qsearchs( $obj->table, {
516 $field => $new->svcnum,
517 map { $_ => $obj->$_ } $obj->_svc_child_partfields,
521 my $pkey = $oldobj->primary_key;
522 $obj->$pkey($oldobj->$pkey);
523 $obj->replace($oldobj);
525 $error = $obj->insert;
528 $dbh->rollback if $oldAutoCommit;
534 unless ( $noexport_hack ) {
536 warn "[$me] replace: \$FS::queue::jobnums is $FS::queue::jobnums\n"
539 my $export_args = $options->{'export_args'} || [];
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
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 =
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;
553 foreach my $delete_part_export (
554 grep { ! $new_exportnum{$_->exportnum} } @old_part_export
556 my $error = $delete_part_export->export_delete($old, @$export_args);
558 $dbh->rollback if $oldAutoCommit;
559 return "error deleting, export to ". $delete_part_export->exporttype.
560 " (transaction rolled back): $error";
564 foreach my $replace_part_export (
565 grep { $old_exportnum{$_->exportnum} } @new_part_export
568 $replace_part_export->export_replace( $new, $old, @$export_args);
570 $dbh->rollback if $oldAutoCommit;
571 return "error exporting to ". $replace_part_export->exporttype.
572 " (transaction rolled back): $error";
576 foreach my $insert_part_export (
577 grep { ! $old_exportnum{$_->exportnum} } @new_part_export
579 my $error = $insert_part_export->export_insert($new, @$export_args );
581 $dbh->rollback if $oldAutoCommit;
582 return "error inserting export to ". $insert_part_export->exporttype.
583 " (transaction rolled back): $error";
587 foreach my $depend_jobnum ( @$depend_jobnums ) {
588 warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
590 foreach my $jobnum ( @jobnums ) {
591 my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
592 warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
594 my $error = $queue->depend_insert($depend_jobnum);
596 $dbh->rollback if $oldAutoCommit;
597 return "error queuing job dependancy: $error";
604 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
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.
618 $self->setx('F', @_);
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).
631 $self->setx('D', @_ );
634 =item set_default_and_fixed
638 sub set_default_and_fixed {
640 $self->setx( [ 'D', 'F' ], @_ );
643 =item setx FLAG | FLAG_ARRAYREF , [ CALLBACK_HASHREF ]
645 Sets fields according to the passed in flag or arrayref of flags.
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.
657 my @x = ref($x) ? @$x : ($x);
658 my $coderef = scalar(@_) ? shift : $self->_fieldhandlers;
661 $self->ut_numbern('svcnum')
663 return $error if $error;
665 my $part_svc = $self->part_svc;
666 return "Unknown svcpart" unless $part_svc;
668 #set default/fixed/whatever fields from part_svc
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
675 my $columnname = $part_svc_column->columnname;
676 my $columnvalue = $part_svc_column->columnvalue;
678 $columnvalue = &{ $coderef->{$columnname} }( $self, $columnvalue )
679 if exists( $coderef->{$columnname} );
680 $self->setfield( $columnname, $columnvalue );
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;
701 qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
707 Returns the FS::svc_pbx record for this service, if any (see L<FS::svc_pbx>).
709 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
714 # XXX FS::h_svc_{acct,phone} could have a history-aware svc_pbx override
718 return '' unless $self->pbxsvc;
719 qsearchs( 'svc_pbx', { 'svcnum' => $self->pbxsvc } );
724 Returns the title of the FS::svc_pbx record associated with this service, if
727 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
734 my $svc_pbx = $self->svc_pbx or return '';
738 =item pbx_select_hash %OPTIONS
740 Can be called as an object method or a class method.
742 Returns a hash SVCNUM => TITLE ... representing the PBXes this customer
743 that may be associated with this service.
745 Currently available options are: I<pkgnum> I<svcpart>
747 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
752 #false laziness w/svc_acct::domain_select_hash
753 sub pbx_select_hash {
754 my ($self, %options) = @_;
760 $part_svc = $self->part_svc;
761 $cust_pkg = $self->cust_svc->cust_pkg
765 $part_svc = qsearchs('part_svc', { 'svcpart' => $options{svcpart} })
766 if $options{'svcpart'};
768 $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $options{pkgnum} })
769 if $options{'pkgnum'};
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 });
783 %pbxes = map { $_->svcnum => $_->title } qsearch('svc_pbx', {} );
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 } );
790 $pbxes{$svc_pbx->svcnum} = $svc_pbx->title;
792 warn "unknown svc_pbx.svcnum for part_svc_column pbxsvc: ".
793 $part_svc->part_svc_column('pbxsvc')->columnvalue;
802 =item set_auto_inventory
804 Sets any fields which auto-populate from inventory (see L<FS::part_svc>), and
805 also check any manually populated inventory fields.
807 If there is an error, returns the error, otherwise returns false.
811 sub set_auto_inventory {
813 my $old = @_ ? shift : '';
816 $self->ut_numbern('svcnum')
818 return $error if $error;
820 my $part_svc = $self->part_svc;
821 return "Unkonwn svcpart" unless $part_svc;
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';
830 my $oldAutoCommit = $FS::UID::AutoCommit;
831 local $FS::UID::AutoCommit = 0;
834 #set default/fixed/whatever fields from part_svc
835 my $table = $self->table;
836 foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
838 my $part_svc_column = $part_svc->part_svc_column($field);
839 my $columnflag = $part_svc_column->columnflag;
840 next unless $columnflag =~ /^[AM]$/;
842 next if $columnflag eq 'A' && $self->$field() ne '';
844 my $classnum = $part_svc_column->columnvalue;
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 my $chosen_classnum = $self->getfield($field.'_classnum');
853 if ( grep {$_ == $chosen_classnum} split(',', $classnum) ) {
854 $classnum = $chosen_classnum;
856 # otherwise the chosen classnum is either (all), or somehow not on
857 # the list, so ignore it and choose the first item that's in any
861 my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql(
863 'table' => 'inventory_item',
866 my $inventory_item = qsearchs({
867 'table' => 'inventory_item',
869 'extra_sql' => "AND classnum IN ($classnum) AND $agentnums_sql",
870 'order_by' => 'ORDER BY ( agentnum IS NULL ) '. #agent inventory first
871 ' LIMIT 1 FOR UPDATE',
874 unless ( $inventory_item ) {
875 # should really only be shown if columnflag eq 'A'...
876 $dbh->rollback if $oldAutoCommit;
877 my $message = 'Out of ';
878 my @classnums = split(',', $classnum);
879 foreach ( @classnums ) {
880 my $class = FS::inventory_class->by_key($_)
881 or return "Can't find inventory_class.classnum $_";
882 $message .= PL_N($class->classname);
883 if ( scalar(@classnums) > 2 ) { # english is hard
884 if ( $_ != $classnums[-1] ) {
888 if ( scalar(@classnums) > 1 and $_ == $classnums[-2] ) {
895 next if $columnflag eq 'M' && $inventory_item->svcnum == $self->svcnum;
897 $self->setfield( $field, $inventory_item->item );
898 #if $columnflag eq 'A' && $self->$field() eq '';
900 # release the old inventory item, if there was one
901 if ( $old && $old->$field() && $old->$field() ne $self->$field() ) {
902 my $old_inv = qsearchs({
903 'table' => 'inventory_item',
905 'svcnum' => $old->svcnum,
907 'extra_sql' => "AND classnum IN ($classnum) AND ".
908 '( ( svc_field IS NOT NULL AND svc_field = '.$dbh->quote($field).' )'.
909 ' OR ( svc_field IS NULL AND item = '. dbh->quote($old->$field).' )'.
913 $old_inv->svcnum('');
914 $old_inv->svc_field('');
915 my $oerror = $old_inv->replace;
917 $dbh->rollback if $oldAutoCommit;
918 return "Error unprovisioning inventory: $oerror";
921 warn "old inventory_item not found for $field ". $self->$field;
925 $inventory_item->svcnum( $self->svcnum );
926 $inventory_item->svc_field( $field );
927 my $ierror = $inventory_item->replace();
929 $dbh->rollback if $oldAutoCommit;
930 return "Error provisioning inventory: $ierror";
935 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
941 =item return_inventory
943 Release all inventory items attached to this service's fields. Call
944 when unprovisioning the service.
948 sub return_inventory {
951 local $SIG{HUP} = 'IGNORE';
952 local $SIG{INT} = 'IGNORE';
953 local $SIG{QUIT} = 'IGNORE';
954 local $SIG{TERM} = 'IGNORE';
955 local $SIG{TSTP} = 'IGNORE';
956 local $SIG{PIPE} = 'IGNORE';
958 my $oldAutoCommit = $FS::UID::AutoCommit;
959 local $FS::UID::AutoCommit = 0;
962 foreach my $inventory_item ( $self->inventory_item ) {
963 $inventory_item->svcnum('');
964 $inventory_item->svc_field('');
965 my $error = $inventory_item->replace();
967 $dbh->rollback if $oldAutoCommit;
968 return "Error returning inventory: $error";
972 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
979 Returns the inventory items associated with this svc_ record, as
980 FS::inventory_item objects (see L<FS::inventory_item>.
987 'table' => 'inventory_item',
988 'hashref' => { 'svcnum' => $self->svcnum, },
994 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
995 object (see L<FS::cust_svc>).
1001 qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
1006 Runs export_suspend callbacks.
1013 my $export_args = $options{'export_args'} || [];
1014 $self->export('suspend', @$export_args);
1019 Runs export_unsuspend callbacks.
1026 my $export_args = $options{'export_args'} || [];
1027 $self->export('unsuspend', @$export_args);
1032 Runs export_links callbacks and returns the links.
1039 $self->export('links', $return);
1043 =item export_getsettings
1045 Runs export_getsettings callbacks and returns the two hashrefs.
1049 sub export_getsettings {
1053 my $error = $self->export('getsettings', \%settings, \%defaults);
1055 warn "error running export_getsetings: $error";
1056 return ( { 'error' => $error }, {} );
1058 ( \%settings, \%defaults );
1061 =item export_getstatus
1063 Runs export_getstatus callbacks and returns a two item list consisting of an
1064 HTML status and a status hashref.
1068 sub export_getstatus {
1072 my $error = $self->export('getstatus', \$html, \%hash);
1074 warn "error running export_getstatus: $error";
1075 return ( '', { 'error' => $error } );
1080 =item export_setstatus
1082 Runs export_setstatus callbacks. If there is an error, returns the error,
1083 otherwise returns false.
1087 sub export_setstatus { shift->_export_setstatus_X('setstatus', @_) }
1088 sub export_setstatus_listadd { shift->_export_setstatus_X('setstatus_listadd', @_) }
1089 sub export_setstatus_listdel { shift->_export_setstatus_X('setstatus_listdel', @_) }
1090 sub export_setstatus_vacationadd { shift->_export_setstatus_X('setstatus_vacationadd', @_) }
1091 sub export_setstatus_vacationdel { shift->_export_setstatus_X('setstatus_vacationdel', @_) }
1093 sub _export_setstatus_X {
1094 my( $self, $method, @args ) = @_;
1095 my $error = $self->export($method, @args);
1097 warn "error running export_$method: $error";
1103 =item export HOOK [ EXPORT_ARGS ]
1105 Runs the provided export hook (i.e. "suspend", "unsuspend") for this service.
1110 my( $self, $method ) = ( shift, shift );
1112 $method = "export_$method" unless $method =~ /^export_/;
1114 local $SIG{HUP} = 'IGNORE';
1115 local $SIG{INT} = 'IGNORE';
1116 local $SIG{QUIT} = 'IGNORE';
1117 local $SIG{TERM} = 'IGNORE';
1118 local $SIG{TSTP} = 'IGNORE';
1119 local $SIG{PIPE} = 'IGNORE';
1121 my $oldAutoCommit = $FS::UID::AutoCommit;
1122 local $FS::UID::AutoCommit = 0;
1126 unless ( $noexport_hack ) {
1127 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
1128 next unless $part_export->can($method);
1129 my $error = $part_export->$method($self, @_);
1131 $dbh->rollback if $oldAutoCommit;
1132 return "error exporting $method event to ". $part_export->exporttype.
1133 " (transaction rolled back): $error";
1138 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1145 Sets or retrieves overlimit date.
1151 #$self->cust_svc->overlimit(@_);
1152 my $cust_svc = $self->cust_svc;
1153 unless ( $cust_svc ) { #wtf?
1154 my $error = "$me overlimit: missing cust_svc record for svc_acct svcnum ".
1156 if ( $overlimit_missing_cust_svc_nonfatal_kludge ) {
1157 cluck "$error; continuing anyway as requested";
1163 $cust_svc->overlimit(@_);
1168 Stub - returns false (no error) so derived classes don't need to define this
1169 methods. Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
1171 This method is called *before* the deletion step which actually deletes the
1172 services. This method should therefore only be used for "pre-deletion"
1173 cancellation steps, if necessary.
1179 =item clone_suspended
1181 Constructor used by FS::part_export::_export_suspend fallback. Stub returning
1182 same object for svc_ classes which don't implement a suspension fallback
1183 (everything except svc_acct at the moment). Document better.
1187 sub clone_suspended {
1191 =item clone_kludge_unsuspend
1193 Constructor used by FS::part_export::_export_unsuspend fallback. Stub returning
1194 same object for svc_ classes which don't implement a suspension fallback
1195 (everything except svc_acct at the moment). Document better.
1199 sub clone_kludge_unsuspend {
1203 =item find_duplicates MODE FIELDS...
1205 Method used by _check_duplicate routines to find services with duplicate
1206 values in specified fields. Set MODE to 'global' to search across all
1207 services, or 'export' to limit to those that share one or more exports
1208 with this service. FIELDS is a list of field names; only services
1209 matching in all fields will be returned. Empty fields will be skipped.
1213 sub find_duplicates {
1218 my %search = map { $_ => $self->getfield($_) }
1219 grep { length($self->getfield($_)) } @fields;
1220 return () if !%search;
1221 my @dup = grep { ! $self->svcnum or $_->svcnum != $self->svcnum }
1222 qsearch( $self->table, \%search );
1224 return @dup if $mode eq 'global';
1225 die "incorrect find_duplicates mode '$mode'" if $mode ne 'export';
1227 my $exports = FS::part_export::export_info($self->table);
1228 my %conflict_svcparts;
1229 my $part_svc = $self->part_svc;
1230 foreach my $part_export ( $part_svc->part_export ) {
1231 %conflict_svcparts = map { $_->svcpart => 1 } $part_export->export_svc;
1233 return grep { $conflict_svcparts{$_->cust_svc->svcpart} } @dup;
1236 =item getstatus_html
1240 sub getstatus_html {
1243 my $part_svc = $self->cust_svc->part_svc;
1247 foreach my $export ( grep $_->can('export_getstatus'), $part_svc->part_export ) {
1248 my $export_html = '';
1250 $export->export_getstatus( $self, \$export_html, \%hash );
1251 $html .= $export_html;
1264 my $conf = new FS::Conf;
1265 return '' unless grep { $self->table eq $_ }
1266 $conf->config('nms-auto_add-svc_ips');
1267 my $ip_field = $self->table_info->{'ip_field'};
1269 my $queue = FS::queue->new( {
1270 'job' => 'FS::NetworkMonitoringSystem::queued_add_router',
1271 'svcnum' => $self->svcnum,
1273 $queue->insert( 'FS::NetworkMonitoringSystem',
1275 $conf->config('nms-auto_add-community')
1284 #XXX not yet implemented
1287 =item search_sql_field FIELD STRING
1289 Class method which returns an SQL fragment to search for STRING in FIELD.
1291 It is now case-insensitive by default.
1295 sub search_sql_field {
1296 my( $class, $field, $string ) = @_;
1297 my $table = $class->table;
1298 my $q_string = dbh->quote($string);
1299 "LOWER($table.$field) = LOWER($q_string)";
1302 #fallback for services that don't provide a search...
1304 #my( $class, $string ) = @_;
1308 =item search HASHREF
1310 Class method which returns a qsearch hash expression to search for parameters
1311 specified in HASHREF.
1317 =item unlinked - set to search for all unlinked services. Overrides all other options.
1327 =item pkgpart - arrayref
1329 =item routernum - arrayref
1331 =item sectornum - arrayref
1333 =item towernum - arrayref
1341 # svc_broadband::search should eventually use this instead
1343 my ($class, $params) = @_;
1346 'LEFT JOIN cust_svc USING ( svcnum )',
1347 'LEFT JOIN part_svc USING ( svcpart )',
1348 'LEFT JOIN cust_pkg USING ( pkgnum )',
1349 FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg'),
1354 $class->_search_svc($params, \@from, \@where) if $class->can('_search_svc');
1357 # if ( $params->{'domain'} ) {
1358 # my $svc_domain = qsearchs('svc_domain', { 'domain'=>$params->{'domain'} } );
1359 # #preserve previous behavior & bubble up an error if $svc_domain not found?
1360 # push @where, 'domsvc = '. $svc_domain->svcnum if $svc_domain;
1364 # if ( $params->{'domsvc'} =~ /^(\d+)$/ ) {
1365 # push @where, "domsvc = $1";
1369 push @where, 'pkgnum IS NULL' if $params->{'unlinked'};
1372 if ( $params->{'agentnum'} =~ /^(\d+)$/ && $1 ) {
1373 push @where, "cust_main.agentnum = $1";
1377 if ( $params->{'custnum'} =~ /^(\d+)$/ && $1 ) {
1378 push @where, "custnum = $1";
1382 if ( $params->{'cust_status'} =~ /^([a-z]+)$/ ) {
1383 push @where, FS::cust_main->cust_status_sql . " = '$1'";
1387 if ( $params->{'balance'} =~ /^\s*(\-?\d*(\.\d{1,2})?)\s*$/ && length($1) ) {
1391 if ( $params->{'balance_days'} =~ /^\s*(\d*(\.\d{1,3})?)\s*$/ && length($1) ) {
1392 $age = time - 86400 * $1;
1394 push @where, FS::cust_main->balance_date_sql($age) . " > $balance";
1398 if ( $params->{'payby'} && scalar(@{ $params->{'payby'} }) ) {
1399 my @payby = map "'$_'", grep /^(\w+)$/, @{ $params->{'payby'} };
1400 push @where, 'payby IN ('. join(',', @payby ). ')';
1404 ##pkgpart, now properly untainted, can be arrayref
1405 #for my $pkgpart ( $params->{'pkgpart'} ) {
1406 # if ( ref $pkgpart ) {
1407 # my $where = join(',', map { /^(\d+)$/ ? $1 : () } @$pkgpart );
1408 # push @where, "cust_pkg.pkgpart IN ($where)" if $where;
1410 # elsif ( $pkgpart =~ /^(\d+)$/ ) {
1411 # push @where, "cust_pkg.pkgpart = $1";
1414 if ( $params->{'pkgpart'} ) {
1415 my @pkgpart = ref( $params->{'pkgpart'} )
1416 ? @{ $params->{'pkgpart'} }
1417 : $params->{'pkgpart'}
1418 ? ( $params->{'pkgpart'} )
1420 @pkgpart = grep /^(\d+)$/, @pkgpart;
1421 push @where, 'cust_pkg.pkgpart IN ('. join(',', @pkgpart ). ')' if @pkgpart;
1425 if ( $params->{'svcnum'} =~ /^(\d+)$/ ) {
1426 push @where, "svcnum = $1";
1430 if ( $params->{'svcpart'} ) {
1431 my @svcpart = ref( $params->{'svcpart'} )
1432 ? @{ $params->{'svcpart'} }
1433 : $params->{'svcpart'}
1434 ? ( $params->{'svcpart'} )
1436 @svcpart = grep /^(\d+)$/, @svcpart;
1437 push @where, 'svcpart IN ('. join(',', @svcpart ). ')' if @svcpart;
1440 if ( $params->{'exportnum'} =~ /^(\d+)$/ ) {
1441 push @from, ' LEFT JOIN export_svc USING ( svcpart )';
1442 push @where, "exportnum = $1";
1445 # # sector and tower
1446 # my @where_sector = $class->tower_sector_sql($params);
1447 # if ( @where_sector ) {
1448 # push @where, @where_sector;
1449 # push @from, ' LEFT JOIN tower_sector USING ( sectornum )';
1452 # here is the agent virtualization
1453 #if ($params->{CurrentUser}) {
1455 # qsearchs('access_user', { username => $params->{CurrentUser} });
1457 # if ($access_user) {
1458 # push @where, $access_user->agentnums_sql('table'=>'cust_main');
1460 # push @where, "1=0";
1463 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql(
1464 'table' => 'cust_main',
1465 'null_right' => 'View/link unlinked services',
1469 push @where, @{ $params->{'where'} } if $params->{'where'};
1471 my $addl_from = join(' ', @from);
1472 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
1474 my $table = $class->table;
1476 my $count_query = "SELECT COUNT(*) FROM $table $addl_from $extra_sql";
1477 #if ( keys %svc_X ) {
1478 # $count_query .= ' WHERE '.
1479 # join(' AND ', map "$_ = ". dbh->quote($svc_X{$_}),
1487 'select' => join(', ',
1490 'cust_main.custnum',
1491 @{ $params->{'addl_select'} || [] },
1492 FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
1494 'addl_from' => $addl_from,
1495 'extra_sql' => $extra_sql,
1496 'order_by' => $params->{'order_by'},
1497 'count_query' => $count_query,
1506 The setfixed method return value.
1508 B<export> method isn't used by insert and replace methods yet.
1512 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
1513 from the base documentation.