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 Only checks fields marked as required in table_info or
159 part_svc_column definition. Should be invoked by service-specific
160 check using SUPER. Invokes FS::Record::check using SUPER.
167 ## Checking required fields
169 # get fields marked as required in table_info
172 my $tinfo = $self->can('table_info') ? $self->table_info : {};
173 if ($tinfo->{'manual_require'}) {
174 my $fields = $tinfo->{'fields'} || {};
175 foreach my $field (keys %$fields) {
176 if (ref($fields->{$field}) && $fields->{$field}->{'required'}) {
177 $required->{$field} = 1;
178 $labels->{$field} = $fields->{$field}->{'label'};
181 # add fields marked as required in database
183 qsearch('part_svc_column',{
184 'svcpart' => $self->svcpart,
188 $required->{$column->columnname} = 1;
189 $labels->{$column->columnname} = $column->columnlabel;
191 # do the actual checking
192 foreach my $field (keys %$required) {
193 unless (length($self->get($field)) > 0) {
194 my $name = $labels->{$field} || $field;
195 return "$name is required\n"
203 =item insert [ , OPTION => VALUE ... ]
205 Adds this record to the database. If there is an error, returns the error,
206 otherwise returns false.
208 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
209 defined. An FS::cust_svc record will be created and inserted.
211 Currently available options are: I<jobnums>, I<child_objects> and
214 If I<jobnum> is set to an array reference, the jobnums of any export jobs will
215 be added to the referenced array.
217 If I<child_objects> is set to an array reference of FS::tablename objects
218 (for example, FS::svc_export_machine or FS::acct_snarf objects), they
219 will have their svcnum field set and will be inserted after this record,
220 but before any exports are run. Each element of the array can also
221 optionally be a two-element array reference containing the child object
222 and the name of an alternate field to be filled in with the newly-inserted
223 svcnum, for example C<[ $svc_forward, 'srcsvc' ]>
225 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
226 jobnums), all provisioning jobs will have a dependancy on the supplied
227 jobnum(s) (they will not run until the specific job(s) complete(s)).
229 If I<export_args> is set to an array reference, the referenced list will be
230 passed to export commands.
237 warn "[$me] insert called with options ".
238 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
242 local $FS::queue::jobnums = \@jobnums;
243 warn "[$me] insert: set \$FS::queue::jobnums to $FS::queue::jobnums\n"
245 my $objects = $options{'child_objects'} || [];
246 my $depend_jobnums = $options{'depend_jobnum'} || [];
247 $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
249 local $SIG{HUP} = 'IGNORE';
250 local $SIG{INT} = 'IGNORE';
251 local $SIG{QUIT} = 'IGNORE';
252 local $SIG{TERM} = 'IGNORE';
253 local $SIG{TSTP} = 'IGNORE';
254 local $SIG{PIPE} = 'IGNORE';
256 my $oldAutoCommit = $FS::UID::AutoCommit;
257 local $FS::UID::AutoCommit = 0;
260 my $svcnum = $self->svcnum;
261 my $cust_svc = $svcnum ? qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) : '';
262 my $inserted_cust_svc = 0;
263 #unless ( $svcnum ) {
264 if ( !$svcnum or !$cust_svc ) {
265 $cust_svc = new FS::cust_svc ( {
266 #hua?# 'svcnum' => $svcnum,
267 'svcnum' => $self->svcnum,
268 'pkgnum' => $self->pkgnum,
269 'svcpart' => $self->svcpart,
271 my $error = $cust_svc->insert;
273 $dbh->rollback if $oldAutoCommit;
276 $inserted_cust_svc = 1;
277 $svcnum = $self->svcnum($cust_svc->svcnum);
279 #$cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
280 unless ( $cust_svc ) {
281 $dbh->rollback if $oldAutoCommit;
282 return "no cust_svc record found for svcnum ". $self->svcnum;
284 $self->pkgnum($cust_svc->pkgnum);
285 $self->svcpart($cust_svc->svcpart);
288 my $error = $self->preinsert_hook_first(%options)
289 || $self->set_auto_inventory
291 || $self->_check_duplicate
292 || $self->preinsert_hook
293 || $self->SUPER::insert;
295 if ( $inserted_cust_svc ) {
296 my $derror = $cust_svc->delete;
297 die $derror if $derror;
299 $dbh->rollback if $oldAutoCommit;
303 foreach my $object ( @$objects ) {
305 if ( ref($object) eq 'ARRAY' ) {
306 ($obj, $field) = @$object;
311 $obj->$field($self->svcnum);
312 $error = $obj->insert;
314 $dbh->rollback if $oldAutoCommit;
320 unless ( $noexport_hack ) {
322 warn "[$me] insert: \$FS::queue::jobnums is $FS::queue::jobnums\n"
325 my $export_args = $options{'export_args'} || [];
327 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
328 my $error = $part_export->export_insert($self, @$export_args);
330 $dbh->rollback if $oldAutoCommit;
331 return "exporting to ". $part_export->exporttype.
332 " (transaction rolled back): $error";
336 foreach my $depend_jobnum ( @$depend_jobnums ) {
337 warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
339 foreach my $jobnum ( @jobnums ) {
340 my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
341 warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
343 my $error = $queue->depend_insert($depend_jobnum);
345 $dbh->rollback if $oldAutoCommit;
346 return "error queuing job dependancy: $error";
353 my $nms_ip_error = $self->nms_ip_insert;
354 if ( $nms_ip_error ) {
355 $dbh->rollback if $oldAutoCommit;
356 return "error queuing IP insert: $nms_ip_error";
359 if ( exists $options{'jobnums'} ) {
360 push @{ $options{'jobnums'} }, @jobnums;
363 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
369 sub preinsert_hook_first { ''; }
370 sub _check_duplcate { ''; }
371 sub preinsert_hook { ''; }
372 sub table_dupcheck_fields { (); }
373 sub prereplace_hook { ''; }
374 sub prereplace_hook_first { ''; }
375 sub predelete_hook { ''; }
376 sub predelete_hook_first { ''; }
378 =item delete [ , OPTION => VALUE ... ]
380 Deletes this account from the database. If there is an error, returns the
381 error, otherwise returns false.
383 The corresponding FS::cust_svc record will be deleted as well.
390 my $export_args = $options{'export_args'} || [];
392 local $SIG{HUP} = 'IGNORE';
393 local $SIG{INT} = 'IGNORE';
394 local $SIG{QUIT} = 'IGNORE';
395 local $SIG{TERM} = 'IGNORE';
396 local $SIG{TSTP} = 'IGNORE';
397 local $SIG{PIPE} = 'IGNORE';
399 my $oldAutoCommit = $FS::UID::AutoCommit;
400 local $FS::UID::AutoCommit = 0;
403 my $error = $self->predelete_hook_first
404 || $self->SUPER::delete
405 || $self->export('delete', @$export_args)
406 || $self->return_inventory
407 || $self->release_router
408 || $self->predelete_hook
409 || $self->cust_svc->delete
412 $dbh->rollback if $oldAutoCommit;
416 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
423 Currently this will only run expire exports if any are attached
428 my($self,$date) = (shift,shift);
430 return 'Expire date must be specified' unless $date;
432 local $SIG{HUP} = 'IGNORE';
433 local $SIG{INT} = 'IGNORE';
434 local $SIG{QUIT} = 'IGNORE';
435 local $SIG{TERM} = 'IGNORE';
436 local $SIG{TSTP} = 'IGNORE';
437 local $SIG{PIPE} = 'IGNORE';
439 my $oldAutoCommit = $FS::UID::AutoCommit;
440 local $FS::UID::AutoCommit = 0;
443 my $export_args = [$date];
444 my $error = $self->export('expire', @$export_args);
446 $dbh->rollback if $oldAutoCommit;
450 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
455 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ]
457 Replaces OLD_RECORD with this one. If there is an error, returns the error,
458 otherwise returns false.
460 Currently available options are: I<child_objects>, I<export_args> and
463 If I<child_objects> is set to an array reference of FS::tablename objects
464 (for example, FS::svc_export_machine or FS::acct_snarf objects), they
465 will have their svcnum field set and will be inserted or replaced after
466 this record, but before any exports are run. Each element of the array
467 can also optionally be a two-element array reference containing the
468 child object and the name of an alternate field to be filled in with
469 the newly-inserted svcnum, for example C<[ $svc_forward, 'srcsvc' ]>
471 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
472 jobnums), all provisioning jobs will have a dependancy on the supplied
473 jobnum(s) (they will not run until the specific job(s) complete(s)).
475 If I<export_args> is set to an array reference, the referenced list will be
476 passed to export commands.
482 $noexport_hack = $new->no_export if $new->no_export;
484 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
489 ( ref($_[0]) eq 'HASH' )
493 my $objects = $options->{'child_objects'} || [];
496 local $FS::queue::jobnums = \@jobnums;
497 warn "[$me] replace: set \$FS::queue::jobnums to $FS::queue::jobnums\n"
499 my $depend_jobnums = $options->{'depend_jobnum'} || [];
500 $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
502 local $SIG{HUP} = 'IGNORE';
503 local $SIG{INT} = 'IGNORE';
504 local $SIG{QUIT} = 'IGNORE';
505 local $SIG{TERM} = 'IGNORE';
506 local $SIG{TSTP} = 'IGNORE';
507 local $SIG{PIPE} = 'IGNORE';
509 my $oldAutoCommit = $FS::UID::AutoCommit;
510 local $FS::UID::AutoCommit = 0;
513 my $error = $new->prereplace_hook_first($old)
514 || $new->set_auto_inventory($old)
515 || $new->check; #redundant, but so any duplicate fields are
516 #maniuplated as appropriate (svc_phone.phonenum)
518 $dbh->rollback if $oldAutoCommit;
522 #if ( $old->username ne $new->username || $old->domsvc != $new->domsvc ) {
523 if ( grep { $old->$_ ne $new->$_ } $new->table_dupcheck_fields ) {
525 $new->svcpart( $new->cust_svc->svcpart ) unless $new->svcpart;
526 $error = $new->_check_duplicate;
528 $dbh->rollback if $oldAutoCommit;
533 $error = $new->SUPER::replace($old);
535 $dbh->rollback if $oldAutoCommit;
539 foreach my $object ( @$objects ) {
541 if ( ref($object) eq 'ARRAY' ) {
542 ($obj, $field) = @$object;
547 $obj->$field($new->svcnum);
549 my $oldobj = qsearchs( $obj->table, {
550 $field => $new->svcnum,
551 map { $_ => $obj->$_ } $obj->_svc_child_partfields,
555 my $pkey = $oldobj->primary_key;
556 $obj->$pkey($oldobj->$pkey);
557 $obj->replace($oldobj);
559 $error = $obj->insert;
562 $dbh->rollback if $oldAutoCommit;
568 unless ( $noexport_hack ) {
570 warn "[$me] replace: \$FS::queue::jobnums is $FS::queue::jobnums\n"
573 my $export_args = $options->{'export_args'} || [];
575 #not quite false laziness, but same pattern as FS::svc_acct::replace and
576 #FS::part_export::sqlradius::_export_replace. List::Compare or something
577 #would be useful but too much of a pain in the ass to deploy
579 my @old_part_export = $old->cust_svc->part_svc->part_export;
580 my %old_exportnum = map { $_->exportnum => 1 } @old_part_export;
581 my @new_part_export =
583 ? qsearchs('part_svc', { svcpart=>$new->svcpart } )->part_export
584 : $new->cust_svc->part_svc->part_export;
585 my %new_exportnum = map { $_->exportnum => 1 } @new_part_export;
587 foreach my $delete_part_export (
588 grep { ! $new_exportnum{$_->exportnum} } @old_part_export
590 my $error = $delete_part_export->export_delete($old, @$export_args);
592 $dbh->rollback if $oldAutoCommit;
593 return "error deleting, export to ". $delete_part_export->exporttype.
594 " (transaction rolled back): $error";
598 foreach my $replace_part_export (
599 grep { $old_exportnum{$_->exportnum} } @new_part_export
602 $replace_part_export->export_replace( $new, $old, @$export_args);
604 $dbh->rollback if $oldAutoCommit;
605 return "error exporting to ". $replace_part_export->exporttype.
606 " (transaction rolled back): $error";
610 foreach my $insert_part_export (
611 grep { ! $old_exportnum{$_->exportnum} } @new_part_export
613 my $error = $insert_part_export->export_insert($new, @$export_args );
615 $dbh->rollback if $oldAutoCommit;
616 return "error inserting export to ". $insert_part_export->exporttype.
617 " (transaction rolled back): $error";
621 foreach my $depend_jobnum ( @$depend_jobnums ) {
622 warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
624 foreach my $jobnum ( @jobnums ) {
625 my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
626 warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
628 my $error = $queue->depend_insert($depend_jobnum);
630 $dbh->rollback if $oldAutoCommit;
631 return "error queuing job dependancy: $error";
638 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
644 Sets any fixed fields for this service (see L<FS::part_svc>). If there is an
645 error, returns the error, otherwise returns the FS::part_svc object (use ref()
646 to test the return). Usually called by the check method.
652 $self->setx('F', @_);
657 Sets all fields to their defaults (see L<FS::part_svc>), overriding their
658 current values. If there is an error, returns the error, otherwise returns
659 the FS::part_svc object (use ref() to test the return).
665 $self->setx('D', @_ );
668 =item set_default_and_fixed
672 sub set_default_and_fixed {
674 $self->setx( [ 'D', 'F' ], @_ );
677 =item setx FLAG | FLAG_ARRAYREF , [ CALLBACK_HASHREF ]
679 Sets fields according to the passed in flag or arrayref of flags.
681 Optionally, a hashref of field names and callback coderefs can be passed.
682 If a coderef exists for a given field name, instead of setting the field,
683 the coderef is called with the column value (part_svc_column.columnvalue)
684 as the single parameter.
691 my @x = ref($x) ? @$x : ($x);
692 my $coderef = scalar(@_) ? shift : $self->_fieldhandlers;
695 $self->ut_numbern('svcnum')
697 return $error if $error;
699 my $part_svc = $self->part_svc;
700 return "Unknown svcpart" unless $part_svc;
702 #set default/fixed/whatever fields from part_svc
704 foreach my $part_svc_column (
705 grep { my $f = $_->columnflag; grep { $f eq $_ } @x } #columnflag in @x
706 $part_svc->all_part_svc_column
709 my $columnname = $part_svc_column->columnname;
710 my $columnvalue = $part_svc_column->columnvalue;
712 $columnvalue = &{ $coderef->{$columnname} }( $self, $columnvalue )
713 if exists( $coderef->{$columnname} );
714 $self->setfield( $columnname, $columnvalue );
727 if ( $self->get('svcpart') ) {
728 $svcpart = $self->get('svcpart');
729 } elsif ( $self->svcnum && qsearchs('cust_svc', {'svcnum'=>$self->svcnum}) ) {
730 my $cust_svc = $self->cust_svc;
731 return "Unknown svcnum" unless $cust_svc;
732 $svcpart = $cust_svc->svcpart;
735 qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
741 Returns the FS::svc_pbx record for this service, if any (see L<FS::svc_pbx>).
743 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
748 # XXX FS::h_svc_{acct,phone} could have a history-aware svc_pbx override
752 return '' unless $self->pbxsvc;
753 qsearchs( 'svc_pbx', { 'svcnum' => $self->pbxsvc } );
758 Returns the title of the FS::svc_pbx record associated with this service, if
761 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
768 my $svc_pbx = $self->svc_pbx or return '';
772 =item pbx_select_hash %OPTIONS
774 Can be called as an object method or a class method.
776 Returns a hash SVCNUM => TITLE ... representing the PBXes this customer
777 that may be associated with this service.
779 Currently available options are: I<pkgnum> I<svcpart>
781 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
786 #false laziness w/svc_acct::domain_select_hash
787 sub pbx_select_hash {
788 my ($self, %options) = @_;
794 $part_svc = $self->part_svc;
795 $cust_pkg = $self->cust_svc->cust_pkg
799 $part_svc = qsearchs('part_svc', { 'svcpart' => $options{svcpart} })
800 if $options{'svcpart'};
802 $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $options{pkgnum} })
803 if $options{'pkgnum'};
805 if ($part_svc && ( $part_svc->part_svc_column('pbxsvc')->columnflag eq 'S'
806 || $part_svc->part_svc_column('pbxsvc')->columnflag eq 'F')) {
807 %pbxes = map { $_->svcnum => $_->title }
808 map { qsearchs('svc_pbx', { 'svcnum' => $_ }) }
809 split(',', $part_svc->part_svc_column('pbxsvc')->columnvalue);
810 } elsif ($cust_pkg) { # && !$conf->exists('svc_acct-alldomains') ) {
811 %pbxes = map { $_->svcnum => $_->title }
812 map { qsearchs('svc_pbx', { 'svcnum' => $_->svcnum }) }
813 map { qsearch('cust_svc', { 'pkgnum' => $_->pkgnum } ) }
814 qsearch('cust_pkg', { 'custnum' => $cust_pkg->custnum });
817 %pbxes = map { $_->svcnum => $_->title } qsearch('svc_pbx', {} );
820 if ($part_svc && $part_svc->part_svc_column('pbxsvc')->columnflag eq 'D') {
821 my $svc_pbx = qsearchs('svc_pbx',
822 { 'svcnum' => $part_svc->part_svc_column('pbxsvc')->columnvalue } );
824 $pbxes{$svc_pbx->svcnum} = $svc_pbx->title;
826 warn "unknown svc_pbx.svcnum for part_svc_column pbxsvc: ".
827 $part_svc->part_svc_column('pbxsvc')->columnvalue;
836 =item set_auto_inventory
838 Sets any fields which auto-populate from inventory (see L<FS::part_svc>), and
839 also check any manually populated inventory fields.
841 If there is an error, returns the error, otherwise returns false.
845 sub set_auto_inventory {
846 # don't try to do this during an upgrade
847 return '' if $FS::CurrentUser::upgrade_hack;
850 my $old = @_ ? shift : '';
853 $self->ut_numbern('svcnum')
855 return $error if $error;
857 my $part_svc = $self->part_svc;
858 return "Unkonwn svcpart" unless $part_svc;
860 local $SIG{HUP} = 'IGNORE';
861 local $SIG{INT} = 'IGNORE';
862 local $SIG{QUIT} = 'IGNORE';
863 local $SIG{TERM} = 'IGNORE';
864 local $SIG{TSTP} = 'IGNORE';
865 local $SIG{PIPE} = 'IGNORE';
867 my $oldAutoCommit = $FS::UID::AutoCommit;
868 local $FS::UID::AutoCommit = 0;
871 #set default/fixed/whatever fields from part_svc
872 my $table = $self->table;
873 foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
875 my $part_svc_column = $part_svc->part_svc_column($field);
876 my $columnflag = $part_svc_column->columnflag;
877 next unless $columnflag =~ /^[AM]$/;
879 next if $columnflag eq 'A' && $self->$field() ne '';
881 my $classnum = $part_svc_column->columnvalue;
884 if ( $columnflag eq 'A' && $self->$field() eq '' ) {
885 $hash{'svcnum'} = '';
886 } elsif ( $columnflag eq 'M' ) {
887 return "Select inventory item for $field" unless $self->getfield($field);
888 $hash{'item'} = $self->getfield($field);
889 my $chosen_classnum = $self->getfield($field.'_classnum');
890 if ( grep {$_ == $chosen_classnum} split(',', $classnum) ) {
891 $classnum = $chosen_classnum;
893 # otherwise the chosen classnum is either (all), or somehow not on
894 # the list, so ignore it and choose the first item that's in any
898 my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql(
900 'table' => 'inventory_item',
903 my $inventory_item = qsearchs({
904 'table' => 'inventory_item',
906 'extra_sql' => "AND classnum IN ($classnum) AND $agentnums_sql",
907 'order_by' => 'ORDER BY ( agentnum IS NULL ) '. #agent inventory first
908 ' LIMIT 1 FOR UPDATE',
911 unless ( $inventory_item ) {
912 # should really only be shown if columnflag eq 'A'...
913 $dbh->rollback if $oldAutoCommit;
914 my $message = 'Out of ';
915 my @classnums = split(',', $classnum);
916 foreach ( @classnums ) {
917 my $class = FS::inventory_class->by_key($_)
918 or return "Can't find inventory_class.classnum $_";
919 $message .= PL_N($class->classname);
920 if ( scalar(@classnums) > 2 ) { # english is hard
921 if ( $_ != $classnums[-1] ) {
925 if ( scalar(@classnums) > 1 and $_ == $classnums[-2] ) {
932 next if $columnflag eq 'M' && $inventory_item->svcnum == $self->svcnum;
934 $self->setfield( $field, $inventory_item->item );
935 #if $columnflag eq 'A' && $self->$field() eq '';
937 # release the old inventory item, if there was one
938 if ( $old && $old->$field() && $old->$field() ne $self->$field() ) {
939 my $old_inv = qsearchs({
940 'table' => 'inventory_item',
942 'svcnum' => $old->svcnum,
944 'extra_sql' => "AND classnum IN ($classnum) AND ".
945 '( ( svc_field IS NOT NULL AND svc_field = '.$dbh->quote($field).' )'.
946 ' OR ( svc_field IS NULL AND item = '. dbh->quote($old->$field).' )'.
950 $old_inv->svcnum('');
951 $old_inv->svc_field('');
952 my $oerror = $old_inv->replace;
954 $dbh->rollback if $oldAutoCommit;
955 return "Error unprovisioning inventory: $oerror";
958 warn "old inventory_item not found for $field ". $self->$field;
962 $inventory_item->svcnum( $self->svcnum );
963 $inventory_item->svc_field( $field );
964 my $ierror = $inventory_item->replace();
966 $dbh->rollback if $oldAutoCommit;
967 return "Error provisioning inventory: $ierror";
972 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
978 =item return_inventory
980 Release all inventory items attached to this service's fields. Call
981 when unprovisioning the service.
985 sub return_inventory {
988 local $SIG{HUP} = 'IGNORE';
989 local $SIG{INT} = 'IGNORE';
990 local $SIG{QUIT} = 'IGNORE';
991 local $SIG{TERM} = 'IGNORE';
992 local $SIG{TSTP} = 'IGNORE';
993 local $SIG{PIPE} = 'IGNORE';
995 my $oldAutoCommit = $FS::UID::AutoCommit;
996 local $FS::UID::AutoCommit = 0;
999 foreach my $inventory_item ( $self->inventory_item ) {
1000 $inventory_item->svcnum('');
1001 $inventory_item->svc_field('');
1002 my $error = $inventory_item->replace();
1004 $dbh->rollback if $oldAutoCommit;
1005 return "Error returning inventory: $error";
1009 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1014 =item inventory_item
1016 Returns the inventory items associated with this svc_ record, as
1017 FS::inventory_item objects (see L<FS::inventory_item>.
1021 sub inventory_item {
1024 'table' => 'inventory_item',
1025 'hashref' => { 'svcnum' => $self->svcnum, },
1029 =item release_router
1031 Delete any routers associated with this service. This will release their
1032 address blocks, also.
1036 sub release_router {
1038 my @routers = qsearch('router', { svcnum => $self->svcnum });
1039 foreach (@routers) {
1040 my $error = $_->delete;
1041 return "$error (removing router '".$_->routername."')" if $error;
1049 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
1050 object (see L<FS::cust_svc>).
1056 qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
1061 Runs export_suspend callbacks.
1068 my $export_args = $options{'export_args'} || [];
1069 $self->export('suspend', @$export_args);
1074 Runs export_unsuspend callbacks.
1081 my $export_args = $options{'export_args'} || [];
1082 $self->export('unsuspend', @$export_args);
1087 Runs export_links callbacks and returns the links.
1094 $self->export('links', $return);
1098 =item export_getsettings
1100 Runs export_getsettings callbacks and returns the two hashrefs.
1104 sub export_getsettings {
1108 my $error = $self->export('getsettings', \%settings, \%defaults);
1110 warn "error running export_getsetings: $error";
1111 return ( { 'error' => $error }, {} );
1113 ( \%settings, \%defaults );
1116 =item export_getstatus
1118 Runs export_getstatus callbacks and returns a two item list consisting of an
1119 HTML status and a status hashref.
1123 sub export_getstatus {
1127 my $error = $self->export('getstatus', \$html, \%hash);
1129 warn "error running export_getstatus: $error";
1130 return ( '', { 'error' => $error } );
1135 =item export_setstatus
1137 Runs export_setstatus callbacks. If there is an error, returns the error,
1138 otherwise returns false.
1142 sub export_setstatus { shift->_export_setstatus_X('setstatus', @_) }
1143 sub export_setstatus_listadd { shift->_export_setstatus_X('setstatus_listadd', @_) }
1144 sub export_setstatus_listdel { shift->_export_setstatus_X('setstatus_listdel', @_) }
1145 sub export_setstatus_vacationadd { shift->_export_setstatus_X('setstatus_vacationadd', @_) }
1146 sub export_setstatus_vacationdel { shift->_export_setstatus_X('setstatus_vacationdel', @_) }
1148 sub _export_setstatus_X {
1149 my( $self, $method, @args ) = @_;
1150 my $error = $self->export($method, @args);
1152 warn "error running export_$method: $error";
1158 =item export HOOK [ EXPORT_ARGS ]
1160 Runs the provided export hook (i.e. "suspend", "unsuspend") for this service.
1165 my( $self, $method ) = ( shift, shift );
1167 # $method must start with export_, $action must be the part after that
1168 $method = "export_$method" unless $method =~ /^export_/;
1169 my ($action) = $method =~ /^export_(\w+)/;
1171 local $SIG{HUP} = 'IGNORE';
1172 local $SIG{INT} = 'IGNORE';
1173 local $SIG{QUIT} = 'IGNORE';
1174 local $SIG{TERM} = 'IGNORE';
1175 local $SIG{TSTP} = 'IGNORE';
1176 local $SIG{PIPE} = 'IGNORE';
1178 my $oldAutoCommit = $FS::UID::AutoCommit;
1179 local $FS::UID::AutoCommit = 0;
1183 unless ( $noexport_hack ) {
1184 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
1185 next unless $part_export->can($method);
1186 next if $part_export->get("no_$action"); # currently only 'no_suspend'
1187 my $error = $part_export->$method($self, @_);
1189 $dbh->rollback if $oldAutoCommit;
1190 return "error exporting $method event to ". $part_export->exporttype.
1191 " (transaction rolled back): $error";
1196 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1203 Sets or retrieves overlimit date.
1209 #$self->cust_svc->overlimit(@_);
1210 my $cust_svc = $self->cust_svc;
1211 unless ( $cust_svc ) { #wtf?
1212 my $error = "$me overlimit: missing cust_svc record for svc_acct svcnum ".
1214 if ( $overlimit_missing_cust_svc_nonfatal_kludge ) {
1215 cluck "$error; continuing anyway as requested";
1221 $cust_svc->overlimit(@_);
1226 Stub - returns false (no error) so derived classes don't need to define this
1227 methods. Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
1229 This method is called *before* the deletion step which actually deletes the
1230 services. This method should therefore only be used for "pre-deletion"
1231 cancellation steps, if necessary.
1237 =item clone_suspended
1239 Constructor used by FS::part_export::_export_suspend fallback. Stub returning
1240 same object for svc_ classes which don't implement a suspension fallback
1241 (everything except svc_acct at the moment). Document better.
1245 sub clone_suspended {
1249 =item clone_kludge_unsuspend
1251 Constructor used by FS::part_export::_export_unsuspend fallback. Stub returning
1252 same object for svc_ classes which don't implement a suspension fallback
1253 (everything except svc_acct at the moment). Document better.
1257 sub clone_kludge_unsuspend {
1261 =item find_duplicates MODE FIELDS...
1263 Method used by _check_duplicate routines to find services with duplicate
1264 values in specified fields. Set MODE to 'global' to search across all
1265 services, or 'export' to limit to those that share one or more exports
1266 with this service. FIELDS is a list of field names; only services
1267 matching in all fields will be returned. Empty fields will be skipped.
1271 sub find_duplicates {
1276 my %search = map { $_ => $self->getfield($_) }
1277 grep { length($self->getfield($_)) } @fields;
1278 return () if !%search;
1279 my @dup = grep { ! $self->svcnum or $_->svcnum != $self->svcnum }
1280 qsearch( $self->table, \%search );
1282 return @dup if $mode eq 'global';
1283 die "incorrect find_duplicates mode '$mode'" if $mode ne 'export';
1285 my $exports = FS::part_export::export_info($self->table);
1286 my %conflict_svcparts;
1287 my $part_svc = $self->part_svc;
1288 foreach my $part_export ( $part_svc->part_export ) {
1289 %conflict_svcparts = map { $_->svcpart => 1 } $part_export->export_svc;
1291 return grep { $conflict_svcparts{$_->cust_svc->svcpart} } @dup;
1294 =item getstatus_html
1298 sub getstatus_html {
1301 my $part_svc = $self->cust_svc->part_svc;
1305 foreach my $export ( grep $_->can('export_getstatus'), $part_svc->part_export ) {
1306 my $export_html = '';
1308 $export->export_getstatus( $self, \$export_html, \%hash );
1309 $html .= $export_html;
1322 my $conf = new FS::Conf;
1323 return '' unless grep { $self->table eq $_ }
1324 $conf->config('nms-auto_add-svc_ips');
1325 my $ip_field = $self->table_info->{'ip_field'};
1327 my $queue = FS::queue->new( {
1328 'job' => 'FS::NetworkMonitoringSystem::queued_add_router',
1329 'svcnum' => $self->svcnum,
1331 $queue->insert( 'FS::NetworkMonitoringSystem',
1333 $conf->config('nms-auto_add-community')
1342 #XXX not yet implemented
1345 =item search_sql_field FIELD STRING
1347 Class method which returns an SQL fragment to search for STRING in FIELD.
1349 It is now case-insensitive by default.
1353 sub search_sql_field {
1354 my( $class, $field, $string ) = @_;
1355 my $table = $class->table;
1356 my $q_string = dbh->quote($string);
1357 "LOWER($table.$field) = LOWER($q_string)";
1360 #fallback for services that don't provide a search...
1362 #my( $class, $string ) = @_;
1365 sub search_sql_addl_from {
1369 =item search HASHREF
1371 Class method which returns a qsearch hash expression to search for parameters
1372 specified in HASHREF.
1378 =item unlinked - set to search for all unlinked services. Overrides all other options.
1388 =item pkgpart - arrayref
1390 =item routernum - arrayref
1392 =item sectornum - arrayref
1394 =item towernum - arrayref
1398 =item cancelled - if true, only returns svcs attached to cancelled pkgs;
1399 if defined and false, only returns svcs not attached to cancelled packages
1405 ### Don't call the 'cancelled' option 'Service Status'
1406 ### There is no such thing
1407 ### See cautionary note in httemplate/browse/part_svc.cgi
1410 my ($class, $params) = @_;
1413 'LEFT JOIN cust_svc USING ( svcnum )',
1414 'LEFT JOIN part_svc USING ( svcpart )',
1415 'LEFT JOIN cust_pkg USING ( pkgnum )',
1416 FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg'),
1421 $class->_search_svc($params, \@from, \@where) if $class->can('_search_svc');
1424 # if ( $params->{'domain'} ) {
1425 # my $svc_domain = qsearchs('svc_domain', { 'domain'=>$params->{'domain'} } );
1426 # #preserve previous behavior & bubble up an error if $svc_domain not found?
1427 # push @where, 'domsvc = '. $svc_domain->svcnum if $svc_domain;
1431 # if ( $params->{'domsvc'} =~ /^(\d+)$/ ) {
1432 # push @where, "domsvc = $1";
1436 push @where, 'pkgnum IS NULL' if $params->{'unlinked'};
1439 if ( $params->{'agentnum'} =~ /^(\d+)$/ && $1 ) {
1440 push @where, "cust_main.agentnum = $1";
1444 if ( $params->{'custnum'} =~ /^(\d+)$/ && $1 ) {
1445 push @where, "cust_pkg.custnum = $1";
1449 if ( $params->{'cust_status'} =~ /^([a-z]+)$/ ) {
1450 push @where, FS::cust_main->cust_status_sql . " = '$1'";
1454 if ( $params->{'balance'} =~ /^\s*(\-?\d*(\.\d{1,2})?)\s*$/ && length($1) ) {
1458 if ( $params->{'balance_days'} =~ /^\s*(\d*(\.\d{1,3})?)\s*$/ && length($1) ) {
1459 $age = time - 86400 * $1;
1461 push @where, FS::cust_main->balance_date_sql($age) . " > $balance";
1465 if ( $params->{'payby'} && scalar(@{ $params->{'payby'} }) ) {
1466 my @payby = map "'$_'", grep /^(\w+)$/, @{ $params->{'payby'} };
1467 push @where, 'payby IN ('. join(',', @payby ). ')';
1471 ##pkgpart, now properly untainted, can be arrayref
1472 #for my $pkgpart ( $params->{'pkgpart'} ) {
1473 # if ( ref $pkgpart ) {
1474 # my $where = join(',', map { /^(\d+)$/ ? $1 : () } @$pkgpart );
1475 # push @where, "cust_pkg.pkgpart IN ($where)" if $where;
1477 # elsif ( $pkgpart =~ /^(\d+)$/ ) {
1478 # push @where, "cust_pkg.pkgpart = $1";
1481 if ( $params->{'pkgpart'} ) {
1482 my @pkgpart = ref( $params->{'pkgpart'} )
1483 ? @{ $params->{'pkgpart'} }
1484 : $params->{'pkgpart'}
1485 ? ( $params->{'pkgpart'} )
1487 @pkgpart = grep /^(\d+)$/, @pkgpart;
1488 push @where, 'cust_pkg.pkgpart IN ('. join(',', @pkgpart ). ')' if @pkgpart;
1492 if ( $params->{'svcnum'} ) {
1493 my @svcnum = ref( $params->{'svcnum'} )
1494 ? @{ $params->{'svcnum'} }
1495 : $params->{'svcnum'};
1496 @svcnum = grep /^\d+$/, @svcnum;
1497 push @where, 'svcnum IN ('. join(',', @svcnum) . ')' if @svcnum;
1501 if ( $params->{'svcpart'} ) {
1502 my @svcpart = ref( $params->{'svcpart'} )
1503 ? @{ $params->{'svcpart'} }
1504 : $params->{'svcpart'}
1505 ? ( $params->{'svcpart'} )
1507 @svcpart = grep /^(\d+)$/, @svcpart;
1508 push @where, 'svcpart IN ('. join(',', @svcpart ). ')' if @svcpart;
1511 if ( $params->{'exportnum'} =~ /^(\d+)$/ ) {
1512 push @from, ' LEFT JOIN export_svc USING ( svcpart )';
1513 push @where, "exportnum = $1";
1516 if ( defined($params->{'cancelled'}) ) {
1517 if ($params->{'cancelled'}) {
1518 push @where, "cust_pkg.cancel IS NOT NULL";
1520 push @where, "cust_pkg.cancel IS NULL";
1524 # # sector and tower
1525 # my @where_sector = $class->tower_sector_sql($params);
1526 # if ( @where_sector ) {
1527 # push @where, @where_sector;
1528 # push @from, ' LEFT JOIN tower_sector USING ( sectornum )';
1531 # here is the agent virtualization
1532 #if ($params->{CurrentUser}) {
1534 # qsearchs('access_user', { username => $params->{CurrentUser} });
1536 # if ($access_user) {
1537 # push @where, $access_user->agentnums_sql('table'=>'cust_main');
1539 # push @where, "1=0";
1542 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql(
1543 'table' => 'cust_main',
1544 'null_right' => 'View/link unlinked services',
1548 push @where, @{ $params->{'where'} } if $params->{'where'};
1550 my $addl_from = join(' ', @from);
1551 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
1553 my $table = $class->table;
1555 my $count_query = "SELECT COUNT(*) FROM $table $addl_from $extra_sql";
1556 #if ( keys %svc_X ) {
1557 # $count_query .= ' WHERE '.
1558 # join(' AND ', map "$_ = ". dbh->quote($svc_X{$_}),
1566 'select' => join(', ',
1569 'cust_main.custnum',
1570 @{ $params->{'addl_select'} || [] },
1571 FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
1573 'addl_from' => $addl_from,
1574 'extra_sql' => $extra_sql,
1575 'order_by' => $params->{'order_by'},
1576 'count_query' => $count_query,
1585 The setfixed method return value.
1587 B<export> method isn't used by insert and replace methods yet.
1591 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
1592 from the base documentation.