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 Only checks fields marked as required in table_info or
156 part_svc_column definition. Should be invoked by service-specific
157 check using SUPER. Invokes FS::Record::check using SUPER.
164 ## Checking required fields
166 # get fields marked as required in table_info
169 my $tinfo = $self->can('table_info') ? $self->table_info : {};
170 my $fields = $tinfo->{'fields'} || {};
171 foreach my $field (keys %$fields) {
172 if (ref($fields->{$field}) && $fields->{$field}->{'required'}) {
173 $required->{$field} = 1;
174 $labels->{$field} = $fields->{$field}->{'label'};
177 # add fields marked as required in database
179 qsearch('part_svc_column',{
180 'svcpart' => $self->svcpart,
184 $required->{$column->columnname} = 1;
185 $labels->{$column->columnname} = $column->columnlabel;
187 # do the actual checking
188 foreach my $field (keys %$required) {
189 unless ($self->$field) {
190 my $name = $labels->{$field} || $field;
191 return "Field $name is required\n"
198 =item insert [ , OPTION => VALUE ... ]
200 Adds this record to the database. If there is an error, returns the error,
201 otherwise returns false.
203 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
204 defined. An FS::cust_svc record will be created and inserted.
206 Currently available options are: I<jobnums>, I<child_objects> and
209 If I<jobnum> is set to an array reference, the jobnums of any export jobs will
210 be added to the referenced array.
212 If I<child_objects> is set to an array reference of FS::tablename objects
213 (for example, FS::svc_export_machine or FS::acct_snarf objects), they
214 will have their svcnum field set and will be inserted after this record,
215 but before any exports are run. Each element of the array can also
216 optionally be a two-element array reference containing the child object
217 and the name of an alternate field to be filled in with the newly-inserted
218 svcnum, for example C<[ $svc_forward, 'srcsvc' ]>
220 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
221 jobnums), all provisioning jobs will have a dependancy on the supplied
222 jobnum(s) (they will not run until the specific job(s) complete(s)).
224 If I<export_args> is set to an array reference, the referenced list will be
225 passed to export commands.
232 warn "[$me] insert called with options ".
233 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
237 local $FS::queue::jobnums = \@jobnums;
238 warn "[$me] insert: set \$FS::queue::jobnums to $FS::queue::jobnums\n"
240 my $objects = $options{'child_objects'} || [];
241 my $depend_jobnums = $options{'depend_jobnum'} || [];
242 $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
244 local $SIG{HUP} = 'IGNORE';
245 local $SIG{INT} = 'IGNORE';
246 local $SIG{QUIT} = 'IGNORE';
247 local $SIG{TERM} = 'IGNORE';
248 local $SIG{TSTP} = 'IGNORE';
249 local $SIG{PIPE} = 'IGNORE';
251 my $oldAutoCommit = $FS::UID::AutoCommit;
252 local $FS::UID::AutoCommit = 0;
255 my $svcnum = $self->svcnum;
256 my $cust_svc = $svcnum ? qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) : '';
257 my $inserted_cust_svc = 0;
258 #unless ( $svcnum ) {
259 if ( !$svcnum or !$cust_svc ) {
260 $cust_svc = new FS::cust_svc ( {
261 #hua?# 'svcnum' => $svcnum,
262 'svcnum' => $self->svcnum,
263 'pkgnum' => $self->pkgnum,
264 'svcpart' => $self->svcpart,
266 my $error = $cust_svc->insert;
268 $dbh->rollback if $oldAutoCommit;
271 $inserted_cust_svc = 1;
272 $svcnum = $self->svcnum($cust_svc->svcnum);
274 #$cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
275 unless ( $cust_svc ) {
276 $dbh->rollback if $oldAutoCommit;
277 return "no cust_svc record found for svcnum ". $self->svcnum;
279 $self->pkgnum($cust_svc->pkgnum);
280 $self->svcpart($cust_svc->svcpart);
283 my $error = $self->preinsert_hook_first
284 || $self->set_auto_inventory
286 || $self->_check_duplicate
287 || $self->preinsert_hook
288 || $self->SUPER::insert;
290 if ( $inserted_cust_svc ) {
291 my $derror = $cust_svc->delete;
292 die $derror if $derror;
294 $dbh->rollback if $oldAutoCommit;
298 foreach my $object ( @$objects ) {
300 if ( ref($object) eq 'ARRAY' ) {
301 ($obj, $field) = @$object;
306 $obj->$field($self->svcnum);
307 $error = $obj->insert;
309 $dbh->rollback if $oldAutoCommit;
315 unless ( $noexport_hack ) {
317 warn "[$me] insert: \$FS::queue::jobnums is $FS::queue::jobnums\n"
320 my $export_args = $options{'export_args'} || [];
322 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
323 my $error = $part_export->export_insert($self, @$export_args);
325 $dbh->rollback if $oldAutoCommit;
326 return "exporting to ". $part_export->exporttype.
327 " (transaction rolled back): $error";
331 foreach my $depend_jobnum ( @$depend_jobnums ) {
332 warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
334 foreach my $jobnum ( @jobnums ) {
335 my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
336 warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
338 my $error = $queue->depend_insert($depend_jobnum);
340 $dbh->rollback if $oldAutoCommit;
341 return "error queuing job dependancy: $error";
348 my $nms_ip_error = $self->nms_ip_insert;
349 if ( $nms_ip_error ) {
350 $dbh->rollback if $oldAutoCommit;
351 return "error queuing IP insert: $nms_ip_error";
354 if ( exists $options{'jobnums'} ) {
355 push @{ $options{'jobnums'} }, @jobnums;
358 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
364 sub preinsert_hook_first { ''; }
365 sub _check_duplcate { ''; }
366 sub preinsert_hook { ''; }
367 sub table_dupcheck_fields { (); }
368 sub prereplace_hook { ''; }
369 sub prereplace_hook_first { ''; }
370 sub predelete_hook { ''; }
371 sub predelete_hook_first { ''; }
373 =item delete [ , OPTION => VALUE ... ]
375 Deletes this account from the database. If there is an error, returns the
376 error, otherwise returns false.
378 The corresponding FS::cust_svc record will be deleted as well.
385 my $export_args = $options{'export_args'} || [];
387 local $SIG{HUP} = 'IGNORE';
388 local $SIG{INT} = 'IGNORE';
389 local $SIG{QUIT} = 'IGNORE';
390 local $SIG{TERM} = 'IGNORE';
391 local $SIG{TSTP} = 'IGNORE';
392 local $SIG{PIPE} = 'IGNORE';
394 my $oldAutoCommit = $FS::UID::AutoCommit;
395 local $FS::UID::AutoCommit = 0;
398 my $error = $self->predelete_hook_first
399 || $self->SUPER::delete
400 || $self->export('delete', @$export_args)
401 || $self->return_inventory
402 || $self->release_router
403 || $self->predelete_hook
404 || $self->cust_svc->delete
407 $dbh->rollback if $oldAutoCommit;
411 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
418 Currently this will only run expire exports if any are attached
423 my($self,$date) = (shift,shift);
425 return 'Expire date must be specified' unless $date;
427 local $SIG{HUP} = 'IGNORE';
428 local $SIG{INT} = 'IGNORE';
429 local $SIG{QUIT} = 'IGNORE';
430 local $SIG{TERM} = 'IGNORE';
431 local $SIG{TSTP} = 'IGNORE';
432 local $SIG{PIPE} = 'IGNORE';
434 my $oldAutoCommit = $FS::UID::AutoCommit;
435 local $FS::UID::AutoCommit = 0;
438 my $export_args = [$date];
439 my $error = $self->export('expire', @$export_args);
441 $dbh->rollback if $oldAutoCommit;
445 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
450 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ]
452 Replaces OLD_RECORD with this one. If there is an error, returns the error,
453 otherwise returns false.
455 Currently available options are: I<child_objects>, I<export_args> and
458 If I<child_objects> is set to an array reference of FS::tablename objects
459 (for example, FS::svc_export_machine or FS::acct_snarf objects), they
460 will have their svcnum field set and will be inserted or replaced after
461 this record, but before any exports are run. Each element of the array
462 can also optionally be a two-element array reference containing the
463 child object and the name of an alternate field to be filled in with
464 the newly-inserted svcnum, for example C<[ $svc_forward, 'srcsvc' ]>
466 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
467 jobnums), all provisioning jobs will have a dependancy on the supplied
468 jobnum(s) (they will not run until the specific job(s) complete(s)).
470 If I<export_args> is set to an array reference, the referenced list will be
471 passed to export commands.
478 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
483 ( ref($_[0]) eq 'HASH' )
487 my $objects = $options->{'child_objects'} || [];
490 local $FS::queue::jobnums = \@jobnums;
491 warn "[$me] replace: set \$FS::queue::jobnums to $FS::queue::jobnums\n"
493 my $depend_jobnums = $options->{'depend_jobnum'} || [];
494 $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
496 local $SIG{HUP} = 'IGNORE';
497 local $SIG{INT} = 'IGNORE';
498 local $SIG{QUIT} = 'IGNORE';
499 local $SIG{TERM} = 'IGNORE';
500 local $SIG{TSTP} = 'IGNORE';
501 local $SIG{PIPE} = 'IGNORE';
503 my $oldAutoCommit = $FS::UID::AutoCommit;
504 local $FS::UID::AutoCommit = 0;
507 my $error = $new->prereplace_hook_first($old)
508 || $new->set_auto_inventory($old)
509 || $new->check; #redundant, but so any duplicate fields are
510 #maniuplated as appropriate (svc_phone.phonenum)
512 $dbh->rollback if $oldAutoCommit;
516 #if ( $old->username ne $new->username || $old->domsvc != $new->domsvc ) {
517 if ( grep { $old->$_ ne $new->$_ } $new->table_dupcheck_fields ) {
519 $new->svcpart( $new->cust_svc->svcpart ) unless $new->svcpart;
520 $error = $new->_check_duplicate;
522 $dbh->rollback if $oldAutoCommit;
527 $error = $new->SUPER::replace($old);
529 $dbh->rollback if $oldAutoCommit;
533 foreach my $object ( @$objects ) {
535 if ( ref($object) eq 'ARRAY' ) {
536 ($obj, $field) = @$object;
541 $obj->$field($new->svcnum);
543 my $oldobj = qsearchs( $obj->table, {
544 $field => $new->svcnum,
545 map { $_ => $obj->$_ } $obj->_svc_child_partfields,
549 my $pkey = $oldobj->primary_key;
550 $obj->$pkey($oldobj->$pkey);
551 $obj->replace($oldobj);
553 $error = $obj->insert;
556 $dbh->rollback if $oldAutoCommit;
562 unless ( $noexport_hack ) {
564 warn "[$me] replace: \$FS::queue::jobnums is $FS::queue::jobnums\n"
567 my $export_args = $options->{'export_args'} || [];
569 #not quite false laziness, but same pattern as FS::svc_acct::replace and
570 #FS::part_export::sqlradius::_export_replace. List::Compare or something
571 #would be useful but too much of a pain in the ass to deploy
573 my @old_part_export = $old->cust_svc->part_svc->part_export;
574 my %old_exportnum = map { $_->exportnum => 1 } @old_part_export;
575 my @new_part_export =
577 ? qsearchs('part_svc', { svcpart=>$new->svcpart } )->part_export
578 : $new->cust_svc->part_svc->part_export;
579 my %new_exportnum = map { $_->exportnum => 1 } @new_part_export;
581 foreach my $delete_part_export (
582 grep { ! $new_exportnum{$_->exportnum} } @old_part_export
584 my $error = $delete_part_export->export_delete($old, @$export_args);
586 $dbh->rollback if $oldAutoCommit;
587 return "error deleting, export to ". $delete_part_export->exporttype.
588 " (transaction rolled back): $error";
592 foreach my $replace_part_export (
593 grep { $old_exportnum{$_->exportnum} } @new_part_export
596 $replace_part_export->export_replace( $new, $old, @$export_args);
598 $dbh->rollback if $oldAutoCommit;
599 return "error exporting to ". $replace_part_export->exporttype.
600 " (transaction rolled back): $error";
604 foreach my $insert_part_export (
605 grep { ! $old_exportnum{$_->exportnum} } @new_part_export
607 my $error = $insert_part_export->export_insert($new, @$export_args );
609 $dbh->rollback if $oldAutoCommit;
610 return "error inserting export to ". $insert_part_export->exporttype.
611 " (transaction rolled back): $error";
615 foreach my $depend_jobnum ( @$depend_jobnums ) {
616 warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
618 foreach my $jobnum ( @jobnums ) {
619 my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
620 warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
622 my $error = $queue->depend_insert($depend_jobnum);
624 $dbh->rollback if $oldAutoCommit;
625 return "error queuing job dependancy: $error";
632 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
638 Sets any fixed fields for this service (see L<FS::part_svc>). If there is an
639 error, returns the error, otherwise returns the FS::part_svc object (use ref()
640 to test the return). Usually called by the check method.
646 $self->setx('F', @_);
651 Sets all fields to their defaults (see L<FS::part_svc>), overriding their
652 current values. If there is an error, returns the error, otherwise returns
653 the FS::part_svc object (use ref() to test the return).
659 $self->setx('D', @_ );
662 =item set_default_and_fixed
666 sub set_default_and_fixed {
668 $self->setx( [ 'D', 'F' ], @_ );
671 =item setx FLAG | FLAG_ARRAYREF , [ CALLBACK_HASHREF ]
673 Sets fields according to the passed in flag or arrayref of flags.
675 Optionally, a hashref of field names and callback coderefs can be passed.
676 If a coderef exists for a given field name, instead of setting the field,
677 the coderef is called with the column value (part_svc_column.columnvalue)
678 as the single parameter.
685 my @x = ref($x) ? @$x : ($x);
686 my $coderef = scalar(@_) ? shift : $self->_fieldhandlers;
689 $self->ut_numbern('svcnum')
691 return $error if $error;
693 my $part_svc = $self->part_svc;
694 return "Unknown svcpart" unless $part_svc;
696 #set default/fixed/whatever fields from part_svc
698 foreach my $part_svc_column (
699 grep { my $f = $_->columnflag; grep { $f eq $_ } @x } #columnflag in @x
700 $part_svc->all_part_svc_column
703 my $columnname = $part_svc_column->columnname;
704 my $columnvalue = $part_svc_column->columnvalue;
706 $columnvalue = &{ $coderef->{$columnname} }( $self, $columnvalue )
707 if exists( $coderef->{$columnname} );
708 $self->setfield( $columnname, $columnvalue );
721 if ( $self->get('svcpart') ) {
722 $svcpart = $self->get('svcpart');
723 } elsif ( $self->svcnum && qsearchs('cust_svc', {'svcnum'=>$self->svcnum}) ) {
724 my $cust_svc = $self->cust_svc;
725 return "Unknown svcnum" unless $cust_svc;
726 $svcpart = $cust_svc->svcpart;
729 qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
735 Returns the FS::svc_pbx record for this service, if any (see L<FS::svc_pbx>).
737 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
742 # XXX FS::h_svc_{acct,phone} could have a history-aware svc_pbx override
746 return '' unless $self->pbxsvc;
747 qsearchs( 'svc_pbx', { 'svcnum' => $self->pbxsvc } );
752 Returns the title of the FS::svc_pbx record associated with this service, if
755 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
762 my $svc_pbx = $self->svc_pbx or return '';
766 =item pbx_select_hash %OPTIONS
768 Can be called as an object method or a class method.
770 Returns a hash SVCNUM => TITLE ... representing the PBXes this customer
771 that may be associated with this service.
773 Currently available options are: I<pkgnum> I<svcpart>
775 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
780 #false laziness w/svc_acct::domain_select_hash
781 sub pbx_select_hash {
782 my ($self, %options) = @_;
788 $part_svc = $self->part_svc;
789 $cust_pkg = $self->cust_svc->cust_pkg
793 $part_svc = qsearchs('part_svc', { 'svcpart' => $options{svcpart} })
794 if $options{'svcpart'};
796 $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $options{pkgnum} })
797 if $options{'pkgnum'};
799 if ($part_svc && ( $part_svc->part_svc_column('pbxsvc')->columnflag eq 'S'
800 || $part_svc->part_svc_column('pbxsvc')->columnflag eq 'F')) {
801 %pbxes = map { $_->svcnum => $_->title }
802 map { qsearchs('svc_pbx', { 'svcnum' => $_ }) }
803 split(',', $part_svc->part_svc_column('pbxsvc')->columnvalue);
804 } elsif ($cust_pkg) { # && !$conf->exists('svc_acct-alldomains') ) {
805 %pbxes = map { $_->svcnum => $_->title }
806 map { qsearchs('svc_pbx', { 'svcnum' => $_->svcnum }) }
807 map { qsearch('cust_svc', { 'pkgnum' => $_->pkgnum } ) }
808 qsearch('cust_pkg', { 'custnum' => $cust_pkg->custnum });
811 %pbxes = map { $_->svcnum => $_->title } qsearch('svc_pbx', {} );
814 if ($part_svc && $part_svc->part_svc_column('pbxsvc')->columnflag eq 'D') {
815 my $svc_pbx = qsearchs('svc_pbx',
816 { 'svcnum' => $part_svc->part_svc_column('pbxsvc')->columnvalue } );
818 $pbxes{$svc_pbx->svcnum} = $svc_pbx->title;
820 warn "unknown svc_pbx.svcnum for part_svc_column pbxsvc: ".
821 $part_svc->part_svc_column('pbxsvc')->columnvalue;
830 =item set_auto_inventory
832 Sets any fields which auto-populate from inventory (see L<FS::part_svc>), and
833 also check any manually populated inventory fields.
835 If there is an error, returns the error, otherwise returns false.
839 sub set_auto_inventory {
840 # don't try to do this during an upgrade
841 return '' if $FS::CurrentUser::upgrade_hack;
844 my $old = @_ ? shift : '';
847 $self->ut_numbern('svcnum')
849 return $error if $error;
851 my $part_svc = $self->part_svc;
852 return "Unkonwn svcpart" unless $part_svc;
854 local $SIG{HUP} = 'IGNORE';
855 local $SIG{INT} = 'IGNORE';
856 local $SIG{QUIT} = 'IGNORE';
857 local $SIG{TERM} = 'IGNORE';
858 local $SIG{TSTP} = 'IGNORE';
859 local $SIG{PIPE} = 'IGNORE';
861 my $oldAutoCommit = $FS::UID::AutoCommit;
862 local $FS::UID::AutoCommit = 0;
865 #set default/fixed/whatever fields from part_svc
866 my $table = $self->table;
867 foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
869 my $part_svc_column = $part_svc->part_svc_column($field);
870 my $columnflag = $part_svc_column->columnflag;
871 next unless $columnflag =~ /^[AM]$/;
873 next if $columnflag eq 'A' && $self->$field() ne '';
875 my $classnum = $part_svc_column->columnvalue;
878 if ( $columnflag eq 'A' && $self->$field() eq '' ) {
879 $hash{'svcnum'} = '';
880 } elsif ( $columnflag eq 'M' ) {
881 return "Select inventory item for $field" unless $self->getfield($field);
882 $hash{'item'} = $self->getfield($field);
883 my $chosen_classnum = $self->getfield($field.'_classnum');
884 if ( grep {$_ == $chosen_classnum} split(',', $classnum) ) {
885 $classnum = $chosen_classnum;
887 # otherwise the chosen classnum is either (all), or somehow not on
888 # the list, so ignore it and choose the first item that's in any
892 my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql(
894 'table' => 'inventory_item',
897 my $inventory_item = qsearchs({
898 'table' => 'inventory_item',
900 'extra_sql' => "AND classnum IN ($classnum) AND $agentnums_sql",
901 'order_by' => 'ORDER BY ( agentnum IS NULL ) '. #agent inventory first
902 ' LIMIT 1 FOR UPDATE',
905 unless ( $inventory_item ) {
906 # should really only be shown if columnflag eq 'A'...
907 $dbh->rollback if $oldAutoCommit;
908 my $message = 'Out of ';
909 my @classnums = split(',', $classnum);
910 foreach ( @classnums ) {
911 my $class = FS::inventory_class->by_key($_)
912 or return "Can't find inventory_class.classnum $_";
913 $message .= PL_N($class->classname);
914 if ( scalar(@classnums) > 2 ) { # english is hard
915 if ( $_ != $classnums[-1] ) {
919 if ( scalar(@classnums) > 1 and $_ == $classnums[-2] ) {
926 next if $columnflag eq 'M' && $inventory_item->svcnum == $self->svcnum;
928 $self->setfield( $field, $inventory_item->item );
929 #if $columnflag eq 'A' && $self->$field() eq '';
931 # release the old inventory item, if there was one
932 if ( $old && $old->$field() && $old->$field() ne $self->$field() ) {
933 my $old_inv = qsearchs({
934 'table' => 'inventory_item',
936 'svcnum' => $old->svcnum,
938 'extra_sql' => "AND classnum IN ($classnum) AND ".
939 '( ( svc_field IS NOT NULL AND svc_field = '.$dbh->quote($field).' )'.
940 ' OR ( svc_field IS NULL AND item = '. dbh->quote($old->$field).' )'.
944 $old_inv->svcnum('');
945 $old_inv->svc_field('');
946 my $oerror = $old_inv->replace;
948 $dbh->rollback if $oldAutoCommit;
949 return "Error unprovisioning inventory: $oerror";
952 warn "old inventory_item not found for $field ". $self->$field;
956 $inventory_item->svcnum( $self->svcnum );
957 $inventory_item->svc_field( $field );
958 my $ierror = $inventory_item->replace();
960 $dbh->rollback if $oldAutoCommit;
961 return "Error provisioning inventory: $ierror";
966 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
972 =item return_inventory
974 Release all inventory items attached to this service's fields. Call
975 when unprovisioning the service.
979 sub return_inventory {
982 local $SIG{HUP} = 'IGNORE';
983 local $SIG{INT} = 'IGNORE';
984 local $SIG{QUIT} = 'IGNORE';
985 local $SIG{TERM} = 'IGNORE';
986 local $SIG{TSTP} = 'IGNORE';
987 local $SIG{PIPE} = 'IGNORE';
989 my $oldAutoCommit = $FS::UID::AutoCommit;
990 local $FS::UID::AutoCommit = 0;
993 foreach my $inventory_item ( $self->inventory_item ) {
994 $inventory_item->svcnum('');
995 $inventory_item->svc_field('');
996 my $error = $inventory_item->replace();
998 $dbh->rollback if $oldAutoCommit;
999 return "Error returning inventory: $error";
1003 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1008 =item inventory_item
1010 Returns the inventory items associated with this svc_ record, as
1011 FS::inventory_item objects (see L<FS::inventory_item>.
1015 sub inventory_item {
1018 'table' => 'inventory_item',
1019 'hashref' => { 'svcnum' => $self->svcnum, },
1023 =item release_router
1025 Delete any routers associated with this service. This will release their
1026 address blocks, also.
1030 sub release_router {
1032 my @routers = qsearch('router', { svcnum => $self->svcnum });
1033 foreach (@routers) {
1034 my $error = $_->delete;
1035 return "$error (removing router '".$_->routername."')" if $error;
1043 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
1044 object (see L<FS::cust_svc>).
1048 Runs export_suspend callbacks.
1055 my $export_args = $options{'export_args'} || [];
1056 $self->export('suspend', @$export_args);
1061 Runs export_unsuspend callbacks.
1068 my $export_args = $options{'export_args'} || [];
1069 $self->export('unsuspend', @$export_args);
1074 Runs export_links callbacks and returns the links.
1081 $self->export('links', $return);
1085 =item export_getsettings
1087 Runs export_getsettings callbacks and returns the two hashrefs.
1091 sub export_getsettings {
1095 my $error = $self->export('getsettings', \%settings, \%defaults);
1097 warn "error running export_getsetings: $error";
1098 return ( { 'error' => $error }, {} );
1100 ( \%settings, \%defaults );
1103 =item export_getstatus
1105 Runs export_getstatus callbacks and returns a two item list consisting of an
1106 HTML status and a status hashref.
1110 sub export_getstatus {
1114 my $error = $self->export('getstatus', \$html, \%hash);
1116 warn "error running export_getstatus: $error";
1117 return ( '', { 'error' => $error } );
1122 =item export_setstatus
1124 Runs export_setstatus callbacks. If there is an error, returns the error,
1125 otherwise returns false.
1129 sub export_setstatus { shift->_export_setstatus_X('setstatus', @_) }
1130 sub export_setstatus_listadd { shift->_export_setstatus_X('setstatus_listadd', @_) }
1131 sub export_setstatus_listdel { shift->_export_setstatus_X('setstatus_listdel', @_) }
1132 sub export_setstatus_vacationadd { shift->_export_setstatus_X('setstatus_vacationadd', @_) }
1133 sub export_setstatus_vacationdel { shift->_export_setstatus_X('setstatus_vacationdel', @_) }
1135 sub _export_setstatus_X {
1136 my( $self, $method, @args ) = @_;
1137 my $error = $self->export($method, @args);
1139 warn "error running export_$method: $error";
1145 =item export HOOK [ EXPORT_ARGS ]
1147 Runs the provided export hook (i.e. "suspend", "unsuspend") for this service.
1152 my( $self, $method ) = ( shift, shift );
1154 $method = "export_$method" unless $method =~ /^export_/;
1156 local $SIG{HUP} = 'IGNORE';
1157 local $SIG{INT} = 'IGNORE';
1158 local $SIG{QUIT} = 'IGNORE';
1159 local $SIG{TERM} = 'IGNORE';
1160 local $SIG{TSTP} = 'IGNORE';
1161 local $SIG{PIPE} = 'IGNORE';
1163 my $oldAutoCommit = $FS::UID::AutoCommit;
1164 local $FS::UID::AutoCommit = 0;
1168 unless ( $noexport_hack ) {
1169 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
1170 next unless $part_export->can($method);
1171 my $error = $part_export->$method($self, @_);
1173 $dbh->rollback if $oldAutoCommit;
1174 return "error exporting $method event to ". $part_export->exporttype.
1175 " (transaction rolled back): $error";
1180 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1187 Sets or retrieves overlimit date.
1193 #$self->cust_svc->overlimit(@_);
1194 my $cust_svc = $self->cust_svc;
1195 unless ( $cust_svc ) { #wtf?
1196 my $error = "$me overlimit: missing cust_svc record for svc_acct svcnum ".
1198 if ( $overlimit_missing_cust_svc_nonfatal_kludge ) {
1199 cluck "$error; continuing anyway as requested";
1205 $cust_svc->overlimit(@_);
1210 Stub - returns false (no error) so derived classes don't need to define this
1211 methods. Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
1213 This method is called *before* the deletion step which actually deletes the
1214 services. This method should therefore only be used for "pre-deletion"
1215 cancellation steps, if necessary.
1221 =item clone_suspended
1223 Constructor used by FS::part_export::_export_suspend fallback. Stub returning
1224 same object for svc_ classes which don't implement a suspension fallback
1225 (everything except svc_acct at the moment). Document better.
1229 sub clone_suspended {
1233 =item clone_kludge_unsuspend
1235 Constructor used by FS::part_export::_export_unsuspend fallback. Stub returning
1236 same object for svc_ classes which don't implement a suspension fallback
1237 (everything except svc_acct at the moment). Document better.
1241 sub clone_kludge_unsuspend {
1245 =item find_duplicates MODE FIELDS...
1247 Method used by _check_duplicate routines to find services with duplicate
1248 values in specified fields. Set MODE to 'global' to search across all
1249 services, or 'export' to limit to those that share one or more exports
1250 with this service. FIELDS is a list of field names; only services
1251 matching in all fields will be returned. Empty fields will be skipped.
1255 sub find_duplicates {
1260 my %search = map { $_ => $self->getfield($_) }
1261 grep { length($self->getfield($_)) } @fields;
1262 return () if !%search;
1263 my @dup = grep { ! $self->svcnum or $_->svcnum != $self->svcnum }
1264 qsearch( $self->table, \%search );
1266 return @dup if $mode eq 'global';
1267 die "incorrect find_duplicates mode '$mode'" if $mode ne 'export';
1269 my $exports = FS::part_export::export_info($self->table);
1270 my %conflict_svcparts;
1271 my $part_svc = $self->part_svc;
1272 foreach my $part_export ( $part_svc->part_export ) {
1273 %conflict_svcparts = map { $_->svcpart => 1 } $part_export->export_svc;
1275 return grep { $conflict_svcparts{$_->cust_svc->svcpart} } @dup;
1278 =item getstatus_html
1282 sub getstatus_html {
1285 my $part_svc = $self->cust_svc->part_svc;
1289 foreach my $export ( grep $_->can('export_getstatus'), $part_svc->part_export ) {
1290 my $export_html = '';
1292 $export->export_getstatus( $self, \$export_html, \%hash );
1293 $html .= $export_html;
1306 my $conf = new FS::Conf;
1307 return '' unless grep { $self->table eq $_ }
1308 $conf->config('nms-auto_add-svc_ips');
1309 my $ip_field = $self->table_info->{'ip_field'};
1311 my $queue = FS::queue->new( {
1312 'job' => 'FS::NetworkMonitoringSystem::queued_add_router',
1313 'svcnum' => $self->svcnum,
1315 $queue->insert( 'FS::NetworkMonitoringSystem',
1317 $conf->config('nms-auto_add-community')
1326 #XXX not yet implemented
1329 =item search_sql_field FIELD STRING
1331 Class method which returns an SQL fragment to search for STRING in FIELD.
1333 It is now case-insensitive by default.
1337 sub search_sql_field {
1338 my( $class, $field, $string ) = @_;
1339 my $table = $class->table;
1340 my $q_string = dbh->quote($string);
1341 "LOWER($table.$field) = LOWER($q_string)";
1344 #fallback for services that don't provide a search...
1346 #my( $class, $string ) = @_;
1350 =item search HASHREF
1352 Class method which returns a qsearch hash expression to search for parameters
1353 specified in HASHREF.
1359 =item unlinked - set to search for all unlinked services. Overrides all other options.
1369 =item pkgpart - arrayref
1371 =item routernum - arrayref
1373 =item sectornum - arrayref
1375 =item towernum - arrayref
1383 # svc_broadband::search should eventually use this instead
1385 my ($class, $params) = @_;
1388 'LEFT JOIN cust_svc USING ( svcnum )',
1389 'LEFT JOIN part_svc USING ( svcpart )',
1390 'LEFT JOIN cust_pkg USING ( pkgnum )',
1391 FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg'),
1396 $class->_search_svc($params, \@from, \@where) if $class->can('_search_svc');
1399 # if ( $params->{'domain'} ) {
1400 # my $svc_domain = qsearchs('svc_domain', { 'domain'=>$params->{'domain'} } );
1401 # #preserve previous behavior & bubble up an error if $svc_domain not found?
1402 # push @where, 'domsvc = '. $svc_domain->svcnum if $svc_domain;
1406 # if ( $params->{'domsvc'} =~ /^(\d+)$/ ) {
1407 # push @where, "domsvc = $1";
1411 push @where, 'pkgnum IS NULL' if $params->{'unlinked'};
1414 if ( $params->{'agentnum'} =~ /^(\d+)$/ && $1 ) {
1415 push @where, "cust_main.agentnum = $1";
1419 if ( $params->{'custnum'} =~ /^(\d+)$/ && $1 ) {
1420 push @where, "cust_pkg.custnum = $1";
1424 if ( $params->{'cust_status'} =~ /^([a-z]+)$/ ) {
1425 push @where, FS::cust_main->cust_status_sql . " = '$1'";
1429 if ( $params->{'balance'} =~ /^\s*(\-?\d*(\.\d{1,2})?)\s*$/ && length($1) ) {
1433 if ( $params->{'balance_days'} =~ /^\s*(\d*(\.\d{1,3})?)\s*$/ && length($1) ) {
1434 $age = time - 86400 * $1;
1436 push @where, FS::cust_main->balance_date_sql($age) . " > $balance";
1440 if ( $params->{'payby'} && scalar(@{ $params->{'payby'} }) ) {
1441 my @payby = map "'$_'", grep /^(\w+)$/, @{ $params->{'payby'} };
1442 push @where, 'payby IN ('. join(',', @payby ). ')';
1446 ##pkgpart, now properly untainted, can be arrayref
1447 #for my $pkgpart ( $params->{'pkgpart'} ) {
1448 # if ( ref $pkgpart ) {
1449 # my $where = join(',', map { /^(\d+)$/ ? $1 : () } @$pkgpart );
1450 # push @where, "cust_pkg.pkgpart IN ($where)" if $where;
1452 # elsif ( $pkgpart =~ /^(\d+)$/ ) {
1453 # push @where, "cust_pkg.pkgpart = $1";
1456 if ( $params->{'pkgpart'} ) {
1457 my @pkgpart = ref( $params->{'pkgpart'} )
1458 ? @{ $params->{'pkgpart'} }
1459 : $params->{'pkgpart'}
1460 ? ( $params->{'pkgpart'} )
1462 @pkgpart = grep /^(\d+)$/, @pkgpart;
1463 push @where, 'cust_pkg.pkgpart IN ('. join(',', @pkgpart ). ')' if @pkgpart;
1467 if ( $params->{'svcnum'} =~ /^(\d+)$/ ) {
1468 push @where, "svcnum = $1";
1472 if ( $params->{'svcpart'} ) {
1473 my @svcpart = ref( $params->{'svcpart'} )
1474 ? @{ $params->{'svcpart'} }
1475 : $params->{'svcpart'}
1476 ? ( $params->{'svcpart'} )
1478 @svcpart = grep /^(\d+)$/, @svcpart;
1479 push @where, 'svcpart IN ('. join(',', @svcpart ). ')' if @svcpart;
1482 if ( $params->{'exportnum'} =~ /^(\d+)$/ ) {
1483 push @from, ' LEFT JOIN export_svc USING ( svcpart )';
1484 push @where, "exportnum = $1";
1487 # # sector and tower
1488 # my @where_sector = $class->tower_sector_sql($params);
1489 # if ( @where_sector ) {
1490 # push @where, @where_sector;
1491 # push @from, ' LEFT JOIN tower_sector USING ( sectornum )';
1494 # here is the agent virtualization
1495 #if ($params->{CurrentUser}) {
1497 # qsearchs('access_user', { username => $params->{CurrentUser} });
1499 # if ($access_user) {
1500 # push @where, $access_user->agentnums_sql('table'=>'cust_main');
1502 # push @where, "1=0";
1505 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql(
1506 'table' => 'cust_main',
1507 'null_right' => 'View/link unlinked services',
1511 push @where, @{ $params->{'where'} } if $params->{'where'};
1513 my $addl_from = join(' ', @from);
1514 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
1516 my $table = $class->table;
1518 my $count_query = "SELECT COUNT(*) FROM $table $addl_from $extra_sql";
1519 #if ( keys %svc_X ) {
1520 # $count_query .= ' WHERE '.
1521 # join(' AND ', map "$_ = ". dbh->quote($svc_X{$_}),
1529 'select' => join(', ',
1532 'cust_main.custnum',
1533 @{ $params->{'addl_select'} || [] },
1534 FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
1536 'addl_from' => $addl_from,
1537 'extra_sql' => $extra_sql,
1538 'order_by' => $params->{'order_by'},
1539 'count_query' => $count_query,
1548 The setfixed method return value.
1550 B<export> method isn't used by insert and replace methods yet.
1554 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
1555 from the base documentation.