1 package FS::svc_Common;
2 use base qw( FS::cust_main_Mixin FS::Record );
5 use vars qw( $noexport_hack $DEBUG $me
6 $overlimit_missing_cust_svc_nonfatal_kludge );
7 use Carp qw( cluck carp croak confess ); #specify cluck have to specify them all
8 use Scalar::Util qw( blessed );
9 use Lingua::EN::Inflect qw( PL_N );
11 use FS::Record qw( qsearch qsearchs fields dbh );
16 use FS::inventory_item;
17 use FS::inventory_class;
18 use FS::NetworkMonitoringSystem;
20 $me = '[FS::svc_Common]';
23 $overlimit_missing_cust_svc_nonfatal_kludge = 0;
27 FS::svc_Common - Object method for all svc_ records
31 package svc_myservice;
32 use base qw( FS::svc_Common );
36 FS::svc_Common is intended as a base class for table-specific classes to
37 inherit from, i.e. FS::svc_acct. FS::svc_Common inherits from FS::Record.
49 my $class = ref($proto) || $proto;
51 bless ($self, $class);
53 unless ( defined ( $self->table ) ) {
54 $self->{'Table'} = shift;
55 carp "warning: FS::Record::new called with table name ". $self->{'Table'};
58 #$self->{'Hash'} = shift;
60 $self->{'Hash'} = { map { $_ => $newhash->{$_} } qw(svcnum svcpart) };
62 $self->setdefault( $self->_fieldhandlers )
65 $self->{'Hash'}{$_} = $newhash->{$_}
66 foreach grep { defined($newhash->{$_}) && length($newhash->{$_}) }
69 foreach my $field ( grep !defined($self->{'Hash'}{$_}), $self->fields ) {
70 $self->{'Hash'}{$field}='';
73 $self->_rebless if $self->can('_rebless');
75 $self->{'modified'} = 0;
77 $self->_cache($self->{'Hash'}, shift) if $self->can('_cache') && @_;
83 sub _fieldhandlers { {}; }
87 # This restricts the fields based on part_svc_column and the svcpart of
88 # the service. There are four possible cases:
89 # 1. svcpart passed as part of the svc_x hash.
90 # 2. svcpart fetched via cust_svc based on svcnum.
91 # 3. No svcnum or svcpart. In this case, return ALL the fields with
92 # dbtable eq $self->table.
93 # 4. Called via "fields('svc_acct')" or something similar. In this case
94 # there is no $self object.
98 my @vfields = $self->SUPER::virtual_fields;
100 return @vfields unless (ref $self); # Case 4
102 if ($self->svcpart) { # Case 1
103 $svcpart = $self->svcpart;
104 } elsif ( $self->svcnum
105 && qsearchs('cust_svc',{'svcnum'=>$self->svcnum} )
107 $svcpart = $self->cust_svc->svcpart;
112 if ($svcpart) { #Cases 1 and 2
113 my %flags = map { $_->columnname, $_->columnflag } (
114 qsearch ('part_svc_column', { svcpart => $svcpart } )
116 return grep { not ( defined($flags{$_}) && $flags{$_} eq 'X') } @vfields;
125 svc_Common provides a fallback label subroutine that just returns the svcnum.
131 cluck "warning: ". ref($self). " not loaded or missing label method; ".
143 (($self->cust_svc || return)->cust_pkg || return)->cust_main || return
148 defined($self->cust_main);
153 Checks the validity of fields in this record.
155 At present, this does nothing but call FS::Record::check (which, in turn,
156 does nothing but run virtual field checks).
165 =item insert [ , OPTION => VALUE ... ]
167 Adds this record to the database. If there is an error, returns the error,
168 otherwise returns false.
170 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
171 defined. An FS::cust_svc record will be created and inserted.
173 Currently available options are: I<jobnums>, I<child_objects> and
176 If I<jobnum> is set to an array reference, the jobnums of any export jobs will
177 be added to the referenced array.
179 If I<child_objects> is set to an array reference of FS::tablename objects
180 (for example, FS::svc_export_machine or FS::acct_snarf objects), they
181 will have their svcnum field set and will be inserted after this record,
182 but before any exports are run. Each element of the array can also
183 optionally be a two-element array reference containing the child object
184 and the name of an alternate field to be filled in with the newly-inserted
185 svcnum, for example C<[ $svc_forward, 'srcsvc' ]>
187 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
188 jobnums), all provisioning jobs will have a dependancy on the supplied
189 jobnum(s) (they will not run until the specific job(s) complete(s)).
191 If I<export_args> is set to an array reference, the referenced list will be
192 passed to export commands.
199 warn "[$me] insert called with options ".
200 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
204 local $FS::queue::jobnums = \@jobnums;
205 warn "[$me] insert: set \$FS::queue::jobnums to $FS::queue::jobnums\n"
207 my $objects = $options{'child_objects'} || [];
208 my $depend_jobnums = $options{'depend_jobnum'} || [];
209 $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
211 local $SIG{HUP} = 'IGNORE';
212 local $SIG{INT} = 'IGNORE';
213 local $SIG{QUIT} = 'IGNORE';
214 local $SIG{TERM} = 'IGNORE';
215 local $SIG{TSTP} = 'IGNORE';
216 local $SIG{PIPE} = 'IGNORE';
218 my $oldAutoCommit = $FS::UID::AutoCommit;
219 local $FS::UID::AutoCommit = 0;
222 my $svcnum = $self->svcnum;
223 my $cust_svc = $svcnum ? qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) : '';
224 my $inserted_cust_svc = 0;
225 #unless ( $svcnum ) {
226 if ( !$svcnum or !$cust_svc ) {
227 $cust_svc = new FS::cust_svc ( {
228 #hua?# 'svcnum' => $svcnum,
229 'svcnum' => $self->svcnum,
230 'pkgnum' => $self->pkgnum,
231 'svcpart' => $self->svcpart,
233 my $error = $cust_svc->insert;
235 $dbh->rollback if $oldAutoCommit;
238 $inserted_cust_svc = 1;
239 $svcnum = $self->svcnum($cust_svc->svcnum);
241 #$cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
242 unless ( $cust_svc ) {
243 $dbh->rollback if $oldAutoCommit;
244 return "no cust_svc record found for svcnum ". $self->svcnum;
246 $self->pkgnum($cust_svc->pkgnum);
247 $self->svcpart($cust_svc->svcpart);
250 my $error = $self->preinsert_hook_first
251 || $self->set_auto_inventory
253 || $self->_check_duplicate
254 || $self->preinsert_hook
255 || $self->SUPER::insert;
257 if ( $inserted_cust_svc ) {
258 my $derror = $cust_svc->delete;
259 die $derror if $derror;
261 $dbh->rollback if $oldAutoCommit;
265 foreach my $object ( @$objects ) {
267 if ( ref($object) eq 'ARRAY' ) {
268 ($obj, $field) = @$object;
273 $obj->$field($self->svcnum);
274 $error = $obj->insert;
276 $dbh->rollback if $oldAutoCommit;
282 unless ( $noexport_hack ) {
284 warn "[$me] insert: \$FS::queue::jobnums is $FS::queue::jobnums\n"
287 my $export_args = $options{'export_args'} || [];
289 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
290 my $error = $part_export->export_insert($self, @$export_args);
292 $dbh->rollback if $oldAutoCommit;
293 return "exporting to ". $part_export->exporttype.
294 " (transaction rolled back): $error";
298 foreach my $depend_jobnum ( @$depend_jobnums ) {
299 warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
301 foreach my $jobnum ( @jobnums ) {
302 my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
303 warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
305 my $error = $queue->depend_insert($depend_jobnum);
307 $dbh->rollback if $oldAutoCommit;
308 return "error queuing job dependancy: $error";
315 my $nms_ip_error = $self->nms_ip_insert;
316 if ( $nms_ip_error ) {
317 $dbh->rollback if $oldAutoCommit;
318 return "error queuing IP insert: $nms_ip_error";
321 if ( exists $options{'jobnums'} ) {
322 push @{ $options{'jobnums'} }, @jobnums;
325 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
331 sub preinsert_hook_first { ''; }
332 sub _check_duplcate { ''; }
333 sub preinsert_hook { ''; }
334 sub table_dupcheck_fields { (); }
335 sub prereplace_hook { ''; }
336 sub prereplace_hook_first { ''; }
337 sub predelete_hook { ''; }
338 sub predelete_hook_first { ''; }
340 =item delete [ , OPTION => VALUE ... ]
342 Deletes this account from the database. If there is an error, returns the
343 error, otherwise returns false.
345 The corresponding FS::cust_svc record will be deleted as well.
352 my $export_args = $options{'export_args'} || [];
354 local $SIG{HUP} = 'IGNORE';
355 local $SIG{INT} = 'IGNORE';
356 local $SIG{QUIT} = 'IGNORE';
357 local $SIG{TERM} = 'IGNORE';
358 local $SIG{TSTP} = 'IGNORE';
359 local $SIG{PIPE} = 'IGNORE';
361 my $oldAutoCommit = $FS::UID::AutoCommit;
362 local $FS::UID::AutoCommit = 0;
365 my $error = $self->predelete_hook_first
366 || $self->SUPER::delete
367 || $self->export('delete', @$export_args)
368 || $self->return_inventory
369 || $self->release_router
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->prereplace_hook_first($old)
475 || $new->set_auto_inventory($old)
476 || $new->check; #redundant, but so any duplicate fields are
477 #maniuplated as appropriate (svc_phone.phonenum)
479 $dbh->rollback if $oldAutoCommit;
483 #if ( $old->username ne $new->username || $old->domsvc != $new->domsvc ) {
484 if ( grep { $old->$_ ne $new->$_ } $new->table_dupcheck_fields ) {
486 $new->svcpart( $new->cust_svc->svcpart ) unless $new->svcpart;
487 $error = $new->_check_duplicate;
489 $dbh->rollback if $oldAutoCommit;
494 $error = $new->SUPER::replace($old);
496 $dbh->rollback if $oldAutoCommit;
500 foreach my $object ( @$objects ) {
502 if ( ref($object) eq 'ARRAY' ) {
503 ($obj, $field) = @$object;
508 $obj->$field($new->svcnum);
510 my $oldobj = qsearchs( $obj->table, {
511 $field => $new->svcnum,
512 map { $_ => $obj->$_ } $obj->_svc_child_partfields,
516 my $pkey = $oldobj->primary_key;
517 $obj->$pkey($oldobj->$pkey);
518 $obj->replace($oldobj);
520 $error = $obj->insert;
523 $dbh->rollback if $oldAutoCommit;
529 unless ( $noexport_hack ) {
531 warn "[$me] replace: \$FS::queue::jobnums is $FS::queue::jobnums\n"
534 my $export_args = $options->{'export_args'} || [];
536 #not quite false laziness, but same pattern as FS::svc_acct::replace and
537 #FS::part_export::sqlradius::_export_replace. List::Compare or something
538 #would be useful but too much of a pain in the ass to deploy
540 my @old_part_export = $old->cust_svc->part_svc->part_export;
541 my %old_exportnum = map { $_->exportnum => 1 } @old_part_export;
542 my @new_part_export =
544 ? qsearchs('part_svc', { svcpart=>$new->svcpart } )->part_export
545 : $new->cust_svc->part_svc->part_export;
546 my %new_exportnum = map { $_->exportnum => 1 } @new_part_export;
548 foreach my $delete_part_export (
549 grep { ! $new_exportnum{$_->exportnum} } @old_part_export
551 my $error = $delete_part_export->export_delete($old, @$export_args);
553 $dbh->rollback if $oldAutoCommit;
554 return "error deleting, export to ". $delete_part_export->exporttype.
555 " (transaction rolled back): $error";
559 foreach my $replace_part_export (
560 grep { $old_exportnum{$_->exportnum} } @new_part_export
563 $replace_part_export->export_replace( $new, $old, @$export_args);
565 $dbh->rollback if $oldAutoCommit;
566 return "error exporting to ". $replace_part_export->exporttype.
567 " (transaction rolled back): $error";
571 foreach my $insert_part_export (
572 grep { ! $old_exportnum{$_->exportnum} } @new_part_export
574 my $error = $insert_part_export->export_insert($new, @$export_args );
576 $dbh->rollback if $oldAutoCommit;
577 return "error inserting export to ". $insert_part_export->exporttype.
578 " (transaction rolled back): $error";
582 foreach my $depend_jobnum ( @$depend_jobnums ) {
583 warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
585 foreach my $jobnum ( @jobnums ) {
586 my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
587 warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
589 my $error = $queue->depend_insert($depend_jobnum);
591 $dbh->rollback if $oldAutoCommit;
592 return "error queuing job dependancy: $error";
599 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
605 Sets any fixed fields for this service (see L<FS::part_svc>). If there is an
606 error, returns the error, otherwise returns the FS::part_svc object (use ref()
607 to test the return). Usually called by the check method.
613 $self->setx('F', @_);
618 Sets all fields to their defaults (see L<FS::part_svc>), overriding their
619 current values. If there is an error, returns the error, otherwise returns
620 the FS::part_svc object (use ref() to test the return).
626 $self->setx('D', @_ );
629 =item set_default_and_fixed
633 sub set_default_and_fixed {
635 $self->setx( [ 'D', 'F' ], @_ );
638 =item setx FLAG | FLAG_ARRAYREF , [ CALLBACK_HASHREF ]
640 Sets fields according to the passed in flag or arrayref of flags.
642 Optionally, a hashref of field names and callback coderefs can be passed.
643 If a coderef exists for a given field name, instead of setting the field,
644 the coderef is called with the column value (part_svc_column.columnvalue)
645 as the single parameter.
652 my @x = ref($x) ? @$x : ($x);
653 my $coderef = scalar(@_) ? shift : $self->_fieldhandlers;
656 $self->ut_numbern('svcnum')
658 return $error if $error;
660 my $part_svc = $self->part_svc;
661 return "Unknown svcpart" unless $part_svc;
663 #set default/fixed/whatever fields from part_svc
665 foreach my $part_svc_column (
666 grep { my $f = $_->columnflag; grep { $f eq $_ } @x } #columnflag in @x
667 $part_svc->all_part_svc_column
670 my $columnname = $part_svc_column->columnname;
671 my $columnvalue = $part_svc_column->columnvalue;
673 $columnvalue = &{ $coderef->{$columnname} }( $self, $columnvalue )
674 if exists( $coderef->{$columnname} );
675 $self->setfield( $columnname, $columnvalue );
688 if ( $self->get('svcpart') ) {
689 $svcpart = $self->get('svcpart');
690 } elsif ( $self->svcnum && qsearchs('cust_svc', {'svcnum'=>$self->svcnum}) ) {
691 my $cust_svc = $self->cust_svc;
692 return "Unknown svcnum" unless $cust_svc;
693 $svcpart = $cust_svc->svcpart;
696 qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
702 Returns the FS::svc_pbx record for this service, if any (see L<FS::svc_pbx>).
704 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
709 # XXX FS::h_svc_{acct,phone} could have a history-aware svc_pbx override
713 return '' unless $self->pbxsvc;
714 qsearchs( 'svc_pbx', { 'svcnum' => $self->pbxsvc } );
719 Returns the title of the FS::svc_pbx record associated with this service, if
722 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
729 my $svc_pbx = $self->svc_pbx or return '';
733 =item pbx_select_hash %OPTIONS
735 Can be called as an object method or a class method.
737 Returns a hash SVCNUM => TITLE ... representing the PBXes this customer
738 that may be associated with this service.
740 Currently available options are: I<pkgnum> I<svcpart>
742 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
747 #false laziness w/svc_acct::domain_select_hash
748 sub pbx_select_hash {
749 my ($self, %options) = @_;
755 $part_svc = $self->part_svc;
756 $cust_pkg = $self->cust_svc->cust_pkg
760 $part_svc = qsearchs('part_svc', { 'svcpart' => $options{svcpart} })
761 if $options{'svcpart'};
763 $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $options{pkgnum} })
764 if $options{'pkgnum'};
766 if ($part_svc && ( $part_svc->part_svc_column('pbxsvc')->columnflag eq 'S'
767 || $part_svc->part_svc_column('pbxsvc')->columnflag eq 'F')) {
768 %pbxes = map { $_->svcnum => $_->title }
769 map { qsearchs('svc_pbx', { 'svcnum' => $_ }) }
770 split(',', $part_svc->part_svc_column('pbxsvc')->columnvalue);
771 } elsif ($cust_pkg) { # && !$conf->exists('svc_acct-alldomains') ) {
772 %pbxes = map { $_->svcnum => $_->title }
773 map { qsearchs('svc_pbx', { 'svcnum' => $_->svcnum }) }
774 map { qsearch('cust_svc', { 'pkgnum' => $_->pkgnum } ) }
775 qsearch('cust_pkg', { 'custnum' => $cust_pkg->custnum });
778 %pbxes = map { $_->svcnum => $_->title } qsearch('svc_pbx', {} );
781 if ($part_svc && $part_svc->part_svc_column('pbxsvc')->columnflag eq 'D') {
782 my $svc_pbx = qsearchs('svc_pbx',
783 { 'svcnum' => $part_svc->part_svc_column('pbxsvc')->columnvalue } );
785 $pbxes{$svc_pbx->svcnum} = $svc_pbx->title;
787 warn "unknown svc_pbx.svcnum for part_svc_column pbxsvc: ".
788 $part_svc->part_svc_column('pbxsvc')->columnvalue;
797 =item set_auto_inventory
799 Sets any fields which auto-populate from inventory (see L<FS::part_svc>), and
800 also check any manually populated inventory fields.
802 If there is an error, returns the error, otherwise returns false.
806 sub set_auto_inventory {
807 # don't try to do this during an upgrade
808 return '' if $FS::CurrentUser::upgrade_hack;
811 my $old = @_ ? shift : '';
814 $self->ut_numbern('svcnum')
816 return $error if $error;
818 my $part_svc = $self->part_svc;
819 return "Unkonwn svcpart" unless $part_svc;
821 local $SIG{HUP} = 'IGNORE';
822 local $SIG{INT} = 'IGNORE';
823 local $SIG{QUIT} = 'IGNORE';
824 local $SIG{TERM} = 'IGNORE';
825 local $SIG{TSTP} = 'IGNORE';
826 local $SIG{PIPE} = 'IGNORE';
828 my $oldAutoCommit = $FS::UID::AutoCommit;
829 local $FS::UID::AutoCommit = 0;
832 #set default/fixed/whatever fields from part_svc
833 my $table = $self->table;
834 foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
836 my $part_svc_column = $part_svc->part_svc_column($field);
837 my $columnflag = $part_svc_column->columnflag;
838 next unless $columnflag =~ /^[AM]$/;
840 next if $columnflag eq 'A' && $self->$field() ne '';
842 my $classnum = $part_svc_column->columnvalue;
845 if ( $columnflag eq 'A' && $self->$field() eq '' ) {
846 $hash{'svcnum'} = '';
847 } elsif ( $columnflag eq 'M' ) {
848 return "Select inventory item for $field" unless $self->getfield($field);
849 $hash{'item'} = $self->getfield($field);
850 my $chosen_classnum = $self->getfield($field.'_classnum');
851 if ( grep {$_ == $chosen_classnum} split(',', $classnum) ) {
852 $classnum = $chosen_classnum;
854 # otherwise the chosen classnum is either (all), or somehow not on
855 # the list, so ignore it and choose the first item that's in any
859 my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql(
861 'table' => 'inventory_item',
864 my $inventory_item = qsearchs({
865 'table' => 'inventory_item',
867 'extra_sql' => "AND classnum IN ($classnum) AND $agentnums_sql",
868 'order_by' => 'ORDER BY ( agentnum IS NULL ) '. #agent inventory first
869 ' LIMIT 1 FOR UPDATE',
872 unless ( $inventory_item ) {
873 # should really only be shown if columnflag eq 'A'...
874 $dbh->rollback if $oldAutoCommit;
875 my $message = 'Out of ';
876 my @classnums = split(',', $classnum);
877 foreach ( @classnums ) {
878 my $class = FS::inventory_class->by_key($_)
879 or return "Can't find inventory_class.classnum $_";
880 $message .= PL_N($class->classname);
881 if ( scalar(@classnums) > 2 ) { # english is hard
882 if ( $_ != $classnums[-1] ) {
886 if ( scalar(@classnums) > 1 and $_ == $classnums[-2] ) {
893 next if $columnflag eq 'M' && $inventory_item->svcnum == $self->svcnum;
895 $self->setfield( $field, $inventory_item->item );
896 #if $columnflag eq 'A' && $self->$field() eq '';
898 # release the old inventory item, if there was one
899 if ( $old && $old->$field() && $old->$field() ne $self->$field() ) {
900 my $old_inv = qsearchs({
901 'table' => 'inventory_item',
903 'svcnum' => $old->svcnum,
905 'extra_sql' => "AND classnum IN ($classnum) AND ".
906 '( ( svc_field IS NOT NULL AND svc_field = '.$dbh->quote($field).' )'.
907 ' OR ( svc_field IS NULL AND item = '. dbh->quote($old->$field).' )'.
911 $old_inv->svcnum('');
912 $old_inv->svc_field('');
913 my $oerror = $old_inv->replace;
915 $dbh->rollback if $oldAutoCommit;
916 return "Error unprovisioning inventory: $oerror";
919 warn "old inventory_item not found for $field ". $self->$field;
923 $inventory_item->svcnum( $self->svcnum );
924 $inventory_item->svc_field( $field );
925 my $ierror = $inventory_item->replace();
927 $dbh->rollback if $oldAutoCommit;
928 return "Error provisioning inventory: $ierror";
933 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
939 =item return_inventory
941 Release all inventory items attached to this service's fields. Call
942 when unprovisioning the service.
946 sub return_inventory {
949 local $SIG{HUP} = 'IGNORE';
950 local $SIG{INT} = 'IGNORE';
951 local $SIG{QUIT} = 'IGNORE';
952 local $SIG{TERM} = 'IGNORE';
953 local $SIG{TSTP} = 'IGNORE';
954 local $SIG{PIPE} = 'IGNORE';
956 my $oldAutoCommit = $FS::UID::AutoCommit;
957 local $FS::UID::AutoCommit = 0;
960 foreach my $inventory_item ( $self->inventory_item ) {
961 $inventory_item->svcnum('');
962 $inventory_item->svc_field('');
963 my $error = $inventory_item->replace();
965 $dbh->rollback if $oldAutoCommit;
966 return "Error returning inventory: $error";
970 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
977 Returns the inventory items associated with this svc_ record, as
978 FS::inventory_item objects (see L<FS::inventory_item>.
985 'table' => 'inventory_item',
986 'hashref' => { 'svcnum' => $self->svcnum, },
992 Delete any routers associated with this service. This will release their
993 address blocks, also.
999 my @routers = qsearch('router', { svcnum => $self->svcnum });
1000 foreach (@routers) {
1001 my $error = $_->delete;
1002 return "$error (removing router '".$_->routername."')" if $error;
1010 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
1011 object (see L<FS::cust_svc>).
1015 Runs export_suspend callbacks.
1022 my $export_args = $options{'export_args'} || [];
1023 $self->export('suspend', @$export_args);
1028 Runs export_unsuspend callbacks.
1035 my $export_args = $options{'export_args'} || [];
1036 $self->export('unsuspend', @$export_args);
1041 Runs export_links callbacks and returns the links.
1048 $self->export('links', $return);
1052 =item export_getsettings
1054 Runs export_getsettings callbacks and returns the two hashrefs.
1058 sub export_getsettings {
1062 my $error = $self->export('getsettings', \%settings, \%defaults);
1064 warn "error running export_getsetings: $error";
1065 return ( { 'error' => $error }, {} );
1067 ( \%settings, \%defaults );
1070 =item export_getstatus
1072 Runs export_getstatus callbacks and returns a two item list consisting of an
1073 HTML status and a status hashref.
1077 sub export_getstatus {
1081 my $error = $self->export('getstatus', \$html, \%hash);
1083 warn "error running export_getstatus: $error";
1084 return ( '', { 'error' => $error } );
1089 =item export_setstatus
1091 Runs export_setstatus callbacks. If there is an error, returns the error,
1092 otherwise returns false.
1096 sub export_setstatus { shift->_export_setstatus_X('setstatus', @_) }
1097 sub export_setstatus_listadd { shift->_export_setstatus_X('setstatus_listadd', @_) }
1098 sub export_setstatus_listdel { shift->_export_setstatus_X('setstatus_listdel', @_) }
1099 sub export_setstatus_vacationadd { shift->_export_setstatus_X('setstatus_vacationadd', @_) }
1100 sub export_setstatus_vacationdel { shift->_export_setstatus_X('setstatus_vacationdel', @_) }
1102 sub _export_setstatus_X {
1103 my( $self, $method, @args ) = @_;
1104 my $error = $self->export($method, @args);
1106 warn "error running export_$method: $error";
1112 =item export HOOK [ EXPORT_ARGS ]
1114 Runs the provided export hook (i.e. "suspend", "unsuspend") for this service.
1119 my( $self, $method ) = ( shift, shift );
1121 $method = "export_$method" unless $method =~ /^export_/;
1123 local $SIG{HUP} = 'IGNORE';
1124 local $SIG{INT} = 'IGNORE';
1125 local $SIG{QUIT} = 'IGNORE';
1126 local $SIG{TERM} = 'IGNORE';
1127 local $SIG{TSTP} = 'IGNORE';
1128 local $SIG{PIPE} = 'IGNORE';
1130 my $oldAutoCommit = $FS::UID::AutoCommit;
1131 local $FS::UID::AutoCommit = 0;
1135 unless ( $noexport_hack ) {
1136 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
1137 next unless $part_export->can($method);
1138 my $error = $part_export->$method($self, @_);
1140 $dbh->rollback if $oldAutoCommit;
1141 return "error exporting $method event to ". $part_export->exporttype.
1142 " (transaction rolled back): $error";
1147 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1154 Sets or retrieves overlimit date.
1160 #$self->cust_svc->overlimit(@_);
1161 my $cust_svc = $self->cust_svc;
1162 unless ( $cust_svc ) { #wtf?
1163 my $error = "$me overlimit: missing cust_svc record for svc_acct svcnum ".
1165 if ( $overlimit_missing_cust_svc_nonfatal_kludge ) {
1166 cluck "$error; continuing anyway as requested";
1172 $cust_svc->overlimit(@_);
1177 Stub - returns false (no error) so derived classes don't need to define this
1178 methods. Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
1180 This method is called *before* the deletion step which actually deletes the
1181 services. This method should therefore only be used for "pre-deletion"
1182 cancellation steps, if necessary.
1188 =item clone_suspended
1190 Constructor used by FS::part_export::_export_suspend fallback. Stub returning
1191 same object for svc_ classes which don't implement a suspension fallback
1192 (everything except svc_acct at the moment). Document better.
1196 sub clone_suspended {
1200 =item clone_kludge_unsuspend
1202 Constructor used by FS::part_export::_export_unsuspend fallback. Stub returning
1203 same object for svc_ classes which don't implement a suspension fallback
1204 (everything except svc_acct at the moment). Document better.
1208 sub clone_kludge_unsuspend {
1212 =item find_duplicates MODE FIELDS...
1214 Method used by _check_duplicate routines to find services with duplicate
1215 values in specified fields. Set MODE to 'global' to search across all
1216 services, or 'export' to limit to those that share one or more exports
1217 with this service. FIELDS is a list of field names; only services
1218 matching in all fields will be returned. Empty fields will be skipped.
1222 sub find_duplicates {
1227 my %search = map { $_ => $self->getfield($_) }
1228 grep { length($self->getfield($_)) } @fields;
1229 return () if !%search;
1230 my @dup = grep { ! $self->svcnum or $_->svcnum != $self->svcnum }
1231 qsearch( $self->table, \%search );
1233 return @dup if $mode eq 'global';
1234 die "incorrect find_duplicates mode '$mode'" if $mode ne 'export';
1236 my $exports = FS::part_export::export_info($self->table);
1237 my %conflict_svcparts;
1238 my $part_svc = $self->part_svc;
1239 foreach my $part_export ( $part_svc->part_export ) {
1240 %conflict_svcparts = map { $_->svcpart => 1 } $part_export->export_svc;
1242 return grep { $conflict_svcparts{$_->cust_svc->svcpart} } @dup;
1245 =item getstatus_html
1249 sub getstatus_html {
1252 my $part_svc = $self->cust_svc->part_svc;
1256 foreach my $export ( grep $_->can('export_getstatus'), $part_svc->part_export ) {
1257 my $export_html = '';
1259 $export->export_getstatus( $self, \$export_html, \%hash );
1260 $html .= $export_html;
1273 my $conf = new FS::Conf;
1274 return '' unless grep { $self->table eq $_ }
1275 $conf->config('nms-auto_add-svc_ips');
1276 my $ip_field = $self->table_info->{'ip_field'};
1278 my $queue = FS::queue->new( {
1279 'job' => 'FS::NetworkMonitoringSystem::queued_add_router',
1280 'svcnum' => $self->svcnum,
1282 $queue->insert( 'FS::NetworkMonitoringSystem',
1284 $conf->config('nms-auto_add-community')
1293 #XXX not yet implemented
1296 =item search_sql_field FIELD STRING
1298 Class method which returns an SQL fragment to search for STRING in FIELD.
1300 It is now case-insensitive by default.
1304 sub search_sql_field {
1305 my( $class, $field, $string ) = @_;
1306 my $table = $class->table;
1307 my $q_string = dbh->quote($string);
1308 "LOWER($table.$field) = LOWER($q_string)";
1311 #fallback for services that don't provide a search...
1313 #my( $class, $string ) = @_;
1317 =item search HASHREF
1319 Class method which returns a qsearch hash expression to search for parameters
1320 specified in HASHREF.
1326 =item unlinked - set to search for all unlinked services. Overrides all other options.
1336 =item pkgpart - arrayref
1338 =item routernum - arrayref
1340 =item sectornum - arrayref
1342 =item towernum - arrayref
1350 # svc_broadband::search should eventually use this instead
1352 my ($class, $params) = @_;
1355 'LEFT JOIN cust_svc USING ( svcnum )',
1356 'LEFT JOIN part_svc USING ( svcpart )',
1357 'LEFT JOIN cust_pkg USING ( pkgnum )',
1358 FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg'),
1363 $class->_search_svc($params, \@from, \@where) if $class->can('_search_svc');
1366 # if ( $params->{'domain'} ) {
1367 # my $svc_domain = qsearchs('svc_domain', { 'domain'=>$params->{'domain'} } );
1368 # #preserve previous behavior & bubble up an error if $svc_domain not found?
1369 # push @where, 'domsvc = '. $svc_domain->svcnum if $svc_domain;
1373 # if ( $params->{'domsvc'} =~ /^(\d+)$/ ) {
1374 # push @where, "domsvc = $1";
1378 push @where, 'pkgnum IS NULL' if $params->{'unlinked'};
1381 if ( $params->{'agentnum'} =~ /^(\d+)$/ && $1 ) {
1382 push @where, "cust_main.agentnum = $1";
1386 if ( $params->{'custnum'} =~ /^(\d+)$/ && $1 ) {
1387 push @where, "custnum = $1";
1391 if ( $params->{'cust_status'} =~ /^([a-z]+)$/ ) {
1392 push @where, FS::cust_main->cust_status_sql . " = '$1'";
1396 if ( $params->{'balance'} =~ /^\s*(\-?\d*(\.\d{1,2})?)\s*$/ && length($1) ) {
1400 if ( $params->{'balance_days'} =~ /^\s*(\d*(\.\d{1,3})?)\s*$/ && length($1) ) {
1401 $age = time - 86400 * $1;
1403 push @where, FS::cust_main->balance_date_sql($age) . " > $balance";
1407 if ( $params->{'payby'} && scalar(@{ $params->{'payby'} }) ) {
1408 my @payby = map "'$_'", grep /^(\w+)$/, @{ $params->{'payby'} };
1409 push @where, 'payby IN ('. join(',', @payby ). ')';
1413 ##pkgpart, now properly untainted, can be arrayref
1414 #for my $pkgpart ( $params->{'pkgpart'} ) {
1415 # if ( ref $pkgpart ) {
1416 # my $where = join(',', map { /^(\d+)$/ ? $1 : () } @$pkgpart );
1417 # push @where, "cust_pkg.pkgpart IN ($where)" if $where;
1419 # elsif ( $pkgpart =~ /^(\d+)$/ ) {
1420 # push @where, "cust_pkg.pkgpart = $1";
1423 if ( $params->{'pkgpart'} ) {
1424 my @pkgpart = ref( $params->{'pkgpart'} )
1425 ? @{ $params->{'pkgpart'} }
1426 : $params->{'pkgpart'}
1427 ? ( $params->{'pkgpart'} )
1429 @pkgpart = grep /^(\d+)$/, @pkgpart;
1430 push @where, 'cust_pkg.pkgpart IN ('. join(',', @pkgpart ). ')' if @pkgpart;
1434 if ( $params->{'svcnum'} =~ /^(\d+)$/ ) {
1435 push @where, "svcnum = $1";
1439 if ( $params->{'svcpart'} ) {
1440 my @svcpart = ref( $params->{'svcpart'} )
1441 ? @{ $params->{'svcpart'} }
1442 : $params->{'svcpart'}
1443 ? ( $params->{'svcpart'} )
1445 @svcpart = grep /^(\d+)$/, @svcpart;
1446 push @where, 'svcpart IN ('. join(',', @svcpart ). ')' if @svcpart;
1449 if ( $params->{'exportnum'} =~ /^(\d+)$/ ) {
1450 push @from, ' LEFT JOIN export_svc USING ( svcpart )';
1451 push @where, "exportnum = $1";
1454 # # sector and tower
1455 # my @where_sector = $class->tower_sector_sql($params);
1456 # if ( @where_sector ) {
1457 # push @where, @where_sector;
1458 # push @from, ' LEFT JOIN tower_sector USING ( sectornum )';
1461 # here is the agent virtualization
1462 #if ($params->{CurrentUser}) {
1464 # qsearchs('access_user', { username => $params->{CurrentUser} });
1466 # if ($access_user) {
1467 # push @where, $access_user->agentnums_sql('table'=>'cust_main');
1469 # push @where, "1=0";
1472 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql(
1473 'table' => 'cust_main',
1474 'null_right' => 'View/link unlinked services',
1478 push @where, @{ $params->{'where'} } if $params->{'where'};
1480 my $addl_from = join(' ', @from);
1481 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
1483 my $table = $class->table;
1485 my $count_query = "SELECT COUNT(*) FROM $table $addl_from $extra_sql";
1486 #if ( keys %svc_X ) {
1487 # $count_query .= ' WHERE '.
1488 # join(' AND ', map "$_ = ". dbh->quote($svc_X{$_}),
1496 'select' => join(', ',
1499 'cust_main.custnum',
1500 @{ $params->{'addl_select'} || [] },
1501 FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
1503 'addl_from' => $addl_from,
1504 'extra_sql' => $extra_sql,
1505 'order_by' => $params->{'order_by'},
1506 'count_query' => $count_query,
1515 The setfixed method return value.
1517 B<export> method isn't used by insert and replace methods yet.
1521 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
1522 from the base documentation.