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 prereplace_hook_first { ''; }
340 sub predelete_hook { ''; }
341 sub predelete_hook_first { ''; }
343 =item delete [ , OPTION => VALUE ... ]
345 Deletes this account from the database. If there is an error, returns the
346 error, otherwise returns false.
348 The corresponding FS::cust_svc record will be deleted as well.
355 my $export_args = $options{'export_args'} || [];
357 local $SIG{HUP} = 'IGNORE';
358 local $SIG{INT} = 'IGNORE';
359 local $SIG{QUIT} = 'IGNORE';
360 local $SIG{TERM} = 'IGNORE';
361 local $SIG{TSTP} = 'IGNORE';
362 local $SIG{PIPE} = 'IGNORE';
364 my $oldAutoCommit = $FS::UID::AutoCommit;
365 local $FS::UID::AutoCommit = 0;
368 my $error = $self->predelete_hook_first
369 || $self->SUPER::delete
370 || $self->export('delete', @$export_args)
371 || $self->return_inventory
372 || $self->release_router
373 || $self->predelete_hook
374 || $self->cust_svc->delete
377 $dbh->rollback if $oldAutoCommit;
381 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
388 Currently this will only run expire exports if any are attached
393 my($self,$date) = (shift,shift);
395 return 'Expire date must be specified' unless $date;
397 local $SIG{HUP} = 'IGNORE';
398 local $SIG{INT} = 'IGNORE';
399 local $SIG{QUIT} = 'IGNORE';
400 local $SIG{TERM} = 'IGNORE';
401 local $SIG{TSTP} = 'IGNORE';
402 local $SIG{PIPE} = 'IGNORE';
404 my $oldAutoCommit = $FS::UID::AutoCommit;
405 local $FS::UID::AutoCommit = 0;
408 my $export_args = [$date];
409 my $error = $self->export('expire', @$export_args);
411 $dbh->rollback if $oldAutoCommit;
415 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
420 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ]
422 Replaces OLD_RECORD with this one. If there is an error, returns the error,
423 otherwise returns false.
425 Currently available options are: I<child_objects>, I<export_args> and
428 If I<child_objects> is set to an array reference of FS::tablename objects
429 (for example, FS::svc_export_machine or FS::acct_snarf objects), they
430 will have their svcnum field set and will be inserted or replaced after
431 this record, but before any exports are run. Each element of the array
432 can also optionally be a two-element array reference containing the
433 child object and the name of an alternate field to be filled in with
434 the newly-inserted svcnum, for example C<[ $svc_forward, 'srcsvc' ]>
436 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
437 jobnums), all provisioning jobs will have a dependancy on the supplied
438 jobnum(s) (they will not run until the specific job(s) complete(s)).
440 If I<export_args> is set to an array reference, the referenced list will be
441 passed to export commands.
448 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
453 ( ref($_[0]) eq 'HASH' )
457 my $objects = $options->{'child_objects'} || [];
460 local $FS::queue::jobnums = \@jobnums;
461 warn "[$me] replace: set \$FS::queue::jobnums to $FS::queue::jobnums\n"
463 my $depend_jobnums = $options->{'depend_jobnum'} || [];
464 $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
466 local $SIG{HUP} = 'IGNORE';
467 local $SIG{INT} = 'IGNORE';
468 local $SIG{QUIT} = 'IGNORE';
469 local $SIG{TERM} = 'IGNORE';
470 local $SIG{TSTP} = 'IGNORE';
471 local $SIG{PIPE} = 'IGNORE';
473 my $oldAutoCommit = $FS::UID::AutoCommit;
474 local $FS::UID::AutoCommit = 0;
477 my $error = $new->prereplace_hook_first($old)
478 || $new->set_auto_inventory($old)
479 || $new->check; #redundant, but so any duplicate fields are
480 #maniuplated as appropriate (svc_phone.phonenum)
482 $dbh->rollback if $oldAutoCommit;
486 #if ( $old->username ne $new->username || $old->domsvc != $new->domsvc ) {
487 if ( grep { $old->$_ ne $new->$_ } $new->table_dupcheck_fields ) {
489 $new->svcpart( $new->cust_svc->svcpart ) unless $new->svcpart;
490 $error = $new->_check_duplicate;
492 $dbh->rollback if $oldAutoCommit;
497 $error = $new->SUPER::replace($old);
499 $dbh->rollback if $oldAutoCommit;
503 foreach my $object ( @$objects ) {
505 if ( ref($object) eq 'ARRAY' ) {
506 ($obj, $field) = @$object;
511 $obj->$field($new->svcnum);
513 my $oldobj = qsearchs( $obj->table, {
514 $field => $new->svcnum,
515 map { $_ => $obj->$_ } $obj->_svc_child_partfields,
519 my $pkey = $oldobj->primary_key;
520 $obj->$pkey($oldobj->$pkey);
521 $obj->replace($oldobj);
523 $error = $obj->insert;
526 $dbh->rollback if $oldAutoCommit;
532 unless ( $noexport_hack ) {
534 warn "[$me] replace: \$FS::queue::jobnums is $FS::queue::jobnums\n"
537 my $export_args = $options->{'export_args'} || [];
539 #not quite false laziness, but same pattern as FS::svc_acct::replace and
540 #FS::part_export::sqlradius::_export_replace. List::Compare or something
541 #would be useful but too much of a pain in the ass to deploy
543 my @old_part_export = $old->cust_svc->part_svc->part_export;
544 my %old_exportnum = map { $_->exportnum => 1 } @old_part_export;
545 my @new_part_export =
547 ? qsearchs('part_svc', { svcpart=>$new->svcpart } )->part_export
548 : $new->cust_svc->part_svc->part_export;
549 my %new_exportnum = map { $_->exportnum => 1 } @new_part_export;
551 foreach my $delete_part_export (
552 grep { ! $new_exportnum{$_->exportnum} } @old_part_export
554 my $error = $delete_part_export->export_delete($old, @$export_args);
556 $dbh->rollback if $oldAutoCommit;
557 return "error deleting, export to ". $delete_part_export->exporttype.
558 " (transaction rolled back): $error";
562 foreach my $replace_part_export (
563 grep { $old_exportnum{$_->exportnum} } @new_part_export
566 $replace_part_export->export_replace( $new, $old, @$export_args);
568 $dbh->rollback if $oldAutoCommit;
569 return "error exporting to ". $replace_part_export->exporttype.
570 " (transaction rolled back): $error";
574 foreach my $insert_part_export (
575 grep { ! $old_exportnum{$_->exportnum} } @new_part_export
577 my $error = $insert_part_export->export_insert($new, @$export_args );
579 $dbh->rollback if $oldAutoCommit;
580 return "error inserting export to ". $insert_part_export->exporttype.
581 " (transaction rolled back): $error";
585 foreach my $depend_jobnum ( @$depend_jobnums ) {
586 warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
588 foreach my $jobnum ( @jobnums ) {
589 my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
590 warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
592 my $error = $queue->depend_insert($depend_jobnum);
594 $dbh->rollback if $oldAutoCommit;
595 return "error queuing job dependancy: $error";
602 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
608 Sets any fixed fields for this service (see L<FS::part_svc>). If there is an
609 error, returns the error, otherwise returns the FS::part_svc object (use ref()
610 to test the return). Usually called by the check method.
616 $self->setx('F', @_);
621 Sets all fields to their defaults (see L<FS::part_svc>), overriding their
622 current values. If there is an error, returns the error, otherwise returns
623 the FS::part_svc object (use ref() to test the return).
629 $self->setx('D', @_ );
632 =item set_default_and_fixed
636 sub set_default_and_fixed {
638 $self->setx( [ 'D', 'F' ], @_ );
641 =item setx FLAG | FLAG_ARRAYREF , [ CALLBACK_HASHREF ]
643 Sets fields according to the passed in flag or arrayref of flags.
645 Optionally, a hashref of field names and callback coderefs can be passed.
646 If a coderef exists for a given field name, instead of setting the field,
647 the coderef is called with the column value (part_svc_column.columnvalue)
648 as the single parameter.
655 my @x = ref($x) ? @$x : ($x);
656 my $coderef = scalar(@_) ? shift : $self->_fieldhandlers;
659 $self->ut_numbern('svcnum')
661 return $error if $error;
663 my $part_svc = $self->part_svc;
664 return "Unknown svcpart" unless $part_svc;
666 #set default/fixed/whatever fields from part_svc
668 foreach my $part_svc_column (
669 grep { my $f = $_->columnflag; grep { $f eq $_ } @x } #columnflag in @x
670 $part_svc->all_part_svc_column
673 my $columnname = $part_svc_column->columnname;
674 my $columnvalue = $part_svc_column->columnvalue;
676 $columnvalue = &{ $coderef->{$columnname} }( $self, $columnvalue )
677 if exists( $coderef->{$columnname} );
678 $self->setfield( $columnname, $columnvalue );
691 if ( $self->get('svcpart') ) {
692 $svcpart = $self->get('svcpart');
693 } elsif ( $self->svcnum && qsearchs('cust_svc', {'svcnum'=>$self->svcnum}) ) {
694 my $cust_svc = $self->cust_svc;
695 return "Unknown svcnum" unless $cust_svc;
696 $svcpart = $cust_svc->svcpart;
699 qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
705 Returns the FS::svc_pbx record for this service, if any (see L<FS::svc_pbx>).
707 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
712 # XXX FS::h_svc_{acct,phone} could have a history-aware svc_pbx override
716 return '' unless $self->pbxsvc;
717 qsearchs( 'svc_pbx', { 'svcnum' => $self->pbxsvc } );
722 Returns the title of the FS::svc_pbx record associated with this service, if
725 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
732 my $svc_pbx = $self->svc_pbx or return '';
736 =item pbx_select_hash %OPTIONS
738 Can be called as an object method or a class method.
740 Returns a hash SVCNUM => TITLE ... representing the PBXes this customer
741 that may be associated with this service.
743 Currently available options are: I<pkgnum> I<svcpart>
745 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
750 #false laziness w/svc_acct::domain_select_hash
751 sub pbx_select_hash {
752 my ($self, %options) = @_;
758 $part_svc = $self->part_svc;
759 $cust_pkg = $self->cust_svc->cust_pkg
763 $part_svc = qsearchs('part_svc', { 'svcpart' => $options{svcpart} })
764 if $options{'svcpart'};
766 $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $options{pkgnum} })
767 if $options{'pkgnum'};
769 if ($part_svc && ( $part_svc->part_svc_column('pbxsvc')->columnflag eq 'S'
770 || $part_svc->part_svc_column('pbxsvc')->columnflag eq 'F')) {
771 %pbxes = map { $_->svcnum => $_->title }
772 map { qsearchs('svc_pbx', { 'svcnum' => $_ }) }
773 split(',', $part_svc->part_svc_column('pbxsvc')->columnvalue);
774 } elsif ($cust_pkg) { # && !$conf->exists('svc_acct-alldomains') ) {
775 %pbxes = map { $_->svcnum => $_->title }
776 map { qsearchs('svc_pbx', { 'svcnum' => $_->svcnum }) }
777 map { qsearch('cust_svc', { 'pkgnum' => $_->pkgnum } ) }
778 qsearch('cust_pkg', { 'custnum' => $cust_pkg->custnum });
781 %pbxes = map { $_->svcnum => $_->title } qsearch('svc_pbx', {} );
784 if ($part_svc && $part_svc->part_svc_column('pbxsvc')->columnflag eq 'D') {
785 my $svc_pbx = qsearchs('svc_pbx',
786 { 'svcnum' => $part_svc->part_svc_column('pbxsvc')->columnvalue } );
788 $pbxes{$svc_pbx->svcnum} = $svc_pbx->title;
790 warn "unknown svc_pbx.svcnum for part_svc_column pbxsvc: ".
791 $part_svc->part_svc_column('pbxsvc')->columnvalue;
800 =item set_auto_inventory
802 Sets any fields which auto-populate from inventory (see L<FS::part_svc>), and
803 also check any manually populated inventory fields.
805 If there is an error, returns the error, otherwise returns false.
809 sub set_auto_inventory {
810 # don't try to do this during an upgrade
811 return '' if $FS::CurrentUser::upgrade_hack;
814 my $old = @_ ? shift : '';
817 $self->ut_numbern('svcnum')
819 return $error if $error;
821 my $part_svc = $self->part_svc;
822 return "Unkonwn svcpart" unless $part_svc;
824 local $SIG{HUP} = 'IGNORE';
825 local $SIG{INT} = 'IGNORE';
826 local $SIG{QUIT} = 'IGNORE';
827 local $SIG{TERM} = 'IGNORE';
828 local $SIG{TSTP} = 'IGNORE';
829 local $SIG{PIPE} = 'IGNORE';
831 my $oldAutoCommit = $FS::UID::AutoCommit;
832 local $FS::UID::AutoCommit = 0;
835 #set default/fixed/whatever fields from part_svc
836 my $table = $self->table;
837 foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
839 my $part_svc_column = $part_svc->part_svc_column($field);
840 my $columnflag = $part_svc_column->columnflag;
841 next unless $columnflag =~ /^[AM]$/;
843 next if $columnflag eq 'A' && $self->$field() ne '';
845 my $classnum = $part_svc_column->columnvalue;
848 if ( $columnflag eq 'A' && $self->$field() eq '' ) {
849 $hash{'svcnum'} = '';
850 } elsif ( $columnflag eq 'M' ) {
851 return "Select inventory item for $field" unless $self->getfield($field);
852 $hash{'item'} = $self->getfield($field);
853 my $chosen_classnum = $self->getfield($field.'_classnum');
854 if ( grep {$_ == $chosen_classnum} split(',', $classnum) ) {
855 $classnum = $chosen_classnum;
857 # otherwise the chosen classnum is either (all), or somehow not on
858 # the list, so ignore it and choose the first item that's in any
862 my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql(
864 'table' => 'inventory_item',
867 my $inventory_item = qsearchs({
868 'table' => 'inventory_item',
870 'extra_sql' => "AND classnum IN ($classnum) AND $agentnums_sql",
871 'order_by' => 'ORDER BY ( agentnum IS NULL ) '. #agent inventory first
872 ' LIMIT 1 FOR UPDATE',
875 unless ( $inventory_item ) {
876 # should really only be shown if columnflag eq 'A'...
877 $dbh->rollback if $oldAutoCommit;
878 my $message = 'Out of ';
879 my @classnums = split(',', $classnum);
880 foreach ( @classnums ) {
881 my $class = FS::inventory_class->by_key($_)
882 or return "Can't find inventory_class.classnum $_";
883 $message .= PL_N($class->classname);
884 if ( scalar(@classnums) > 2 ) { # english is hard
885 if ( $_ != $classnums[-1] ) {
889 if ( scalar(@classnums) > 1 and $_ == $classnums[-2] ) {
896 next if $columnflag eq 'M' && $inventory_item->svcnum == $self->svcnum;
898 $self->setfield( $field, $inventory_item->item );
899 #if $columnflag eq 'A' && $self->$field() eq '';
901 # release the old inventory item, if there was one
902 if ( $old && $old->$field() && $old->$field() ne $self->$field() ) {
903 my $old_inv = qsearchs({
904 'table' => 'inventory_item',
906 'svcnum' => $old->svcnum,
908 'extra_sql' => "AND classnum IN ($classnum) AND ".
909 '( ( svc_field IS NOT NULL AND svc_field = '.$dbh->quote($field).' )'.
910 ' OR ( svc_field IS NULL AND item = '. dbh->quote($old->$field).' )'.
914 $old_inv->svcnum('');
915 $old_inv->svc_field('');
916 my $oerror = $old_inv->replace;
918 $dbh->rollback if $oldAutoCommit;
919 return "Error unprovisioning inventory: $oerror";
922 warn "old inventory_item not found for $field ". $self->$field;
926 $inventory_item->svcnum( $self->svcnum );
927 $inventory_item->svc_field( $field );
928 my $ierror = $inventory_item->replace();
930 $dbh->rollback if $oldAutoCommit;
931 return "Error provisioning inventory: $ierror";
936 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
942 =item return_inventory
944 Release all inventory items attached to this service's fields. Call
945 when unprovisioning the service.
949 sub return_inventory {
952 local $SIG{HUP} = 'IGNORE';
953 local $SIG{INT} = 'IGNORE';
954 local $SIG{QUIT} = 'IGNORE';
955 local $SIG{TERM} = 'IGNORE';
956 local $SIG{TSTP} = 'IGNORE';
957 local $SIG{PIPE} = 'IGNORE';
959 my $oldAutoCommit = $FS::UID::AutoCommit;
960 local $FS::UID::AutoCommit = 0;
963 foreach my $inventory_item ( $self->inventory_item ) {
964 $inventory_item->svcnum('');
965 $inventory_item->svc_field('');
966 my $error = $inventory_item->replace();
968 $dbh->rollback if $oldAutoCommit;
969 return "Error returning inventory: $error";
973 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
980 Returns the inventory items associated with this svc_ record, as
981 FS::inventory_item objects (see L<FS::inventory_item>.
988 'table' => 'inventory_item',
989 'hashref' => { 'svcnum' => $self->svcnum, },
995 Delete any routers associated with this service. This will release their
996 address blocks, also.
1000 sub release_router {
1002 my @routers = qsearch('router', { svcnum => $self->svcnum });
1003 foreach (@routers) {
1004 my $error = $_->delete;
1005 return "$error (removing router '".$_->routername."')" if $error;
1013 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
1014 object (see L<FS::cust_svc>).
1020 qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
1025 Runs export_suspend callbacks.
1032 my $export_args = $options{'export_args'} || [];
1033 $self->export('suspend', @$export_args);
1038 Runs export_unsuspend callbacks.
1045 my $export_args = $options{'export_args'} || [];
1046 $self->export('unsuspend', @$export_args);
1051 Runs export_links callbacks and returns the links.
1058 $self->export('links', $return);
1062 =item export_getsettings
1064 Runs export_getsettings callbacks and returns the two hashrefs.
1068 sub export_getsettings {
1072 my $error = $self->export('getsettings', \%settings, \%defaults);
1074 warn "error running export_getsetings: $error";
1075 return ( { 'error' => $error }, {} );
1077 ( \%settings, \%defaults );
1080 =item export_getstatus
1082 Runs export_getstatus callbacks and returns a two item list consisting of an
1083 HTML status and a status hashref.
1087 sub export_getstatus {
1091 my $error = $self->export('getstatus', \$html, \%hash);
1093 warn "error running export_getstatus: $error";
1094 return ( '', { 'error' => $error } );
1099 =item export_setstatus
1101 Runs export_setstatus callbacks. If there is an error, returns the error,
1102 otherwise returns false.
1106 sub export_setstatus { shift->_export_setstatus_X('setstatus', @_) }
1107 sub export_setstatus_listadd { shift->_export_setstatus_X('setstatus_listadd', @_) }
1108 sub export_setstatus_listdel { shift->_export_setstatus_X('setstatus_listdel', @_) }
1109 sub export_setstatus_vacationadd { shift->_export_setstatus_X('setstatus_vacationadd', @_) }
1110 sub export_setstatus_vacationdel { shift->_export_setstatus_X('setstatus_vacationdel', @_) }
1112 sub _export_setstatus_X {
1113 my( $self, $method, @args ) = @_;
1114 my $error = $self->export($method, @args);
1116 warn "error running export_$method: $error";
1122 =item export HOOK [ EXPORT_ARGS ]
1124 Runs the provided export hook (i.e. "suspend", "unsuspend") for this service.
1129 my( $self, $method ) = ( shift, shift );
1131 $method = "export_$method" unless $method =~ /^export_/;
1133 local $SIG{HUP} = 'IGNORE';
1134 local $SIG{INT} = 'IGNORE';
1135 local $SIG{QUIT} = 'IGNORE';
1136 local $SIG{TERM} = 'IGNORE';
1137 local $SIG{TSTP} = 'IGNORE';
1138 local $SIG{PIPE} = 'IGNORE';
1140 my $oldAutoCommit = $FS::UID::AutoCommit;
1141 local $FS::UID::AutoCommit = 0;
1145 unless ( $noexport_hack ) {
1146 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
1147 next unless $part_export->can($method);
1148 my $error = $part_export->$method($self, @_);
1150 $dbh->rollback if $oldAutoCommit;
1151 return "error exporting $method event to ". $part_export->exporttype.
1152 " (transaction rolled back): $error";
1157 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1164 Sets or retrieves overlimit date.
1170 #$self->cust_svc->overlimit(@_);
1171 my $cust_svc = $self->cust_svc;
1172 unless ( $cust_svc ) { #wtf?
1173 my $error = "$me overlimit: missing cust_svc record for svc_acct svcnum ".
1175 if ( $overlimit_missing_cust_svc_nonfatal_kludge ) {
1176 cluck "$error; continuing anyway as requested";
1182 $cust_svc->overlimit(@_);
1187 Stub - returns false (no error) so derived classes don't need to define this
1188 methods. Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
1190 This method is called *before* the deletion step which actually deletes the
1191 services. This method should therefore only be used for "pre-deletion"
1192 cancellation steps, if necessary.
1198 =item clone_suspended
1200 Constructor used by FS::part_export::_export_suspend fallback. Stub returning
1201 same object for svc_ classes which don't implement a suspension fallback
1202 (everything except svc_acct at the moment). Document better.
1206 sub clone_suspended {
1210 =item clone_kludge_unsuspend
1212 Constructor used by FS::part_export::_export_unsuspend fallback. Stub returning
1213 same object for svc_ classes which don't implement a suspension fallback
1214 (everything except svc_acct at the moment). Document better.
1218 sub clone_kludge_unsuspend {
1222 =item find_duplicates MODE FIELDS...
1224 Method used by _check_duplicate routines to find services with duplicate
1225 values in specified fields. Set MODE to 'global' to search across all
1226 services, or 'export' to limit to those that share one or more exports
1227 with this service. FIELDS is a list of field names; only services
1228 matching in all fields will be returned. Empty fields will be skipped.
1232 sub find_duplicates {
1237 my %search = map { $_ => $self->getfield($_) }
1238 grep { length($self->getfield($_)) } @fields;
1239 return () if !%search;
1240 my @dup = grep { ! $self->svcnum or $_->svcnum != $self->svcnum }
1241 qsearch( $self->table, \%search );
1243 return @dup if $mode eq 'global';
1244 die "incorrect find_duplicates mode '$mode'" if $mode ne 'export';
1246 my $exports = FS::part_export::export_info($self->table);
1247 my %conflict_svcparts;
1248 my $part_svc = $self->part_svc;
1249 foreach my $part_export ( $part_svc->part_export ) {
1250 %conflict_svcparts = map { $_->svcpart => 1 } $part_export->export_svc;
1252 return grep { $conflict_svcparts{$_->cust_svc->svcpart} } @dup;
1255 =item getstatus_html
1259 sub getstatus_html {
1262 my $part_svc = $self->cust_svc->part_svc;
1266 foreach my $export ( grep $_->can('export_getstatus'), $part_svc->part_export ) {
1267 my $export_html = '';
1269 $export->export_getstatus( $self, \$export_html, \%hash );
1270 $html .= $export_html;
1283 my $conf = new FS::Conf;
1284 return '' unless grep { $self->table eq $_ }
1285 $conf->config('nms-auto_add-svc_ips');
1286 my $ip_field = $self->table_info->{'ip_field'};
1288 my $queue = FS::queue->new( {
1289 'job' => 'FS::NetworkMonitoringSystem::queued_add_router',
1290 'svcnum' => $self->svcnum,
1292 $queue->insert( 'FS::NetworkMonitoringSystem',
1294 $conf->config('nms-auto_add-community')
1303 #XXX not yet implemented
1306 =item search_sql_field FIELD STRING
1308 Class method which returns an SQL fragment to search for STRING in FIELD.
1310 It is now case-insensitive by default.
1314 sub search_sql_field {
1315 my( $class, $field, $string ) = @_;
1316 my $table = $class->table;
1317 my $q_string = dbh->quote($string);
1318 "LOWER($table.$field) = LOWER($q_string)";
1321 #fallback for services that don't provide a search...
1323 #my( $class, $string ) = @_;
1327 =item search HASHREF
1329 Class method which returns a qsearch hash expression to search for parameters
1330 specified in HASHREF.
1336 =item unlinked - set to search for all unlinked services. Overrides all other options.
1346 =item pkgpart - arrayref
1348 =item routernum - arrayref
1350 =item sectornum - arrayref
1352 =item towernum - arrayref
1360 # svc_broadband::search should eventually use this instead
1362 my ($class, $params) = @_;
1365 'LEFT JOIN cust_svc USING ( svcnum )',
1366 'LEFT JOIN part_svc USING ( svcpart )',
1367 'LEFT JOIN cust_pkg USING ( pkgnum )',
1368 FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg'),
1373 $class->_search_svc($params, \@from, \@where) if $class->can('_search_svc');
1376 # if ( $params->{'domain'} ) {
1377 # my $svc_domain = qsearchs('svc_domain', { 'domain'=>$params->{'domain'} } );
1378 # #preserve previous behavior & bubble up an error if $svc_domain not found?
1379 # push @where, 'domsvc = '. $svc_domain->svcnum if $svc_domain;
1383 # if ( $params->{'domsvc'} =~ /^(\d+)$/ ) {
1384 # push @where, "domsvc = $1";
1388 push @where, 'pkgnum IS NULL' if $params->{'unlinked'};
1391 if ( $params->{'agentnum'} =~ /^(\d+)$/ && $1 ) {
1392 push @where, "cust_main.agentnum = $1";
1396 if ( $params->{'custnum'} =~ /^(\d+)$/ && $1 ) {
1397 push @where, "cust_pkg.custnum = $1";
1401 if ( $params->{'cust_status'} =~ /^([a-z]+)$/ ) {
1402 push @where, FS::cust_main->cust_status_sql . " = '$1'";
1406 if ( $params->{'balance'} =~ /^\s*(\-?\d*(\.\d{1,2})?)\s*$/ && length($1) ) {
1410 if ( $params->{'balance_days'} =~ /^\s*(\d*(\.\d{1,3})?)\s*$/ && length($1) ) {
1411 $age = time - 86400 * $1;
1413 push @where, FS::cust_main->balance_date_sql($age) . " > $balance";
1417 if ( $params->{'payby'} && scalar(@{ $params->{'payby'} }) ) {
1418 my @payby = map "'$_'", grep /^(\w+)$/, @{ $params->{'payby'} };
1419 push @where, 'payby IN ('. join(',', @payby ). ')';
1423 ##pkgpart, now properly untainted, can be arrayref
1424 #for my $pkgpart ( $params->{'pkgpart'} ) {
1425 # if ( ref $pkgpart ) {
1426 # my $where = join(',', map { /^(\d+)$/ ? $1 : () } @$pkgpart );
1427 # push @where, "cust_pkg.pkgpart IN ($where)" if $where;
1429 # elsif ( $pkgpart =~ /^(\d+)$/ ) {
1430 # push @where, "cust_pkg.pkgpart = $1";
1433 if ( $params->{'pkgpart'} ) {
1434 my @pkgpart = ref( $params->{'pkgpart'} )
1435 ? @{ $params->{'pkgpart'} }
1436 : $params->{'pkgpart'}
1437 ? ( $params->{'pkgpart'} )
1439 @pkgpart = grep /^(\d+)$/, @pkgpart;
1440 push @where, 'cust_pkg.pkgpart IN ('. join(',', @pkgpart ). ')' if @pkgpart;
1444 if ( $params->{'svcnum'} =~ /^(\d+)$/ ) {
1445 push @where, "svcnum = $1";
1449 if ( $params->{'svcpart'} ) {
1450 my @svcpart = ref( $params->{'svcpart'} )
1451 ? @{ $params->{'svcpart'} }
1452 : $params->{'svcpart'}
1453 ? ( $params->{'svcpart'} )
1455 @svcpart = grep /^(\d+)$/, @svcpart;
1456 push @where, 'svcpart IN ('. join(',', @svcpart ). ')' if @svcpart;
1459 if ( $params->{'exportnum'} =~ /^(\d+)$/ ) {
1460 push @from, ' LEFT JOIN export_svc USING ( svcpart )';
1461 push @where, "exportnum = $1";
1464 # # sector and tower
1465 # my @where_sector = $class->tower_sector_sql($params);
1466 # if ( @where_sector ) {
1467 # push @where, @where_sector;
1468 # push @from, ' LEFT JOIN tower_sector USING ( sectornum )';
1471 # here is the agent virtualization
1472 #if ($params->{CurrentUser}) {
1474 # qsearchs('access_user', { username => $params->{CurrentUser} });
1476 # if ($access_user) {
1477 # push @where, $access_user->agentnums_sql('table'=>'cust_main');
1479 # push @where, "1=0";
1482 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql(
1483 'table' => 'cust_main',
1484 'null_right' => 'View/link unlinked services',
1488 push @where, @{ $params->{'where'} } if $params->{'where'};
1490 my $addl_from = join(' ', @from);
1491 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
1493 my $table = $class->table;
1495 my $count_query = "SELECT COUNT(*) FROM $table $addl_from $extra_sql";
1496 #if ( keys %svc_X ) {
1497 # $count_query .= ' WHERE '.
1498 # join(' AND ', map "$_ = ". dbh->quote($svc_X{$_}),
1506 'select' => join(', ',
1509 'cust_main.custnum',
1510 @{ $params->{'addl_select'} || [] },
1511 FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
1513 'addl_from' => $addl_from,
1514 'extra_sql' => $extra_sql,
1515 'order_by' => $params->{'order_by'},
1516 'count_query' => $count_query,
1525 The setfixed method return value.
1527 B<export> method isn't used by insert and replace methods yet.
1531 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
1532 from the base documentation.