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 if ($tinfo->{'manual_require'}) {
171 my $fields = $tinfo->{'fields'} || {};
172 foreach my $field (keys %$fields) {
173 if (ref($fields->{$field}) && $fields->{$field}->{'required'}) {
174 $required->{$field} = 1;
175 $labels->{$field} = $fields->{$field}->{'label'};
178 # add fields marked as required in database
180 qsearch('part_svc_column',{
181 'svcpart' => $self->svcpart,
185 $required->{$column->columnname} = 1;
186 $labels->{$column->columnname} = $column->columnlabel;
188 # do the actual checking
189 foreach my $field (keys %$required) {
190 unless (length($self->get($field)) > 0) {
191 my $name = $labels->{$field} || $field;
192 return "$name is required\n"
200 =item insert [ , OPTION => VALUE ... ]
202 Adds this record to the database. If there is an error, returns the error,
203 otherwise returns false.
205 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
206 defined. An FS::cust_svc record will be created and inserted.
208 Currently available options are: I<jobnums>, I<child_objects> and
211 If I<jobnum> is set to an array reference, the jobnums of any export jobs will
212 be added to the referenced array.
214 If I<child_objects> is set to an array reference of FS::tablename objects
215 (for example, FS::svc_export_machine or FS::acct_snarf objects), they
216 will have their svcnum field set and will be inserted after this record,
217 but before any exports are run. Each element of the array can also
218 optionally be a two-element array reference containing the child object
219 and the name of an alternate field to be filled in with the newly-inserted
220 svcnum, for example C<[ $svc_forward, 'srcsvc' ]>
222 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
223 jobnums), all provisioning jobs will have a dependancy on the supplied
224 jobnum(s) (they will not run until the specific job(s) complete(s)).
226 If I<export_args> is set to an array reference, the referenced list will be
227 passed to export commands.
234 warn "[$me] insert called with options ".
235 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
239 local $FS::queue::jobnums = \@jobnums;
240 warn "[$me] insert: set \$FS::queue::jobnums to $FS::queue::jobnums\n"
242 my $objects = $options{'child_objects'} || [];
243 my $depend_jobnums = $options{'depend_jobnum'} || [];
244 $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
246 local $SIG{HUP} = 'IGNORE';
247 local $SIG{INT} = 'IGNORE';
248 local $SIG{QUIT} = 'IGNORE';
249 local $SIG{TERM} = 'IGNORE';
250 local $SIG{TSTP} = 'IGNORE';
251 local $SIG{PIPE} = 'IGNORE';
253 my $oldAutoCommit = $FS::UID::AutoCommit;
254 local $FS::UID::AutoCommit = 0;
257 my $svcnum = $self->svcnum;
258 my $cust_svc = $svcnum ? qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) : '';
259 my $inserted_cust_svc = 0;
260 #unless ( $svcnum ) {
261 if ( !$svcnum or !$cust_svc ) {
262 $cust_svc = new FS::cust_svc ( {
263 #hua?# 'svcnum' => $svcnum,
264 'svcnum' => $self->svcnum,
265 'pkgnum' => $self->pkgnum,
266 'svcpart' => $self->svcpart,
268 my $error = $cust_svc->insert;
270 $dbh->rollback if $oldAutoCommit;
273 $inserted_cust_svc = 1;
274 $svcnum = $self->svcnum($cust_svc->svcnum);
276 #$cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
277 unless ( $cust_svc ) {
278 $dbh->rollback if $oldAutoCommit;
279 return "no cust_svc record found for svcnum ". $self->svcnum;
281 $self->pkgnum($cust_svc->pkgnum);
282 $self->svcpart($cust_svc->svcpart);
285 my $error = $self->preinsert_hook_first(%options)
286 || $self->set_auto_inventory
288 || $self->_check_duplicate
289 || $self->preinsert_hook
290 || $self->SUPER::insert;
292 if ( $inserted_cust_svc ) {
293 my $derror = $cust_svc->delete;
294 die $derror if $derror;
296 $dbh->rollback if $oldAutoCommit;
300 foreach my $object ( @$objects ) {
302 if ( ref($object) eq 'ARRAY' ) {
303 ($obj, $field) = @$object;
308 $obj->$field($self->svcnum);
309 $error = $obj->insert;
311 $dbh->rollback if $oldAutoCommit;
317 unless ( $noexport_hack ) {
319 warn "[$me] insert: \$FS::queue::jobnums is $FS::queue::jobnums\n"
322 my $export_args = $options{'export_args'} || [];
324 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
325 my $error = $part_export->export_insert($self, @$export_args);
327 $dbh->rollback if $oldAutoCommit;
328 return "exporting to ". $part_export->exporttype.
329 " (transaction rolled back): $error";
333 foreach my $depend_jobnum ( @$depend_jobnums ) {
334 warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
336 foreach my $jobnum ( @jobnums ) {
337 my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
338 warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
340 my $error = $queue->depend_insert($depend_jobnum);
342 $dbh->rollback if $oldAutoCommit;
343 return "error queuing job dependancy: $error";
350 my $nms_ip_error = $self->nms_ip_insert;
351 if ( $nms_ip_error ) {
352 $dbh->rollback if $oldAutoCommit;
353 return "error queuing IP insert: $nms_ip_error";
356 if ( exists $options{'jobnums'} ) {
357 push @{ $options{'jobnums'} }, @jobnums;
360 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
366 sub preinsert_hook_first { ''; }
367 sub _check_duplcate { ''; }
368 sub preinsert_hook { ''; }
369 sub table_dupcheck_fields { (); }
370 sub prereplace_hook { ''; }
371 sub prereplace_hook_first { ''; }
372 sub predelete_hook { ''; }
373 sub predelete_hook_first { ''; }
375 =item delete [ , OPTION => VALUE ... ]
377 Deletes this account from the database. If there is an error, returns the
378 error, otherwise returns false.
380 The corresponding FS::cust_svc record will be deleted as well.
387 my $export_args = $options{'export_args'} || [];
389 local $SIG{HUP} = 'IGNORE';
390 local $SIG{INT} = 'IGNORE';
391 local $SIG{QUIT} = 'IGNORE';
392 local $SIG{TERM} = 'IGNORE';
393 local $SIG{TSTP} = 'IGNORE';
394 local $SIG{PIPE} = 'IGNORE';
396 my $oldAutoCommit = $FS::UID::AutoCommit;
397 local $FS::UID::AutoCommit = 0;
400 my $error = $self->cust_svc->check_part_svc_link_unprovision
401 || $self->predelete_hook_first
402 || $self->SUPER::delete
403 || $self->export('delete', @$export_args)
404 || $self->return_inventory
405 || $self->release_router
406 || $self->predelete_hook
407 || $self->cust_svc->delete
410 $dbh->rollback if $oldAutoCommit;
414 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
421 Currently this will only run expire exports if any are attached
426 my($self,$date) = (shift,shift);
428 return 'Expire date must be specified' unless $date;
430 local $SIG{HUP} = 'IGNORE';
431 local $SIG{INT} = 'IGNORE';
432 local $SIG{QUIT} = 'IGNORE';
433 local $SIG{TERM} = 'IGNORE';
434 local $SIG{TSTP} = 'IGNORE';
435 local $SIG{PIPE} = 'IGNORE';
437 my $oldAutoCommit = $FS::UID::AutoCommit;
438 local $FS::UID::AutoCommit = 0;
441 my $export_args = [$date];
442 my $error = $self->export('expire', @$export_args);
444 $dbh->rollback if $oldAutoCommit;
448 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
453 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ]
455 Replaces OLD_RECORD with this one. If there is an error, returns the error,
456 otherwise returns false.
458 Currently available options are: I<child_objects>, I<export_args> and
461 If I<child_objects> is set to an array reference of FS::tablename objects
462 (for example, FS::svc_export_machine or FS::acct_snarf objects), they
463 will have their svcnum field set and will be inserted or replaced after
464 this record, but before any exports are run. Each element of the array
465 can also optionally be a two-element array reference containing the
466 child object and the name of an alternate field to be filled in with
467 the newly-inserted svcnum, for example C<[ $svc_forward, 'srcsvc' ]>
469 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
470 jobnums), all provisioning jobs will have a dependancy on the supplied
471 jobnum(s) (they will not run until the specific job(s) complete(s)).
473 If I<export_args> is set to an array reference, the referenced list will be
474 passed to export commands.
481 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
486 ( ref($_[0]) eq 'HASH' )
490 my $objects = $options->{'child_objects'} || [];
493 local $FS::queue::jobnums = \@jobnums;
494 warn "[$me] replace: set \$FS::queue::jobnums to $FS::queue::jobnums\n"
496 my $depend_jobnums = $options->{'depend_jobnum'} || [];
497 $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
499 local $SIG{HUP} = 'IGNORE';
500 local $SIG{INT} = 'IGNORE';
501 local $SIG{QUIT} = 'IGNORE';
502 local $SIG{TERM} = 'IGNORE';
503 local $SIG{TSTP} = 'IGNORE';
504 local $SIG{PIPE} = 'IGNORE';
506 my $oldAutoCommit = $FS::UID::AutoCommit;
507 local $FS::UID::AutoCommit = 0;
510 my $error = $new->prereplace_hook_first($old)
511 || $new->set_auto_inventory($old)
512 || $new->check; #redundant, but so any duplicate fields are
513 #maniuplated as appropriate (svc_phone.phonenum)
515 $dbh->rollback if $oldAutoCommit;
519 #if ( $old->username ne $new->username || $old->domsvc != $new->domsvc ) {
520 if ( grep { $old->$_ ne $new->$_ } $new->table_dupcheck_fields ) {
522 $new->svcpart( $new->cust_svc->svcpart ) unless $new->svcpart;
523 $error = $new->_check_duplicate;
525 $dbh->rollback if $oldAutoCommit;
530 $error = $new->SUPER::replace($old);
532 $dbh->rollback if $oldAutoCommit;
536 foreach my $object ( @$objects ) {
538 if ( ref($object) eq 'ARRAY' ) {
539 ($obj, $field) = @$object;
544 $obj->$field($new->svcnum);
546 my $oldobj = qsearchs( $obj->table, {
547 $field => $new->svcnum,
548 map { $_ => $obj->$_ } $obj->_svc_child_partfields,
552 my $pkey = $oldobj->primary_key;
553 $obj->$pkey($oldobj->$pkey);
554 $obj->replace($oldobj);
556 $error = $obj->insert;
559 $dbh->rollback if $oldAutoCommit;
565 unless ( $noexport_hack ) {
567 warn "[$me] replace: \$FS::queue::jobnums is $FS::queue::jobnums\n"
570 my $export_args = $options->{'export_args'} || [];
572 #not quite false laziness, but same pattern as FS::svc_acct::replace and
573 #FS::part_export::sqlradius::_export_replace. List::Compare or something
574 #would be useful but too much of a pain in the ass to deploy
576 my @old_part_export = $old->cust_svc->part_svc->part_export;
577 my %old_exportnum = map { $_->exportnum => 1 } @old_part_export;
578 my @new_part_export =
580 ? qsearchs('part_svc', { svcpart=>$new->svcpart } )->part_export
581 : $new->cust_svc->part_svc->part_export;
582 my %new_exportnum = map { $_->exportnum => 1 } @new_part_export;
584 foreach my $delete_part_export (
585 grep { ! $new_exportnum{$_->exportnum} } @old_part_export
587 my $error = $delete_part_export->export_delete($old, @$export_args);
589 $dbh->rollback if $oldAutoCommit;
590 return "error deleting, export to ". $delete_part_export->exporttype.
591 " (transaction rolled back): $error";
595 foreach my $replace_part_export (
596 grep { $old_exportnum{$_->exportnum} } @new_part_export
599 $replace_part_export->export_replace( $new, $old, @$export_args);
601 $dbh->rollback if $oldAutoCommit;
602 return "error exporting to ". $replace_part_export->exporttype.
603 " (transaction rolled back): $error";
607 foreach my $insert_part_export (
608 grep { ! $old_exportnum{$_->exportnum} } @new_part_export
610 my $error = $insert_part_export->export_insert($new, @$export_args );
612 $dbh->rollback if $oldAutoCommit;
613 return "error inserting export to ". $insert_part_export->exporttype.
614 " (transaction rolled back): $error";
618 foreach my $depend_jobnum ( @$depend_jobnums ) {
619 warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
621 foreach my $jobnum ( @jobnums ) {
622 my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
623 warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
625 my $error = $queue->depend_insert($depend_jobnum);
627 $dbh->rollback if $oldAutoCommit;
628 return "error queuing job dependancy: $error";
635 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
641 Sets any fixed fields for this service (see L<FS::part_svc>). If there is an
642 error, returns the error, otherwise returns the FS::part_svc object (use ref()
643 to test the return). Usually called by the check method.
649 $self->setx('F', @_);
654 Sets all fields to their defaults (see L<FS::part_svc>), overriding their
655 current values. If there is an error, returns the error, otherwise returns
656 the FS::part_svc object (use ref() to test the return).
662 $self->setx('D', @_ );
665 =item set_default_and_fixed
669 sub set_default_and_fixed {
671 $self->setx( [ 'D', 'F' ], @_ );
674 =item setx FLAG | FLAG_ARRAYREF , [ CALLBACK_HASHREF ]
676 Sets fields according to the passed in flag or arrayref of flags.
678 Optionally, a hashref of field names and callback coderefs can be passed.
679 If a coderef exists for a given field name, instead of setting the field,
680 the coderef is called with the column value (part_svc_column.columnvalue)
681 as the single parameter.
688 my @x = ref($x) ? @$x : ($x);
689 my $coderef = scalar(@_) ? shift : $self->_fieldhandlers;
692 $self->ut_numbern('svcnum')
694 return $error if $error;
696 my $part_svc = $self->part_svc;
697 return "Unknown svcpart" unless $part_svc;
699 #set default/fixed/whatever fields from part_svc
701 foreach my $part_svc_column (
702 grep { my $f = $_->columnflag; grep { $f eq $_ } @x } #columnflag in @x
703 $part_svc->all_part_svc_column
706 my $columnname = $part_svc_column->columnname;
707 my $columnvalue = $part_svc_column->columnvalue;
709 $columnvalue = &{ $coderef->{$columnname} }( $self, $columnvalue )
710 if exists( $coderef->{$columnname} );
711 $self->setfield( $columnname, $columnvalue );
722 cluck 'svc_X->part_svc called' if $DEBUG;
726 if ( $self->get('svcpart') ) {
727 $svcpart = $self->get('svcpart');
728 } elsif ( $self->svcnum && qsearchs('cust_svc', {'svcnum'=>$self->svcnum}) ) {
729 my $cust_svc = $self->cust_svc;
730 return "Unknown svcnum" unless $cust_svc;
731 $svcpart = $cust_svc->svcpart;
734 qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
740 Returns the FS::svc_pbx record for this service, if any (see L<FS::svc_pbx>).
742 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
747 # XXX FS::h_svc_{acct,phone} could have a history-aware svc_pbx override
751 return '' unless $self->pbxsvc;
752 qsearchs( 'svc_pbx', { 'svcnum' => $self->pbxsvc } );
757 Returns the title of the FS::svc_pbx record associated with this service, if
760 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
767 my $svc_pbx = $self->svc_pbx or return '';
771 =item pbx_select_hash %OPTIONS
773 Can be called as an object method or a class method.
775 Returns a hash SVCNUM => TITLE ... representing the PBXes this customer
776 that may be associated with this service.
778 Currently available options are: I<pkgnum> I<svcpart>
780 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
785 #false laziness w/svc_acct::domain_select_hash
786 sub pbx_select_hash {
787 my ($self, %options) = @_;
793 $part_svc = $self->part_svc;
794 $cust_pkg = $self->cust_svc->cust_pkg
798 $part_svc = qsearchs('part_svc', { 'svcpart' => $options{svcpart} })
799 if $options{'svcpart'};
801 $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $options{pkgnum} })
802 if $options{'pkgnum'};
804 if ($part_svc && ( $part_svc->part_svc_column('pbxsvc')->columnflag eq 'S'
805 || $part_svc->part_svc_column('pbxsvc')->columnflag eq 'F')) {
806 %pbxes = map { $_->svcnum => $_->title }
807 map { qsearchs('svc_pbx', { 'svcnum' => $_ }) }
808 split(',', $part_svc->part_svc_column('pbxsvc')->columnvalue);
809 } elsif ($cust_pkg) { # && !$conf->exists('svc_acct-alldomains') ) {
810 %pbxes = map { $_->svcnum => $_->title }
811 map { qsearchs('svc_pbx', { 'svcnum' => $_->svcnum }) }
812 map { qsearch('cust_svc', { 'pkgnum' => $_->pkgnum } ) }
813 qsearch('cust_pkg', { 'custnum' => $cust_pkg->custnum });
816 %pbxes = map { $_->svcnum => $_->title } qsearch('svc_pbx', {} );
819 if ($part_svc && $part_svc->part_svc_column('pbxsvc')->columnflag eq 'D') {
820 my $svc_pbx = qsearchs('svc_pbx',
821 { 'svcnum' => $part_svc->part_svc_column('pbxsvc')->columnvalue } );
823 $pbxes{$svc_pbx->svcnum} = $svc_pbx->title;
825 warn "unknown svc_pbx.svcnum for part_svc_column pbxsvc: ".
826 $part_svc->part_svc_column('pbxsvc')->columnvalue;
835 =item set_auto_inventory
837 Sets any fields which auto-populate from inventory (see L<FS::part_svc>), and
838 also check any manually populated inventory fields.
840 If there is an error, returns the error, otherwise returns false.
844 sub set_auto_inventory {
845 # don't try to do this during an upgrade
846 return '' if $FS::CurrentUser::upgrade_hack;
849 my $old = @_ ? shift : '';
852 $self->ut_numbern('svcnum')
854 return $error if $error;
856 my $part_svc = $self->part_svc;
857 return "Unkonwn svcpart" unless $part_svc;
859 local $SIG{HUP} = 'IGNORE';
860 local $SIG{INT} = 'IGNORE';
861 local $SIG{QUIT} = 'IGNORE';
862 local $SIG{TERM} = 'IGNORE';
863 local $SIG{TSTP} = 'IGNORE';
864 local $SIG{PIPE} = 'IGNORE';
866 my $oldAutoCommit = $FS::UID::AutoCommit;
867 local $FS::UID::AutoCommit = 0;
870 #set default/fixed/whatever fields from part_svc
871 my $table = $self->table;
872 foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
874 my $part_svc_column = $part_svc->part_svc_column($field);
875 my $columnflag = $part_svc_column->columnflag;
876 next unless $columnflag =~ /^[AM]$/;
878 next if $columnflag eq 'A' && $self->$field() ne '';
880 my $classnum = $part_svc_column->columnvalue;
883 if ( $columnflag eq 'A' && $self->$field() eq '' ) {
884 $hash{'svcnum'} = '';
885 } elsif ( $columnflag eq 'M' ) {
886 return "Select inventory item for $field" unless $self->getfield($field);
887 $hash{'item'} = $self->getfield($field);
888 my $chosen_classnum = $self->getfield($field.'_classnum');
889 if ( grep {$_ == $chosen_classnum} split(',', $classnum) ) {
890 $classnum = $chosen_classnum;
892 # otherwise the chosen classnum is either (all), or somehow not on
893 # the list, so ignore it and choose the first item that's in any
897 my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql(
899 'table' => 'inventory_item',
902 my $inventory_item = qsearchs({
903 'table' => 'inventory_item',
905 'extra_sql' => "AND classnum IN ($classnum) AND $agentnums_sql",
906 'order_by' => 'ORDER BY ( agentnum IS NULL ) '. #agent inventory first
907 ' LIMIT 1 FOR UPDATE',
910 unless ( $inventory_item ) {
911 # should really only be shown if columnflag eq 'A'...
912 $dbh->rollback if $oldAutoCommit;
913 my $message = 'Out of ';
914 my @classnums = split(',', $classnum);
915 foreach ( @classnums ) {
916 my $class = FS::inventory_class->by_key($_)
917 or return "Can't find inventory_class.classnum $_";
918 $message .= PL_N($class->classname);
919 if ( scalar(@classnums) > 2 ) { # english is hard
920 if ( $_ != $classnums[-1] ) {
924 if ( scalar(@classnums) > 1 and $_ == $classnums[-2] ) {
931 next if $columnflag eq 'M' && $inventory_item->svcnum == $self->svcnum;
933 $self->setfield( $field, $inventory_item->item );
934 #if $columnflag eq 'A' && $self->$field() eq '';
936 # release the old inventory item, if there was one
937 if ( $old && $old->$field() && $old->$field() ne $self->$field() ) {
938 my $old_inv = qsearchs({
939 'table' => 'inventory_item',
941 'svcnum' => $old->svcnum,
943 'extra_sql' => "AND classnum IN ($classnum) AND ".
944 '( ( svc_field IS NOT NULL AND svc_field = '.$dbh->quote($field).' )'.
945 ' OR ( svc_field IS NULL AND item = '. dbh->quote($old->$field).' )'.
949 $old_inv->svcnum('');
950 $old_inv->svc_field('');
951 my $oerror = $old_inv->replace;
953 $dbh->rollback if $oldAutoCommit;
954 return "Error unprovisioning inventory: $oerror";
957 warn "old inventory_item not found for $field ". $self->$field;
961 $inventory_item->svcnum( $self->svcnum );
962 $inventory_item->svc_field( $field );
963 my $ierror = $inventory_item->replace();
965 $dbh->rollback if $oldAutoCommit;
966 return "Error provisioning inventory: $ierror";
971 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
977 =item return_inventory
979 Release all inventory items attached to this service's fields. Call
980 when unprovisioning the service.
984 sub return_inventory {
987 local $SIG{HUP} = 'IGNORE';
988 local $SIG{INT} = 'IGNORE';
989 local $SIG{QUIT} = 'IGNORE';
990 local $SIG{TERM} = 'IGNORE';
991 local $SIG{TSTP} = 'IGNORE';
992 local $SIG{PIPE} = 'IGNORE';
994 my $oldAutoCommit = $FS::UID::AutoCommit;
995 local $FS::UID::AutoCommit = 0;
998 foreach my $inventory_item ( $self->inventory_item ) {
999 $inventory_item->svcnum('');
1000 $inventory_item->svc_field('');
1001 my $error = $inventory_item->replace();
1003 $dbh->rollback if $oldAutoCommit;
1004 return "Error returning inventory: $error";
1008 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1013 =item inventory_item
1015 Returns the inventory items associated with this svc_ record, as
1016 FS::inventory_item objects (see L<FS::inventory_item>.
1020 sub inventory_item {
1023 'table' => 'inventory_item',
1024 'hashref' => { 'svcnum' => $self->svcnum, },
1028 =item release_router
1030 Delete any routers associated with this service. This will release their
1031 address blocks, also.
1035 sub release_router {
1037 my @routers = qsearch('router', { svcnum => $self->svcnum });
1038 foreach (@routers) {
1039 my $error = $_->delete;
1040 return "$error (removing router '".$_->routername."')" if $error;
1048 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
1049 object (see L<FS::cust_svc>).
1053 Runs export_suspend callbacks.
1060 my $export_args = $options{'export_args'} || [];
1061 $self->export('suspend', @$export_args);
1066 Runs export_unsuspend callbacks.
1073 my $export_args = $options{'export_args'} || [];
1074 $self->export('unsuspend', @$export_args);
1079 Runs export_links callbacks and returns the links.
1086 $self->export('links', $return);
1090 =item export_getsettings
1092 Runs export_getsettings callbacks and returns the two hashrefs.
1096 sub export_getsettings {
1100 my $error = $self->export('getsettings', \%settings, \%defaults);
1102 warn "error running export_getsetings: $error";
1103 return ( { 'error' => $error }, {} );
1105 ( \%settings, \%defaults );
1108 =item export_getstatus
1110 Runs export_getstatus callbacks and returns a two item list consisting of an
1111 HTML status and a status hashref.
1115 sub export_getstatus {
1119 my $error = $self->export('getstatus', \$html, \%hash);
1121 warn "error running export_getstatus: $error";
1122 return ( '', { 'error' => $error } );
1127 =item export_setstatus
1129 Runs export_setstatus callbacks. If there is an error, returns the error,
1130 otherwise returns false.
1134 sub export_setstatus { shift->_export_setstatus_X('setstatus', @_) }
1135 sub export_setstatus_listadd { shift->_export_setstatus_X('setstatus_listadd', @_) }
1136 sub export_setstatus_listdel { shift->_export_setstatus_X('setstatus_listdel', @_) }
1137 sub export_setstatus_vacationadd { shift->_export_setstatus_X('setstatus_vacationadd', @_) }
1138 sub export_setstatus_vacationdel { shift->_export_setstatus_X('setstatus_vacationdel', @_) }
1140 sub _export_setstatus_X {
1141 my( $self, $method, @args ) = @_;
1142 my $error = $self->export($method, @args);
1144 warn "error running export_$method: $error";
1150 =item export HOOK [ EXPORT_ARGS ]
1152 Runs the provided export hook (i.e. "suspend", "unsuspend") for this service.
1157 my( $self, $method ) = ( shift, shift );
1159 # $method must start with export_, $action must be the part after that
1160 $method = "export_$method" unless $method =~ /^export_/;
1161 my ($action) = $method =~ /^export_(\w+)/;
1163 local $SIG{HUP} = 'IGNORE';
1164 local $SIG{INT} = 'IGNORE';
1165 local $SIG{QUIT} = 'IGNORE';
1166 local $SIG{TERM} = 'IGNORE';
1167 local $SIG{TSTP} = 'IGNORE';
1168 local $SIG{PIPE} = 'IGNORE';
1170 my $oldAutoCommit = $FS::UID::AutoCommit;
1171 local $FS::UID::AutoCommit = 0;
1175 unless ( $noexport_hack ) {
1176 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
1177 next unless $part_export->can($method);
1178 next if $part_export->get("no_$action"); # currently only 'no_suspend'
1179 my $error = $part_export->$method($self, @_);
1181 $dbh->rollback if $oldAutoCommit;
1182 return "error exporting $method event to ". $part_export->exporttype.
1183 " (transaction rolled back): $error";
1188 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1195 Sets or retrieves overlimit date.
1201 #$self->cust_svc->overlimit(@_);
1202 my $cust_svc = $self->cust_svc;
1203 unless ( $cust_svc ) { #wtf?
1204 my $error = "$me overlimit: missing cust_svc record for svc_acct svcnum ".
1206 if ( $overlimit_missing_cust_svc_nonfatal_kludge ) {
1207 cluck "$error; continuing anyway as requested";
1213 $cust_svc->overlimit(@_);
1218 Stub - returns false (no error) so derived classes don't need to define this
1219 methods. Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
1221 This method is called *before* the deletion step which actually deletes the
1222 services. This method should therefore only be used for "pre-deletion"
1223 cancellation steps, if necessary.
1229 =item clone_suspended
1231 Constructor used by FS::part_export::_export_suspend fallback. Stub returning
1232 same object for svc_ classes which don't implement a suspension fallback
1233 (everything except svc_acct at the moment). Document better.
1237 sub clone_suspended {
1241 =item clone_kludge_unsuspend
1243 Constructor used by FS::part_export::_export_unsuspend fallback. Stub returning
1244 same object for svc_ classes which don't implement a suspension fallback
1245 (everything except svc_acct at the moment). Document better.
1249 sub clone_kludge_unsuspend {
1253 =item find_duplicates MODE FIELDS...
1255 Method used by _check_duplicate routines to find services with duplicate
1256 values in specified fields. Set MODE to 'global' to search across all
1257 services, or 'export' to limit to those that share one or more exports
1258 with this service. FIELDS is a list of field names; only services
1259 matching in all fields will be returned. Empty fields will be skipped.
1263 sub find_duplicates {
1268 my %search = map { $_ => $self->getfield($_) }
1269 grep { length($self->getfield($_)) } @fields;
1270 return () if !%search;
1271 my @dup = grep { ! $self->svcnum or $_->svcnum != $self->svcnum }
1272 qsearch( $self->table, \%search );
1274 return @dup if $mode eq 'global';
1275 die "incorrect find_duplicates mode '$mode'" if $mode ne 'export';
1277 my $exports = FS::part_export::export_info($self->table);
1278 my %conflict_svcparts;
1279 my $part_svc = $self->part_svc;
1280 foreach my $part_export ( $part_svc->part_export ) {
1281 %conflict_svcparts = map { $_->svcpart => 1 } $part_export->export_svc;
1283 return grep { $conflict_svcparts{$_->cust_svc->svcpart} } @dup;
1286 =item getstatus_html
1290 sub getstatus_html {
1293 my $part_svc = $self->cust_svc->part_svc;
1297 foreach my $export ( grep $_->can('export_getstatus'), $part_svc->part_export ) {
1298 my $export_html = '';
1300 $export->export_getstatus( $self, \$export_html, \%hash );
1301 $html .= $export_html;
1314 my $conf = new FS::Conf;
1315 return '' unless grep { $self->table eq $_ }
1316 $conf->config('nms-auto_add-svc_ips');
1317 my $ip_field = $self->table_info->{'ip_field'};
1319 my $queue = FS::queue->new( {
1320 'job' => 'FS::NetworkMonitoringSystem::queued_add_router',
1321 'svcnum' => $self->svcnum,
1323 $queue->insert( 'FS::NetworkMonitoringSystem',
1325 $conf->config('nms-auto_add-community')
1334 #XXX not yet implemented
1337 =item search_sql_field FIELD STRING
1339 Class method which returns an SQL fragment to search for STRING in FIELD.
1341 It is now case-insensitive by default.
1345 sub search_sql_field {
1346 my( $class, $field, $string ) = @_;
1347 my $table = $class->table;
1348 my $q_string = dbh->quote($string);
1349 "LOWER($table.$field) = LOWER($q_string)";
1352 #fallback for services that don't provide a search...
1354 #my( $class, $string ) = @_;
1357 sub search_sql_addl_from {
1361 =item search HASHREF
1363 Class method which returns a qsearch hash expression to search for parameters
1364 specified in HASHREF.
1370 =item unlinked - set to search for all unlinked services. Overrides all other options.
1380 =item pkgpart - arrayref
1382 =item routernum - arrayref
1384 =item sectornum - arrayref
1386 =item towernum - arrayref
1390 =item cancelled - if true, only returns svcs attached to cancelled pkgs;
1391 if defined and false, only returns svcs not attached to cancelled packages
1397 ### Don't call the 'cancelled' option 'Service Status'
1398 ### There is no such thing
1399 ### See cautionary note in httemplate/browse/part_svc.cgi
1402 my ($class, $params) = @_;
1405 'LEFT JOIN cust_svc USING ( svcnum )',
1406 'LEFT JOIN part_svc USING ( svcpart )',
1407 'LEFT JOIN cust_pkg USING ( pkgnum )',
1408 FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg'),
1413 $class->_search_svc($params, \@from, \@where) if $class->can('_search_svc');
1416 # if ( $params->{'domain'} ) {
1417 # my $svc_domain = qsearchs('svc_domain', { 'domain'=>$params->{'domain'} } );
1418 # #preserve previous behavior & bubble up an error if $svc_domain not found?
1419 # push @where, 'domsvc = '. $svc_domain->svcnum if $svc_domain;
1423 # if ( $params->{'domsvc'} =~ /^(\d+)$/ ) {
1424 # push @where, "domsvc = $1";
1428 push @where, 'pkgnum IS NULL' if $params->{'unlinked'};
1431 if ( $params->{'agentnum'} =~ /^(\d+)$/ && $1 ) {
1432 push @where, "cust_main.agentnum = $1";
1436 if ( $params->{'custnum'} =~ /^(\d+)$/ && $1 ) {
1437 push @where, "cust_pkg.custnum = $1";
1441 if ( $params->{'cust_status'} =~ /^([a-z]+)$/ ) {
1442 push @where, FS::cust_main->cust_status_sql . " = '$1'";
1446 if ( $params->{'balance'} =~ /^\s*(\-?\d*(\.\d{1,2})?)\s*$/ && length($1) ) {
1450 if ( $params->{'balance_days'} =~ /^\s*(\d*(\.\d{1,3})?)\s*$/ && length($1) ) {
1451 $age = time - 86400 * $1;
1453 push @where, FS::cust_main->balance_date_sql($age) . " > $balance";
1457 if ( $params->{'payby'} && scalar(@{ $params->{'payby'} }) ) {
1458 my @payby = map "'$_'", grep /^(\w+)$/, @{ $params->{'payby'} };
1459 push @where, 'payby IN ('. join(',', @payby ). ')';
1463 ##pkgpart, now properly untainted, can be arrayref
1464 #for my $pkgpart ( $params->{'pkgpart'} ) {
1465 # if ( ref $pkgpart ) {
1466 # my $where = join(',', map { /^(\d+)$/ ? $1 : () } @$pkgpart );
1467 # push @where, "cust_pkg.pkgpart IN ($where)" if $where;
1469 # elsif ( $pkgpart =~ /^(\d+)$/ ) {
1470 # push @where, "cust_pkg.pkgpart = $1";
1473 if ( $params->{'pkgpart'} ) {
1474 my @pkgpart = ref( $params->{'pkgpart'} )
1475 ? @{ $params->{'pkgpart'} }
1476 : $params->{'pkgpart'}
1477 ? ( $params->{'pkgpart'} )
1479 @pkgpart = grep /^(\d+)$/, @pkgpart;
1480 push @where, 'cust_pkg.pkgpart IN ('. join(',', @pkgpart ). ')' if @pkgpart;
1484 if ( $params->{'svcnum'} =~ /^(\d+)$/ ) {
1485 push @where, "svcnum = $1";
1489 if ( $params->{'svcpart'} ) {
1490 my @svcpart = ref( $params->{'svcpart'} )
1491 ? @{ $params->{'svcpart'} }
1492 : $params->{'svcpart'}
1493 ? ( $params->{'svcpart'} )
1495 @svcpart = grep /^(\d+)$/, @svcpart;
1496 push @where, 'svcpart IN ('. join(',', @svcpart ). ')' if @svcpart;
1499 if ( $params->{'exportnum'} =~ /^(\d+)$/ ) {
1500 push @from, ' LEFT JOIN export_svc USING ( svcpart )';
1501 push @where, "exportnum = $1";
1504 if ( defined($params->{'cancelled'}) ) {
1505 if ($params->{'cancelled'}) {
1506 push @where, "cust_pkg.cancel IS NOT NULL";
1508 push @where, "cust_pkg.cancel IS NULL";
1512 # # sector and tower
1513 # my @where_sector = $class->tower_sector_sql($params);
1514 # if ( @where_sector ) {
1515 # push @where, @where_sector;
1516 # push @from, ' LEFT JOIN tower_sector USING ( sectornum )';
1519 # here is the agent virtualization
1520 #if ($params->{CurrentUser}) {
1522 # qsearchs('access_user', { username => $params->{CurrentUser} });
1524 # if ($access_user) {
1525 # push @where, $access_user->agentnums_sql('table'=>'cust_main');
1527 # push @where, "1=0";
1530 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql(
1531 'table' => 'cust_main',
1532 'null_right' => 'View/link unlinked services',
1536 push @where, @{ $params->{'where'} } if $params->{'where'};
1538 my $addl_from = join(' ', @from);
1539 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
1541 my $table = $class->table;
1543 my $count_query = "SELECT COUNT(*) FROM $table $addl_from $extra_sql";
1544 #if ( keys %svc_X ) {
1545 # $count_query .= ' WHERE '.
1546 # join(' AND ', map "$_ = ". dbh->quote($svc_X{$_}),
1554 'select' => join(', ',
1557 'cust_main.custnum',
1558 @{ $params->{'addl_select'} || [] },
1559 FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
1561 'addl_from' => $addl_from,
1562 'extra_sql' => $extra_sql,
1563 'order_by' => $params->{'order_by'},
1564 'count_query' => $count_query,
1573 The setfixed method return value.
1575 B<export> method isn't used by insert and replace methods yet.
1579 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
1580 from the base documentation.