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 prereplace_hook { ''; }
339 sub predelete_hook { ''; }
340 sub predelete_hook_first { ''; }
342 =item delete [ , OPTION => VALUE ... ]
344 Deletes this account from the database. If there is an error, returns the
345 error, otherwise returns false.
347 The corresponding FS::cust_svc record will be deleted as well.
354 my $export_args = $options{'export_args'} || [];
356 local $SIG{HUP} = 'IGNORE';
357 local $SIG{INT} = 'IGNORE';
358 local $SIG{QUIT} = 'IGNORE';
359 local $SIG{TERM} = 'IGNORE';
360 local $SIG{TSTP} = 'IGNORE';
361 local $SIG{PIPE} = 'IGNORE';
363 my $oldAutoCommit = $FS::UID::AutoCommit;
364 local $FS::UID::AutoCommit = 0;
367 my $error = $self->predelete_hook_first
368 || $self->SUPER::delete
369 || $self->export('delete', @$export_args)
370 || $self->return_inventory
371 || $self->release_router
372 || $self->predelete_hook
373 || $self->cust_svc->delete
376 $dbh->rollback if $oldAutoCommit;
380 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
387 Currently this will only run expire exports if any are attached
392 my($self,$date) = (shift,shift);
394 return 'Expire date must be specified' unless $date;
396 local $SIG{HUP} = 'IGNORE';
397 local $SIG{INT} = 'IGNORE';
398 local $SIG{QUIT} = 'IGNORE';
399 local $SIG{TERM} = 'IGNORE';
400 local $SIG{TSTP} = 'IGNORE';
401 local $SIG{PIPE} = 'IGNORE';
403 my $oldAutoCommit = $FS::UID::AutoCommit;
404 local $FS::UID::AutoCommit = 0;
407 my $export_args = [$date];
408 my $error = $self->export('expire', @$export_args);
410 $dbh->rollback if $oldAutoCommit;
414 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
419 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ]
421 Replaces OLD_RECORD with this one. If there is an error, returns the error,
422 otherwise returns false.
424 Currently available options are: I<child_objects>, I<export_args> and
427 If I<child_objects> is set to an array reference of FS::tablename objects
428 (for example, FS::svc_export_machine or FS::acct_snarf objects), they
429 will have their svcnum field set and will be inserted or replaced after
430 this record, but before any exports are run. Each element of the array
431 can also optionally be a two-element array reference containing the
432 child object and the name of an alternate field to be filled in with
433 the newly-inserted svcnum, for example C<[ $svc_forward, 'srcsvc' ]>
435 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
436 jobnums), all provisioning jobs will have a dependancy on the supplied
437 jobnum(s) (they will not run until the specific job(s) complete(s)).
439 If I<export_args> is set to an array reference, the referenced list will be
440 passed to export commands.
447 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
452 ( ref($_[0]) eq 'HASH' )
456 my $objects = $options->{'child_objects'} || [];
459 local $FS::queue::jobnums = \@jobnums;
460 warn "[$me] replace: set \$FS::queue::jobnums to $FS::queue::jobnums\n"
462 my $depend_jobnums = $options->{'depend_jobnum'} || [];
463 $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
465 local $SIG{HUP} = 'IGNORE';
466 local $SIG{INT} = 'IGNORE';
467 local $SIG{QUIT} = 'IGNORE';
468 local $SIG{TERM} = 'IGNORE';
469 local $SIG{TSTP} = 'IGNORE';
470 local $SIG{PIPE} = 'IGNORE';
472 my $oldAutoCommit = $FS::UID::AutoCommit;
473 local $FS::UID::AutoCommit = 0;
476 my $error = $new->prereplace_hook_first($old)
477 || $new->set_auto_inventory($old)
478 || $new->check; #redundant, but so any duplicate fields are
479 #maniuplated as appropriate (svc_phone.phonenum)
481 $dbh->rollback if $oldAutoCommit;
485 #if ( $old->username ne $new->username || $old->domsvc != $new->domsvc ) {
486 if ( grep { $old->$_ ne $new->$_ } $new->table_dupcheck_fields ) {
488 $new->svcpart( $new->cust_svc->svcpart ) unless $new->svcpart;
489 $error = $new->_check_duplicate;
491 $dbh->rollback if $oldAutoCommit;
496 $error = $new->SUPER::replace($old);
498 $dbh->rollback if $oldAutoCommit;
502 foreach my $object ( @$objects ) {
504 if ( ref($object) eq 'ARRAY' ) {
505 ($obj, $field) = @$object;
510 $obj->$field($new->svcnum);
512 my $oldobj = qsearchs( $obj->table, {
513 $field => $new->svcnum,
514 map { $_ => $obj->$_ } $obj->_svc_child_partfields,
518 my $pkey = $oldobj->primary_key;
519 $obj->$pkey($oldobj->$pkey);
520 $obj->replace($oldobj);
522 $error = $obj->insert;
525 $dbh->rollback if $oldAutoCommit;
531 unless ( $noexport_hack ) {
533 warn "[$me] replace: \$FS::queue::jobnums is $FS::queue::jobnums\n"
536 my $export_args = $options->{'export_args'} || [];
538 #not quite false laziness, but same pattern as FS::svc_acct::replace and
539 #FS::part_export::sqlradius::_export_replace. List::Compare or something
540 #would be useful but too much of a pain in the ass to deploy
542 my @old_part_export = $old->cust_svc->part_svc->part_export;
543 my %old_exportnum = map { $_->exportnum => 1 } @old_part_export;
544 my @new_part_export =
546 ? qsearchs('part_svc', { svcpart=>$new->svcpart } )->part_export
547 : $new->cust_svc->part_svc->part_export;
548 my %new_exportnum = map { $_->exportnum => 1 } @new_part_export;
550 foreach my $delete_part_export (
551 grep { ! $new_exportnum{$_->exportnum} } @old_part_export
553 my $error = $delete_part_export->export_delete($old, @$export_args);
555 $dbh->rollback if $oldAutoCommit;
556 return "error deleting, export to ". $delete_part_export->exporttype.
557 " (transaction rolled back): $error";
561 foreach my $replace_part_export (
562 grep { $old_exportnum{$_->exportnum} } @new_part_export
565 $replace_part_export->export_replace( $new, $old, @$export_args);
567 $dbh->rollback if $oldAutoCommit;
568 return "error exporting to ". $replace_part_export->exporttype.
569 " (transaction rolled back): $error";
573 foreach my $insert_part_export (
574 grep { ! $old_exportnum{$_->exportnum} } @new_part_export
576 my $error = $insert_part_export->export_insert($new, @$export_args );
578 $dbh->rollback if $oldAutoCommit;
579 return "error inserting export to ". $insert_part_export->exporttype.
580 " (transaction rolled back): $error";
584 foreach my $depend_jobnum ( @$depend_jobnums ) {
585 warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
587 foreach my $jobnum ( @jobnums ) {
588 my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
589 warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
591 my $error = $queue->depend_insert($depend_jobnum);
593 $dbh->rollback if $oldAutoCommit;
594 return "error queuing job dependancy: $error";
601 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
607 Sets any fixed fields for this service (see L<FS::part_svc>). If there is an
608 error, returns the error, otherwise returns the FS::part_svc object (use ref()
609 to test the return). Usually called by the check method.
615 $self->setx('F', @_);
620 Sets all fields to their defaults (see L<FS::part_svc>), overriding their
621 current values. If there is an error, returns the error, otherwise returns
622 the FS::part_svc object (use ref() to test the return).
628 $self->setx('D', @_ );
631 =item set_default_and_fixed
635 sub set_default_and_fixed {
637 $self->setx( [ 'D', 'F' ], @_ );
640 =item setx FLAG | FLAG_ARRAYREF , [ CALLBACK_HASHREF ]
642 Sets fields according to the passed in flag or arrayref of flags.
644 Optionally, a hashref of field names and callback coderefs can be passed.
645 If a coderef exists for a given field name, instead of setting the field,
646 the coderef is called with the column value (part_svc_column.columnvalue)
647 as the single parameter.
654 my @x = ref($x) ? @$x : ($x);
655 my $coderef = scalar(@_) ? shift : $self->_fieldhandlers;
658 $self->ut_numbern('svcnum')
660 return $error if $error;
662 my $part_svc = $self->part_svc;
663 return "Unknown svcpart" unless $part_svc;
665 #set default/fixed/whatever fields from part_svc
667 foreach my $part_svc_column (
668 grep { my $f = $_->columnflag; grep { $f eq $_ } @x } #columnflag in @x
669 $part_svc->all_part_svc_column
672 my $columnname = $part_svc_column->columnname;
673 my $columnvalue = $part_svc_column->columnvalue;
675 $columnvalue = &{ $coderef->{$columnname} }( $self, $columnvalue )
676 if exists( $coderef->{$columnname} );
677 $self->setfield( $columnname, $columnvalue );
690 if ( $self->get('svcpart') ) {
691 $svcpart = $self->get('svcpart');
692 } elsif ( $self->svcnum && qsearchs('cust_svc', {'svcnum'=>$self->svcnum}) ) {
693 my $cust_svc = $self->cust_svc;
694 return "Unknown svcnum" unless $cust_svc;
695 $svcpart = $cust_svc->svcpart;
698 qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
704 Returns the FS::svc_pbx record for this service, if any (see L<FS::svc_pbx>).
706 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
711 # XXX FS::h_svc_{acct,phone} could have a history-aware svc_pbx override
715 return '' unless $self->pbxsvc;
716 qsearchs( 'svc_pbx', { 'svcnum' => $self->pbxsvc } );
721 Returns the title of the FS::svc_pbx record associated with this service, if
724 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
731 my $svc_pbx = $self->svc_pbx or return '';
735 =item pbx_select_hash %OPTIONS
737 Can be called as an object method or a class method.
739 Returns a hash SVCNUM => TITLE ... representing the PBXes this customer
740 that may be associated with this service.
742 Currently available options are: I<pkgnum> I<svcpart>
744 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
749 #false laziness w/svc_acct::domain_select_hash
750 sub pbx_select_hash {
751 my ($self, %options) = @_;
757 $part_svc = $self->part_svc;
758 $cust_pkg = $self->cust_svc->cust_pkg
762 $part_svc = qsearchs('part_svc', { 'svcpart' => $options{svcpart} })
763 if $options{'svcpart'};
765 $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $options{pkgnum} })
766 if $options{'pkgnum'};
768 if ($part_svc && ( $part_svc->part_svc_column('pbxsvc')->columnflag eq 'S'
769 || $part_svc->part_svc_column('pbxsvc')->columnflag eq 'F')) {
770 %pbxes = map { $_->svcnum => $_->title }
771 map { qsearchs('svc_pbx', { 'svcnum' => $_ }) }
772 split(',', $part_svc->part_svc_column('pbxsvc')->columnvalue);
773 } elsif ($cust_pkg) { # && !$conf->exists('svc_acct-alldomains') ) {
774 %pbxes = map { $_->svcnum => $_->title }
775 map { qsearchs('svc_pbx', { 'svcnum' => $_->svcnum }) }
776 map { qsearch('cust_svc', { 'pkgnum' => $_->pkgnum } ) }
777 qsearch('cust_pkg', { 'custnum' => $cust_pkg->custnum });
780 %pbxes = map { $_->svcnum => $_->title } qsearch('svc_pbx', {} );
783 if ($part_svc && $part_svc->part_svc_column('pbxsvc')->columnflag eq 'D') {
784 my $svc_pbx = qsearchs('svc_pbx',
785 { 'svcnum' => $part_svc->part_svc_column('pbxsvc')->columnvalue } );
787 $pbxes{$svc_pbx->svcnum} = $svc_pbx->title;
789 warn "unknown svc_pbx.svcnum for part_svc_column pbxsvc: ".
790 $part_svc->part_svc_column('pbxsvc')->columnvalue;
799 =item set_auto_inventory
801 Sets any fields which auto-populate from inventory (see L<FS::part_svc>), and
802 also check any manually populated inventory fields.
804 If there is an error, returns the error, otherwise returns false.
808 sub set_auto_inventory {
810 my $old = @_ ? shift : '';
813 $self->ut_numbern('svcnum')
815 return $error if $error;
817 my $part_svc = $self->part_svc;
818 return "Unkonwn svcpart" unless $part_svc;
820 local $SIG{HUP} = 'IGNORE';
821 local $SIG{INT} = 'IGNORE';
822 local $SIG{QUIT} = 'IGNORE';
823 local $SIG{TERM} = 'IGNORE';
824 local $SIG{TSTP} = 'IGNORE';
825 local $SIG{PIPE} = 'IGNORE';
827 my $oldAutoCommit = $FS::UID::AutoCommit;
828 local $FS::UID::AutoCommit = 0;
831 #set default/fixed/whatever fields from part_svc
832 my $table = $self->table;
833 foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
835 my $part_svc_column = $part_svc->part_svc_column($field);
836 my $columnflag = $part_svc_column->columnflag;
837 next unless $columnflag =~ /^[AM]$/;
839 next if $columnflag eq 'A' && $self->$field() ne '';
841 my $classnum = $part_svc_column->columnvalue;
844 if ( $columnflag eq 'A' && $self->$field() eq '' ) {
845 $hash{'svcnum'} = '';
846 } elsif ( $columnflag eq 'M' ) {
847 return "Select inventory item for $field" unless $self->getfield($field);
848 $hash{'item'} = $self->getfield($field);
849 my $chosen_classnum = $self->getfield($field.'_classnum');
850 if ( grep {$_ == $chosen_classnum} split(',', $classnum) ) {
851 $classnum = $chosen_classnum;
853 # otherwise the chosen classnum is either (all), or somehow not on
854 # the list, so ignore it and choose the first item that's in any
858 my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql(
860 'table' => 'inventory_item',
863 my $inventory_item = qsearchs({
864 'table' => 'inventory_item',
866 'extra_sql' => "AND classnum IN ($classnum) AND $agentnums_sql",
867 'order_by' => 'ORDER BY ( agentnum IS NULL ) '. #agent inventory first
868 ' LIMIT 1 FOR UPDATE',
871 unless ( $inventory_item ) {
872 # should really only be shown if columnflag eq 'A'...
873 $dbh->rollback if $oldAutoCommit;
874 my $message = 'Out of ';
875 my @classnums = split(',', $classnum);
876 foreach ( @classnums ) {
877 my $class = FS::inventory_class->by_key($_)
878 or return "Can't find inventory_class.classnum $_";
879 $message .= PL_N($class->classname);
880 if ( scalar(@classnums) > 2 ) { # english is hard
881 if ( $_ != $classnums[-1] ) {
885 if ( scalar(@classnums) > 1 and $_ == $classnums[-2] ) {
892 next if $columnflag eq 'M' && $inventory_item->svcnum == $self->svcnum;
894 $self->setfield( $field, $inventory_item->item );
895 #if $columnflag eq 'A' && $self->$field() eq '';
897 # release the old inventory item, if there was one
898 if ( $old && $old->$field() && $old->$field() ne $self->$field() ) {
899 my $old_inv = qsearchs({
900 'table' => 'inventory_item',
902 'svcnum' => $old->svcnum,
904 'extra_sql' => "AND classnum IN ($classnum) AND ".
905 '( ( svc_field IS NOT NULL AND svc_field = '.$dbh->quote($field).' )'.
906 ' OR ( svc_field IS NULL AND item = '. dbh->quote($old->$field).' )'.
910 $old_inv->svcnum('');
911 $old_inv->svc_field('');
912 my $oerror = $old_inv->replace;
914 $dbh->rollback if $oldAutoCommit;
915 return "Error unprovisioning inventory: $oerror";
918 warn "old inventory_item not found for $field ". $self->$field;
922 $inventory_item->svcnum( $self->svcnum );
923 $inventory_item->svc_field( $field );
924 my $ierror = $inventory_item->replace();
926 $dbh->rollback if $oldAutoCommit;
927 return "Error provisioning inventory: $ierror";
932 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
938 =item return_inventory
940 Release all inventory items attached to this service's fields. Call
941 when unprovisioning the service.
945 sub return_inventory {
948 local $SIG{HUP} = 'IGNORE';
949 local $SIG{INT} = 'IGNORE';
950 local $SIG{QUIT} = 'IGNORE';
951 local $SIG{TERM} = 'IGNORE';
952 local $SIG{TSTP} = 'IGNORE';
953 local $SIG{PIPE} = 'IGNORE';
955 my $oldAutoCommit = $FS::UID::AutoCommit;
956 local $FS::UID::AutoCommit = 0;
959 foreach my $inventory_item ( $self->inventory_item ) {
960 $inventory_item->svcnum('');
961 $inventory_item->svc_field('');
962 my $error = $inventory_item->replace();
964 $dbh->rollback if $oldAutoCommit;
965 return "Error returning inventory: $error";
969 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
976 Returns the inventory items associated with this svc_ record, as
977 FS::inventory_item objects (see L<FS::inventory_item>.
984 'table' => 'inventory_item',
985 'hashref' => { 'svcnum' => $self->svcnum, },
991 Delete any routers associated with this service. This will release their
992 address blocks, also.
998 my @routers = qsearch('router', { svcnum => $self->svcnum });
1000 my $error = $_->delete;
1001 return "$error (removing router '".$_->routername."')" if $error;
1009 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
1010 object (see L<FS::cust_svc>).
1016 qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
1021 Runs export_suspend callbacks.
1028 my $export_args = $options{'export_args'} || [];
1029 $self->export('suspend', @$export_args);
1034 Runs export_unsuspend callbacks.
1041 my $export_args = $options{'export_args'} || [];
1042 $self->export('unsuspend', @$export_args);
1047 Runs export_links callbacks and returns the links.
1054 $self->export('links', $return);
1058 =item export_getsettings
1060 Runs export_getsettings callbacks and returns the two hashrefs.
1064 sub export_getsettings {
1068 my $error = $self->export('getsettings', \%settings, \%defaults);
1070 warn "error running export_getsetings: $error";
1071 return ( { 'error' => $error }, {} );
1073 ( \%settings, \%defaults );
1076 =item export_getstatus
1078 Runs export_getstatus callbacks and returns a two item list consisting of an
1079 HTML status and a status hashref.
1083 sub export_getstatus {
1087 my $error = $self->export('getstatus', \$html, \%hash);
1089 warn "error running export_getstatus: $error";
1090 return ( '', { 'error' => $error } );
1095 =item export_setstatus
1097 Runs export_setstatus callbacks. If there is an error, returns the error,
1098 otherwise returns false.
1102 sub export_setstatus { shift->_export_setstatus_X('setstatus', @_) }
1103 sub export_setstatus_listadd { shift->_export_setstatus_X('setstatus_listadd', @_) }
1104 sub export_setstatus_listdel { shift->_export_setstatus_X('setstatus_listdel', @_) }
1105 sub export_setstatus_vacationadd { shift->_export_setstatus_X('setstatus_vacationadd', @_) }
1106 sub export_setstatus_vacationdel { shift->_export_setstatus_X('setstatus_vacationdel', @_) }
1108 sub _export_setstatus_X {
1109 my( $self, $method, @args ) = @_;
1110 my $error = $self->export($method, @args);
1112 warn "error running export_$method: $error";
1118 =item export HOOK [ EXPORT_ARGS ]
1120 Runs the provided export hook (i.e. "suspend", "unsuspend") for this service.
1125 my( $self, $method ) = ( shift, shift );
1127 $method = "export_$method" unless $method =~ /^export_/;
1129 local $SIG{HUP} = 'IGNORE';
1130 local $SIG{INT} = 'IGNORE';
1131 local $SIG{QUIT} = 'IGNORE';
1132 local $SIG{TERM} = 'IGNORE';
1133 local $SIG{TSTP} = 'IGNORE';
1134 local $SIG{PIPE} = 'IGNORE';
1136 my $oldAutoCommit = $FS::UID::AutoCommit;
1137 local $FS::UID::AutoCommit = 0;
1141 unless ( $noexport_hack ) {
1142 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
1143 next unless $part_export->can($method);
1144 my $error = $part_export->$method($self, @_);
1146 $dbh->rollback if $oldAutoCommit;
1147 return "error exporting $method event to ". $part_export->exporttype.
1148 " (transaction rolled back): $error";
1153 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1160 Sets or retrieves overlimit date.
1166 #$self->cust_svc->overlimit(@_);
1167 my $cust_svc = $self->cust_svc;
1168 unless ( $cust_svc ) { #wtf?
1169 my $error = "$me overlimit: missing cust_svc record for svc_acct svcnum ".
1171 if ( $overlimit_missing_cust_svc_nonfatal_kludge ) {
1172 cluck "$error; continuing anyway as requested";
1178 $cust_svc->overlimit(@_);
1183 Stub - returns false (no error) so derived classes don't need to define this
1184 methods. Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
1186 This method is called *before* the deletion step which actually deletes the
1187 services. This method should therefore only be used for "pre-deletion"
1188 cancellation steps, if necessary.
1194 =item clone_suspended
1196 Constructor used by FS::part_export::_export_suspend fallback. Stub returning
1197 same object for svc_ classes which don't implement a suspension fallback
1198 (everything except svc_acct at the moment). Document better.
1202 sub clone_suspended {
1206 =item clone_kludge_unsuspend
1208 Constructor used by FS::part_export::_export_unsuspend fallback. Stub returning
1209 same object for svc_ classes which don't implement a suspension fallback
1210 (everything except svc_acct at the moment). Document better.
1214 sub clone_kludge_unsuspend {
1218 =item find_duplicates MODE FIELDS...
1220 Method used by _check_duplicate routines to find services with duplicate
1221 values in specified fields. Set MODE to 'global' to search across all
1222 services, or 'export' to limit to those that share one or more exports
1223 with this service. FIELDS is a list of field names; only services
1224 matching in all fields will be returned. Empty fields will be skipped.
1228 sub find_duplicates {
1233 my %search = map { $_ => $self->getfield($_) }
1234 grep { length($self->getfield($_)) } @fields;
1235 return () if !%search;
1236 my @dup = grep { ! $self->svcnum or $_->svcnum != $self->svcnum }
1237 qsearch( $self->table, \%search );
1239 return @dup if $mode eq 'global';
1240 die "incorrect find_duplicates mode '$mode'" if $mode ne 'export';
1242 my $exports = FS::part_export::export_info($self->table);
1243 my %conflict_svcparts;
1244 my $part_svc = $self->part_svc;
1245 foreach my $part_export ( $part_svc->part_export ) {
1246 %conflict_svcparts = map { $_->svcpart => 1 } $part_export->export_svc;
1248 return grep { $conflict_svcparts{$_->cust_svc->svcpart} } @dup;
1251 =item getstatus_html
1255 sub getstatus_html {
1258 my $part_svc = $self->cust_svc->part_svc;
1262 foreach my $export ( grep $_->can('export_getstatus'), $part_svc->part_export ) {
1263 my $export_html = '';
1265 $export->export_getstatus( $self, \$export_html, \%hash );
1266 $html .= $export_html;
1279 my $conf = new FS::Conf;
1280 return '' unless grep { $self->table eq $_ }
1281 $conf->config('nms-auto_add-svc_ips');
1282 my $ip_field = $self->table_info->{'ip_field'};
1284 my $queue = FS::queue->new( {
1285 'job' => 'FS::NetworkMonitoringSystem::queued_add_router',
1286 'svcnum' => $self->svcnum,
1288 $queue->insert( 'FS::NetworkMonitoringSystem',
1290 $conf->config('nms-auto_add-community')
1299 #XXX not yet implemented
1302 =item search_sql_field FIELD STRING
1304 Class method which returns an SQL fragment to search for STRING in FIELD.
1306 It is now case-insensitive by default.
1310 sub search_sql_field {
1311 my( $class, $field, $string ) = @_;
1312 my $table = $class->table;
1313 my $q_string = dbh->quote($string);
1314 "LOWER($table.$field) = LOWER($q_string)";
1317 #fallback for services that don't provide a search...
1319 #my( $class, $string ) = @_;
1323 =item search HASHREF
1325 Class method which returns a qsearch hash expression to search for parameters
1326 specified in HASHREF.
1332 =item unlinked - set to search for all unlinked services. Overrides all other options.
1342 =item pkgpart - arrayref
1344 =item routernum - arrayref
1346 =item sectornum - arrayref
1348 =item towernum - arrayref
1356 # svc_broadband::search should eventually use this instead
1358 my ($class, $params) = @_;
1361 'LEFT JOIN cust_svc USING ( svcnum )',
1362 'LEFT JOIN part_svc USING ( svcpart )',
1363 'LEFT JOIN cust_pkg USING ( pkgnum )',
1364 FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg'),
1369 $class->_search_svc($params, \@from, \@where) if $class->can('_search_svc');
1372 # if ( $params->{'domain'} ) {
1373 # my $svc_domain = qsearchs('svc_domain', { 'domain'=>$params->{'domain'} } );
1374 # #preserve previous behavior & bubble up an error if $svc_domain not found?
1375 # push @where, 'domsvc = '. $svc_domain->svcnum if $svc_domain;
1379 # if ( $params->{'domsvc'} =~ /^(\d+)$/ ) {
1380 # push @where, "domsvc = $1";
1384 push @where, 'pkgnum IS NULL' if $params->{'unlinked'};
1387 if ( $params->{'agentnum'} =~ /^(\d+)$/ && $1 ) {
1388 push @where, "cust_main.agentnum = $1";
1392 if ( $params->{'custnum'} =~ /^(\d+)$/ && $1 ) {
1393 push @where, "custnum = $1";
1397 if ( $params->{'cust_status'} =~ /^([a-z]+)$/ ) {
1398 push @where, FS::cust_main->cust_status_sql . " = '$1'";
1402 if ( $params->{'balance'} =~ /^\s*(\-?\d*(\.\d{1,2})?)\s*$/ && length($1) ) {
1406 if ( $params->{'balance_days'} =~ /^\s*(\d*(\.\d{1,3})?)\s*$/ && length($1) ) {
1407 $age = time - 86400 * $1;
1409 push @where, FS::cust_main->balance_date_sql($age) . " > $balance";
1413 if ( $params->{'payby'} && scalar(@{ $params->{'payby'} }) ) {
1414 my @payby = map "'$_'", grep /^(\w+)$/, @{ $params->{'payby'} };
1415 push @where, 'payby IN ('. join(',', @payby ). ')';
1419 ##pkgpart, now properly untainted, can be arrayref
1420 #for my $pkgpart ( $params->{'pkgpart'} ) {
1421 # if ( ref $pkgpart ) {
1422 # my $where = join(',', map { /^(\d+)$/ ? $1 : () } @$pkgpart );
1423 # push @where, "cust_pkg.pkgpart IN ($where)" if $where;
1425 # elsif ( $pkgpart =~ /^(\d+)$/ ) {
1426 # push @where, "cust_pkg.pkgpart = $1";
1429 if ( $params->{'pkgpart'} ) {
1430 my @pkgpart = ref( $params->{'pkgpart'} )
1431 ? @{ $params->{'pkgpart'} }
1432 : $params->{'pkgpart'}
1433 ? ( $params->{'pkgpart'} )
1435 @pkgpart = grep /^(\d+)$/, @pkgpart;
1436 push @where, 'cust_pkg.pkgpart IN ('. join(',', @pkgpart ). ')' if @pkgpart;
1440 if ( $params->{'svcnum'} =~ /^(\d+)$/ ) {
1441 push @where, "svcnum = $1";
1445 if ( $params->{'svcpart'} ) {
1446 my @svcpart = ref( $params->{'svcpart'} )
1447 ? @{ $params->{'svcpart'} }
1448 : $params->{'svcpart'}
1449 ? ( $params->{'svcpart'} )
1451 @svcpart = grep /^(\d+)$/, @svcpart;
1452 push @where, 'svcpart IN ('. join(',', @svcpart ). ')' if @svcpart;
1455 if ( $params->{'exportnum'} =~ /^(\d+)$/ ) {
1456 push @from, ' LEFT JOIN export_svc USING ( svcpart )';
1457 push @where, "exportnum = $1";
1460 # # sector and tower
1461 # my @where_sector = $class->tower_sector_sql($params);
1462 # if ( @where_sector ) {
1463 # push @where, @where_sector;
1464 # push @from, ' LEFT JOIN tower_sector USING ( sectornum )';
1467 # here is the agent virtualization
1468 #if ($params->{CurrentUser}) {
1470 # qsearchs('access_user', { username => $params->{CurrentUser} });
1472 # if ($access_user) {
1473 # push @where, $access_user->agentnums_sql('table'=>'cust_main');
1475 # push @where, "1=0";
1478 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql(
1479 'table' => 'cust_main',
1480 'null_right' => 'View/link unlinked services',
1484 push @where, @{ $params->{'where'} } if $params->{'where'};
1486 my $addl_from = join(' ', @from);
1487 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
1489 my $table = $class->table;
1491 my $count_query = "SELECT COUNT(*) FROM $table $addl_from $extra_sql";
1492 #if ( keys %svc_X ) {
1493 # $count_query .= ' WHERE '.
1494 # join(' AND ', map "$_ = ". dbh->quote($svc_X{$_}),
1502 'select' => join(', ',
1505 'cust_main.custnum',
1506 @{ $params->{'addl_select'} || [] },
1507 FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
1509 'addl_from' => $addl_from,
1510 'extra_sql' => $extra_sql,
1511 'order_by' => $params->{'order_by'},
1512 'count_query' => $count_query,
1521 The setfixed method return value.
1523 B<export> method isn't used by insert and replace methods yet.
1527 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
1528 from the base documentation.