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;
845 my %hash = ( 'classnum' => $classnum );
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);
854 my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql(
856 'table' => 'inventory_item',
859 my $inventory_item = qsearchs({
860 'table' => 'inventory_item',
862 'extra_sql' => "AND $agentnums_sql",
863 'order_by' => 'ORDER BY ( agentnum IS NULL ) '. #agent inventory first
864 ' LIMIT 1 FOR UPDATE',
867 unless ( $inventory_item ) {
868 $dbh->rollback if $oldAutoCommit;
869 my $inventory_class =
870 qsearchs('inventory_class', { 'classnum' => $classnum } );
871 return "Can't find inventory_class.classnum $classnum"
872 unless $inventory_class;
873 return "Out of ". PL_N($inventory_class->classname);
876 next if $columnflag eq 'M' && $inventory_item->svcnum == $self->svcnum;
878 $self->setfield( $field, $inventory_item->item );
879 #if $columnflag eq 'A' && $self->$field() eq '';
881 if ( $old && $old->$field() && $old->$field() ne $self->$field() ) {
882 my $old_inv = qsearchs({
883 'table' => 'inventory_item',
884 'hashref' => { 'classnum' => $classnum,
885 'svcnum' => $old->svcnum,
887 'extra_sql' => ' AND '.
888 '( ( svc_field IS NOT NULL AND svc_field = '.$dbh->quote($field).' )'.
889 ' OR ( svc_field IS NULL AND item = '. dbh->quote($old->$field).' )'.
893 $old_inv->svcnum('');
894 $old_inv->svc_field('');
895 my $oerror = $old_inv->replace;
897 $dbh->rollback if $oldAutoCommit;
898 return "Error unprovisioning inventory: $oerror";
901 warn "old inventory_item not found for $field ". $self->$field;
905 $inventory_item->svcnum( $self->svcnum );
906 $inventory_item->svc_field( $field );
907 my $ierror = $inventory_item->replace();
909 $dbh->rollback if $oldAutoCommit;
910 return "Error provisioning inventory: $ierror";
915 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
921 =item return_inventory
925 sub return_inventory {
928 local $SIG{HUP} = 'IGNORE';
929 local $SIG{INT} = 'IGNORE';
930 local $SIG{QUIT} = 'IGNORE';
931 local $SIG{TERM} = 'IGNORE';
932 local $SIG{TSTP} = 'IGNORE';
933 local $SIG{PIPE} = 'IGNORE';
935 my $oldAutoCommit = $FS::UID::AutoCommit;
936 local $FS::UID::AutoCommit = 0;
939 foreach my $inventory_item ( $self->inventory_item ) {
940 $inventory_item->svcnum('');
941 $inventory_item->svc_field('');
942 my $error = $inventory_item->replace();
944 $dbh->rollback if $oldAutoCommit;
945 return "Error returning inventory: $error";
949 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
956 Returns the inventory items associated with this svc_ record, as
957 FS::inventory_item objects (see L<FS::inventory_item>.
964 'table' => 'inventory_item',
965 'hashref' => { 'svcnum' => $self->svcnum, },
971 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
972 object (see L<FS::cust_svc>).
978 qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
983 Runs export_suspend callbacks.
990 my $export_args = $options{'export_args'} || [];
991 $self->export('suspend', @$export_args);
996 Runs export_unsuspend callbacks.
1003 my $export_args = $options{'export_args'} || [];
1004 $self->export('unsuspend', @$export_args);
1009 Runs export_links callbacks and returns the links.
1016 $self->export('links', $return);
1020 =item export_getsettings
1022 Runs export_getsettings callbacks and returns the two hashrefs.
1026 sub export_getsettings {
1030 my $error = $self->export('getsettings', \%settings, \%defaults);
1032 warn "error running export_getsetings: $error";
1033 return ( { 'error' => $error }, {} );
1035 ( \%settings, \%defaults );
1038 =item export_getstatus
1040 Runs export_getstatus callbacks and returns a two item list consisting of an
1041 HTML status and a status hashref.
1045 sub export_getstatus {
1049 my $error = $self->export('getstatus', \$html, \%hash);
1051 warn "error running export_getstatus: $error";
1052 return ( '', { 'error' => $error } );
1057 =item export_setstatus
1059 Runs export_setstatus callbacks. If there is an error, returns the error,
1060 otherwise returns false.
1064 sub export_setstatus { shift->_export_setstatus_X('setstatus', @_) }
1065 sub export_setstatus_listadd { shift->_export_setstatus_X('setstatus_listadd', @_) }
1066 sub export_setstatus_listdel { shift->_export_setstatus_X('setstatus_listdel', @_) }
1067 sub export_setstatus_vacationadd { shift->_export_setstatus_X('setstatus_vacationadd', @_) }
1068 sub export_setstatus_vacationdel { shift->_export_setstatus_X('setstatus_vacationdel', @_) }
1070 sub _export_setstatus_X {
1071 my( $self, $method, @args ) = @_;
1072 my $error = $self->export($method, @args);
1074 warn "error running export_$method: $error";
1080 =item export HOOK [ EXPORT_ARGS ]
1082 Runs the provided export hook (i.e. "suspend", "unsuspend") for this service.
1087 my( $self, $method ) = ( shift, shift );
1089 $method = "export_$method" unless $method =~ /^export_/;
1091 local $SIG{HUP} = 'IGNORE';
1092 local $SIG{INT} = 'IGNORE';
1093 local $SIG{QUIT} = 'IGNORE';
1094 local $SIG{TERM} = 'IGNORE';
1095 local $SIG{TSTP} = 'IGNORE';
1096 local $SIG{PIPE} = 'IGNORE';
1098 my $oldAutoCommit = $FS::UID::AutoCommit;
1099 local $FS::UID::AutoCommit = 0;
1103 unless ( $noexport_hack ) {
1104 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
1105 next unless $part_export->can($method);
1106 my $error = $part_export->$method($self, @_);
1108 $dbh->rollback if $oldAutoCommit;
1109 return "error exporting $method event to ". $part_export->exporttype.
1110 " (transaction rolled back): $error";
1115 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1122 Sets or retrieves overlimit date.
1128 #$self->cust_svc->overlimit(@_);
1129 my $cust_svc = $self->cust_svc;
1130 unless ( $cust_svc ) { #wtf?
1131 my $error = "$me overlimit: missing cust_svc record for svc_acct svcnum ".
1133 if ( $overlimit_missing_cust_svc_nonfatal_kludge ) {
1134 cluck "$error; continuing anyway as requested";
1140 $cust_svc->overlimit(@_);
1145 Stub - returns false (no error) so derived classes don't need to define this
1146 methods. Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
1148 This method is called *before* the deletion step which actually deletes the
1149 services. This method should therefore only be used for "pre-deletion"
1150 cancellation steps, if necessary.
1156 =item clone_suspended
1158 Constructor used by FS::part_export::_export_suspend fallback. Stub returning
1159 same object for svc_ classes which don't implement a suspension fallback
1160 (everything except svc_acct at the moment). Document better.
1164 sub clone_suspended {
1168 =item clone_kludge_unsuspend
1170 Constructor used by FS::part_export::_export_unsuspend fallback. Stub returning
1171 same object for svc_ classes which don't implement a suspension fallback
1172 (everything except svc_acct at the moment). Document better.
1176 sub clone_kludge_unsuspend {
1180 =item find_duplicates MODE FIELDS...
1182 Method used by _check_duplicate routines to find services with duplicate
1183 values in specified fields. Set MODE to 'global' to search across all
1184 services, or 'export' to limit to those that share one or more exports
1185 with this service. FIELDS is a list of field names; only services
1186 matching in all fields will be returned. Empty fields will be skipped.
1190 sub find_duplicates {
1195 my %search = map { $_ => $self->getfield($_) }
1196 grep { length($self->getfield($_)) } @fields;
1197 return () if !%search;
1198 my @dup = grep { ! $self->svcnum or $_->svcnum != $self->svcnum }
1199 qsearch( $self->table, \%search );
1201 return @dup if $mode eq 'global';
1202 die "incorrect find_duplicates mode '$mode'" if $mode ne 'export';
1204 my $exports = FS::part_export::export_info($self->table);
1205 my %conflict_svcparts;
1206 my $part_svc = $self->part_svc;
1207 foreach my $part_export ( $part_svc->part_export ) {
1208 %conflict_svcparts = map { $_->svcpart => 1 } $part_export->export_svc;
1210 return grep { $conflict_svcparts{$_->cust_svc->svcpart} } @dup;
1213 =item getstatus_html
1217 sub getstatus_html {
1220 my $part_svc = $self->cust_svc->part_svc;
1224 foreach my $export ( grep $_->can('export_getstatus'), $part_svc->part_export ) {
1225 my $export_html = '';
1227 $export->export_getstatus( $self, \$export_html, \%hash );
1228 $html .= $export_html;
1241 my $conf = new FS::Conf;
1242 return '' unless grep { $self->table eq $_ }
1243 $conf->config('nms-auto_add-svc_ips');
1244 my $ip_field = $self->table_info->{'ip_field'};
1246 my $queue = FS::queue->new( {
1247 'job' => 'FS::NetworkMonitoringSystem::queued_add_router',
1248 'svcnum' => $self->svcnum,
1250 $queue->insert( 'FS::NetworkMonitoringSystem',
1252 $conf->config('nms-auto_add-community')
1261 #XXX not yet implemented
1264 =item search_sql_field FIELD STRING
1266 Class method which returns an SQL fragment to search for STRING in FIELD.
1268 It is now case-insensitive by default.
1272 sub search_sql_field {
1273 my( $class, $field, $string ) = @_;
1274 my $table = $class->table;
1275 my $q_string = dbh->quote($string);
1276 "LOWER($table.$field) = LOWER($q_string)";
1279 #fallback for services that don't provide a search...
1281 #my( $class, $string ) = @_;
1285 =item search HASHREF
1287 Class method which returns a qsearch hash expression to search for parameters
1288 specified in HASHREF.
1294 =item unlinked - set to search for all unlinked services. Overrides all other options.
1304 =item pkgpart - arrayref
1306 =item routernum - arrayref
1308 =item sectornum - arrayref
1310 =item towernum - arrayref
1318 # based on FS::svc_acct::search, both that and svc_broadband::search should
1319 # eventually use this instead
1321 my ($class, $params) = @_;
1324 'LEFT JOIN cust_svc USING ( svcnum )',
1325 'LEFT JOIN part_svc USING ( svcpart )',
1326 'LEFT JOIN cust_pkg USING ( pkgnum )',
1327 FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg'),
1333 # if ( $params->{'domain'} ) {
1334 # my $svc_domain = qsearchs('svc_domain', { 'domain'=>$params->{'domain'} } );
1335 # #preserve previous behavior & bubble up an error if $svc_domain not found?
1336 # push @where, 'domsvc = '. $svc_domain->svcnum if $svc_domain;
1340 # if ( $params->{'domsvc'} =~ /^(\d+)$/ ) {
1341 # push @where, "domsvc = $1";
1345 push @where, 'pkgnum IS NULL' if $params->{'unlinked'};
1348 if ( $params->{'agentnum'} =~ /^(\d+)$/ && $1 ) {
1349 push @where, "cust_main.agentnum = $1";
1353 if ( $params->{'custnum'} =~ /^(\d+)$/ && $1 ) {
1354 push @where, "custnum = $1";
1358 if ( $params->{'cust_status'} =~ /^([a-z]+)$/ ) {
1359 push @where, FS::cust_main->cust_status_sql . " = '$1'";
1363 if ( $params->{'balance'} =~ /^\s*(\-?\d*(\.\d{1,2})?)\s*$/ && length($1) ) {
1367 if ( $params->{'balance_days'} =~ /^\s*(\d*(\.\d{1,3})?)\s*$/ && length($1) ) {
1368 $age = time - 86400 * $1;
1370 push @where, FS::cust_main->balance_date_sql($age) . " > $balance";
1374 if ( $params->{'payby'} && scalar(@{ $params->{'payby'} }) ) {
1375 my @payby = map "'$_'", grep /^(\w+)$/, @{ $params->{'payby'} };
1376 push @where, 'payby IN ('. join(',', @payby ). ')';
1380 if ( $params->{'pkgpart'} && scalar(@{ $params->{'pkgpart'} }) ) {
1381 my @pkgpart = grep /^(\d+)$/, @{ $params->{'pkgpart'} };
1382 push @where, 'cust_pkg.pkgpart IN ('. join(',', @pkgpart ). ')';
1386 if ( $params->{'svcpart'} && scalar(@{ $params->{'svcpart'} }) ) {
1387 my @svcpart = grep /^(\d+)$/, @{ $params->{'svcpart'} };
1388 push @where, 'svcpart IN ('. join(',', @svcpart ). ')';
1391 if ( $params->{'exportnum'} =~ /^(\d+)$/ ) {
1392 push @from, ' LEFT JOIN export_svc USING ( svcpart )';
1393 push @where, "exportnum = $1";
1396 # # sector and tower
1397 # my @where_sector = $class->tower_sector_sql($params);
1398 # if ( @where_sector ) {
1399 # push @where, @where_sector;
1400 # push @from, ' LEFT JOIN tower_sector USING ( sectornum )';
1403 # here is the agent virtualization
1404 #if ($params->{CurrentUser}) {
1406 # qsearchs('access_user', { username => $params->{CurrentUser} });
1408 # if ($access_user) {
1409 # push @where, $access_user->agentnums_sql('table'=>'cust_main');
1411 # push @where, "1=0";
1414 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql(
1415 'table' => 'cust_main',
1416 'null_right' => 'View/link unlinked services',
1420 push @where, @{ $params->{'where'} } if $params->{'where'};
1422 my $addl_from = join(' ', @from);
1423 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
1425 my $table = $class->table;
1427 my $count_query = "SELECT COUNT(*) FROM $table $addl_from $extra_sql";
1428 #if ( keys %svc_X ) {
1429 # $count_query .= ' WHERE '.
1430 # join(' AND ', map "$_ = ". dbh->quote($svc_X{$_}),
1438 'select' => join(', ',
1441 'cust_main.custnum',
1442 @{ $params->{'addl_select'} || [] },
1443 FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
1445 'addl_from' => $addl_from,
1446 'extra_sql' => $extra_sql,
1447 'order_by' => $params->{'order_by'},
1448 'count_query' => $count_query,
1457 The setfixed method return value.
1459 B<export> method isn't used by insert and replace methods yet.
1463 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
1464 from the base documentation.