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.
480 $noexport_hack = $new->no_export if $new->no_export;
482 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
487 ( ref($_[0]) eq 'HASH' )
491 my $objects = $options->{'child_objects'} || [];
494 local $FS::queue::jobnums = \@jobnums;
495 warn "[$me] replace: set \$FS::queue::jobnums to $FS::queue::jobnums\n"
497 my $depend_jobnums = $options->{'depend_jobnum'} || [];
498 $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
500 local $SIG{HUP} = 'IGNORE';
501 local $SIG{INT} = 'IGNORE';
502 local $SIG{QUIT} = 'IGNORE';
503 local $SIG{TERM} = 'IGNORE';
504 local $SIG{TSTP} = 'IGNORE';
505 local $SIG{PIPE} = 'IGNORE';
507 my $oldAutoCommit = $FS::UID::AutoCommit;
508 local $FS::UID::AutoCommit = 0;
511 my $error = $new->prereplace_hook_first($old)
512 || $new->set_auto_inventory($old)
513 || $new->check; #redundant, but so any duplicate fields are
514 #maniuplated as appropriate (svc_phone.phonenum)
516 $dbh->rollback if $oldAutoCommit;
520 #if ( $old->username ne $new->username || $old->domsvc != $new->domsvc ) {
521 if ( grep { $old->$_ ne $new->$_ } $new->table_dupcheck_fields ) {
523 $new->svcpart( $new->cust_svc->svcpart ) unless $new->svcpart;
524 $error = $new->_check_duplicate;
526 $dbh->rollback if $oldAutoCommit;
531 $error = $new->SUPER::replace($old);
533 $dbh->rollback if $oldAutoCommit;
537 foreach my $object ( @$objects ) {
539 if ( ref($object) eq 'ARRAY' ) {
540 ($obj, $field) = @$object;
545 $obj->$field($new->svcnum);
547 my $oldobj = qsearchs( $obj->table, {
548 $field => $new->svcnum,
549 map { $_ => $obj->$_ } $obj->_svc_child_partfields,
553 my $pkey = $oldobj->primary_key;
554 $obj->$pkey($oldobj->$pkey);
555 $obj->replace($oldobj);
557 $error = $obj->insert;
560 $dbh->rollback if $oldAutoCommit;
566 unless ( $noexport_hack ) {
568 warn "[$me] replace: \$FS::queue::jobnums is $FS::queue::jobnums\n"
571 my $export_args = $options->{'export_args'} || [];
573 #not quite false laziness, but same pattern as FS::svc_acct::replace and
574 #FS::part_export::sqlradius::_export_replace. List::Compare or something
575 #would be useful but too much of a pain in the ass to deploy
577 my @old_part_export = $old->cust_svc->part_svc->part_export;
578 my %old_exportnum = map { $_->exportnum => 1 } @old_part_export;
579 my @new_part_export =
581 ? qsearchs('part_svc', { svcpart=>$new->svcpart } )->part_export
582 : $new->cust_svc->part_svc->part_export;
583 my %new_exportnum = map { $_->exportnum => 1 } @new_part_export;
585 foreach my $delete_part_export (
586 grep { ! $new_exportnum{$_->exportnum} } @old_part_export
588 my $error = $delete_part_export->export_delete($old, @$export_args);
590 $dbh->rollback if $oldAutoCommit;
591 return "error deleting, export to ". $delete_part_export->exporttype.
592 " (transaction rolled back): $error";
596 foreach my $replace_part_export (
597 grep { $old_exportnum{$_->exportnum} } @new_part_export
600 $replace_part_export->export_replace( $new, $old, @$export_args);
602 $dbh->rollback if $oldAutoCommit;
603 return "error exporting to ". $replace_part_export->exporttype.
604 " (transaction rolled back): $error";
608 foreach my $insert_part_export (
609 grep { ! $old_exportnum{$_->exportnum} } @new_part_export
611 my $error = $insert_part_export->export_insert($new, @$export_args );
613 $dbh->rollback if $oldAutoCommit;
614 return "error inserting export to ". $insert_part_export->exporttype.
615 " (transaction rolled back): $error";
619 foreach my $depend_jobnum ( @$depend_jobnums ) {
620 warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
622 foreach my $jobnum ( @jobnums ) {
623 my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
624 warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
626 my $error = $queue->depend_insert($depend_jobnum);
628 $dbh->rollback if $oldAutoCommit;
629 return "error queuing job dependancy: $error";
636 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
642 Sets any fixed fields for this service (see L<FS::part_svc>). If there is an
643 error, returns the error, otherwise returns the FS::part_svc object (use ref()
644 to test the return). Usually called by the check method.
650 $self->setx('F', @_);
655 Sets all fields to their defaults (see L<FS::part_svc>), overriding their
656 current values. If there is an error, returns the error, otherwise returns
657 the FS::part_svc object (use ref() to test the return).
663 $self->setx('D', @_ );
666 =item set_default_and_fixed
670 sub set_default_and_fixed {
672 $self->setx( [ 'D', 'F' ], @_ );
675 =item setx FLAG | FLAG_ARRAYREF , [ CALLBACK_HASHREF ]
677 Sets fields according to the passed in flag or arrayref of flags.
679 Optionally, a hashref of field names and callback coderefs can be passed.
680 If a coderef exists for a given field name, instead of setting the field,
681 the coderef is called with the column value (part_svc_column.columnvalue)
682 as the single parameter.
689 my @x = ref($x) ? @$x : ($x);
690 my $coderef = scalar(@_) ? shift : $self->_fieldhandlers;
693 $self->ut_numbern('svcnum')
695 return $error if $error;
697 my $part_svc = $self->part_svc;
698 return "Unknown svcpart" unless $part_svc;
700 #set default/fixed/whatever fields from part_svc
702 foreach my $part_svc_column (
703 grep { my $f = $_->columnflag; grep { $f eq $_ } @x } #columnflag in @x
704 $part_svc->all_part_svc_column
707 my $columnname = $part_svc_column->columnname;
708 my $columnvalue = $part_svc_column->columnvalue;
710 $columnvalue = &{ $coderef->{$columnname} }( $self, $columnvalue )
711 if exists( $coderef->{$columnname} );
712 $self->setfield( $columnname, $columnvalue );
725 if ( $self->get('svcpart') ) {
726 $svcpart = $self->get('svcpart');
727 } elsif ( $self->svcnum && qsearchs('cust_svc', {'svcnum'=>$self->svcnum}) ) {
728 my $cust_svc = $self->cust_svc;
729 return "Unknown svcnum" unless $cust_svc;
730 $svcpart = $cust_svc->svcpart;
733 qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
739 Returns the FS::svc_pbx record for this service, if any (see L<FS::svc_pbx>).
741 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
746 # XXX FS::h_svc_{acct,phone} could have a history-aware svc_pbx override
750 return '' unless $self->pbxsvc;
751 qsearchs( 'svc_pbx', { 'svcnum' => $self->pbxsvc } );
756 Returns the title of the FS::svc_pbx record associated with this service, if
759 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
766 my $svc_pbx = $self->svc_pbx or return '';
770 =item pbx_select_hash %OPTIONS
772 Can be called as an object method or a class method.
774 Returns a hash SVCNUM => TITLE ... representing the PBXes this customer
775 that may be associated with this service.
777 Currently available options are: I<pkgnum> I<svcpart>
779 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
784 #false laziness w/svc_acct::domain_select_hash
785 sub pbx_select_hash {
786 my ($self, %options) = @_;
792 $part_svc = $self->part_svc;
793 $cust_pkg = $self->cust_svc->cust_pkg
797 $part_svc = qsearchs('part_svc', { 'svcpart' => $options{svcpart} })
798 if $options{'svcpart'};
800 $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $options{pkgnum} })
801 if $options{'pkgnum'};
803 if ($part_svc && ( $part_svc->part_svc_column('pbxsvc')->columnflag eq 'S'
804 || $part_svc->part_svc_column('pbxsvc')->columnflag eq 'F')) {
805 %pbxes = map { $_->svcnum => $_->title }
806 map { qsearchs('svc_pbx', { 'svcnum' => $_ }) }
807 split(',', $part_svc->part_svc_column('pbxsvc')->columnvalue);
808 } elsif ($cust_pkg) { # && !$conf->exists('svc_acct-alldomains') ) {
809 %pbxes = map { $_->svcnum => $_->title }
810 map { qsearchs('svc_pbx', { 'svcnum' => $_->svcnum }) }
811 map { qsearch('cust_svc', { 'pkgnum' => $_->pkgnum } ) }
812 qsearch('cust_pkg', { 'custnum' => $cust_pkg->custnum });
815 %pbxes = map { $_->svcnum => $_->title } qsearch('svc_pbx', {} );
818 if ($part_svc && $part_svc->part_svc_column('pbxsvc')->columnflag eq 'D') {
819 my $svc_pbx = qsearchs('svc_pbx',
820 { 'svcnum' => $part_svc->part_svc_column('pbxsvc')->columnvalue } );
822 $pbxes{$svc_pbx->svcnum} = $svc_pbx->title;
824 warn "unknown svc_pbx.svcnum for part_svc_column pbxsvc: ".
825 $part_svc->part_svc_column('pbxsvc')->columnvalue;
834 =item set_auto_inventory
836 Sets any fields which auto-populate from inventory (see L<FS::part_svc>), and
837 also check any manually populated inventory fields.
839 If there is an error, returns the error, otherwise returns false.
843 sub set_auto_inventory {
844 # don't try to do this during an upgrade
845 return '' if $FS::CurrentUser::upgrade_hack;
848 my $old = @_ ? shift : '';
851 $self->ut_numbern('svcnum')
853 return $error if $error;
855 my $part_svc = $self->part_svc;
856 return "Unkonwn svcpart" unless $part_svc;
858 local $SIG{HUP} = 'IGNORE';
859 local $SIG{INT} = 'IGNORE';
860 local $SIG{QUIT} = 'IGNORE';
861 local $SIG{TERM} = 'IGNORE';
862 local $SIG{TSTP} = 'IGNORE';
863 local $SIG{PIPE} = 'IGNORE';
865 my $oldAutoCommit = $FS::UID::AutoCommit;
866 local $FS::UID::AutoCommit = 0;
869 #set default/fixed/whatever fields from part_svc
870 my $table = $self->table;
871 foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
873 my $part_svc_column = $part_svc->part_svc_column($field);
874 my $columnflag = $part_svc_column->columnflag;
875 next unless $columnflag =~ /^[AM]$/;
877 next if $columnflag eq 'A' && $self->$field() ne '';
879 my $classnum = $part_svc_column->columnvalue;
882 if ( $columnflag eq 'A' && $self->$field() eq '' ) {
883 $hash{'svcnum'} = '';
884 } elsif ( $columnflag eq 'M' ) {
885 return "Select inventory item for $field" unless $self->getfield($field);
886 $hash{'item'} = $self->getfield($field);
887 my $chosen_classnum = $self->getfield($field.'_classnum');
888 if ( grep {$_ == $chosen_classnum} split(',', $classnum) ) {
889 $classnum = $chosen_classnum;
891 # otherwise the chosen classnum is either (all), or somehow not on
892 # the list, so ignore it and choose the first item that's in any
896 my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql(
898 'table' => 'inventory_item',
901 my $inventory_item = qsearchs({
902 'table' => 'inventory_item',
904 'extra_sql' => "AND classnum IN ($classnum) AND $agentnums_sql",
905 'order_by' => 'ORDER BY ( agentnum IS NULL ) '. #agent inventory first
906 ' LIMIT 1 FOR UPDATE',
909 unless ( $inventory_item ) {
910 # should really only be shown if columnflag eq 'A'...
911 $dbh->rollback if $oldAutoCommit;
912 my $message = 'Out of ';
913 my @classnums = split(',', $classnum);
914 foreach ( @classnums ) {
915 my $class = FS::inventory_class->by_key($_)
916 or return "Can't find inventory_class.classnum $_";
917 $message .= PL_N($class->classname);
918 if ( scalar(@classnums) > 2 ) { # english is hard
919 if ( $_ != $classnums[-1] ) {
923 if ( scalar(@classnums) > 1 and $_ == $classnums[-2] ) {
930 next if $columnflag eq 'M' && $inventory_item->svcnum == $self->svcnum;
932 $self->setfield( $field, $inventory_item->item );
933 #if $columnflag eq 'A' && $self->$field() eq '';
935 # release the old inventory item, if there was one
936 if ( $old && $old->$field() && $old->$field() ne $self->$field() ) {
937 my $old_inv = qsearchs({
938 'table' => 'inventory_item',
940 'svcnum' => $old->svcnum,
942 'extra_sql' => "AND classnum IN ($classnum) AND ".
943 '( ( svc_field IS NOT NULL AND svc_field = '.$dbh->quote($field).' )'.
944 ' OR ( svc_field IS NULL AND item = '. dbh->quote($old->$field).' )'.
948 $old_inv->svcnum('');
949 $old_inv->svc_field('');
950 my $oerror = $old_inv->replace;
952 $dbh->rollback if $oldAutoCommit;
953 return "Error unprovisioning inventory: $oerror";
956 warn "old inventory_item not found for $field ". $self->$field;
960 $inventory_item->svcnum( $self->svcnum );
961 $inventory_item->svc_field( $field );
962 my $ierror = $inventory_item->replace();
964 $dbh->rollback if $oldAutoCommit;
965 return "Error provisioning inventory: $ierror";
970 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
976 =item return_inventory
978 Release all inventory items attached to this service's fields. Call
979 when unprovisioning the service.
983 sub return_inventory {
986 local $SIG{HUP} = 'IGNORE';
987 local $SIG{INT} = 'IGNORE';
988 local $SIG{QUIT} = 'IGNORE';
989 local $SIG{TERM} = 'IGNORE';
990 local $SIG{TSTP} = 'IGNORE';
991 local $SIG{PIPE} = 'IGNORE';
993 my $oldAutoCommit = $FS::UID::AutoCommit;
994 local $FS::UID::AutoCommit = 0;
997 foreach my $inventory_item ( $self->inventory_item ) {
998 $inventory_item->svcnum('');
999 $inventory_item->svc_field('');
1000 my $error = $inventory_item->replace();
1002 $dbh->rollback if $oldAutoCommit;
1003 return "Error returning inventory: $error";
1007 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1012 =item inventory_item
1014 Returns the inventory items associated with this svc_ record, as
1015 FS::inventory_item objects (see L<FS::inventory_item>.
1019 sub inventory_item {
1022 'table' => 'inventory_item',
1023 'hashref' => { 'svcnum' => $self->svcnum, },
1027 =item release_router
1029 Delete any routers associated with this service. This will release their
1030 address blocks, also.
1034 sub release_router {
1036 my @routers = qsearch('router', { svcnum => $self->svcnum });
1037 foreach (@routers) {
1038 my $error = $_->delete;
1039 return "$error (removing router '".$_->routername."')" if $error;
1047 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
1048 object (see L<FS::cust_svc>).
1052 Runs export_suspend callbacks.
1059 my $export_args = $options{'export_args'} || [];
1060 $self->export('suspend', @$export_args);
1065 Runs export_unsuspend callbacks.
1072 my $export_args = $options{'export_args'} || [];
1073 $self->export('unsuspend', @$export_args);
1078 Runs export_links callbacks and returns the links.
1085 $self->export('links', $return);
1089 =item export_getsettings
1091 Runs export_getsettings callbacks and returns the two hashrefs.
1095 sub export_getsettings {
1099 my $error = $self->export('getsettings', \%settings, \%defaults);
1101 warn "error running export_getsetings: $error";
1102 return ( { 'error' => $error }, {} );
1104 ( \%settings, \%defaults );
1107 =item export_getstatus
1109 Runs export_getstatus callbacks and returns a two item list consisting of an
1110 HTML status and a status hashref.
1114 sub export_getstatus {
1118 my $error = $self->export('getstatus', \$html, \%hash);
1120 warn "error running export_getstatus: $error";
1121 return ( '', { 'error' => $error } );
1126 =item export_setstatus
1128 Runs export_setstatus callbacks. If there is an error, returns the error,
1129 otherwise returns false.
1133 sub export_setstatus { shift->_export_setstatus_X('setstatus', @_) }
1134 sub export_setstatus_listadd { shift->_export_setstatus_X('setstatus_listadd', @_) }
1135 sub export_setstatus_listdel { shift->_export_setstatus_X('setstatus_listdel', @_) }
1136 sub export_setstatus_vacationadd { shift->_export_setstatus_X('setstatus_vacationadd', @_) }
1137 sub export_setstatus_vacationdel { shift->_export_setstatus_X('setstatus_vacationdel', @_) }
1139 sub _export_setstatus_X {
1140 my( $self, $method, @args ) = @_;
1141 my $error = $self->export($method, @args);
1143 warn "error running export_$method: $error";
1149 =item export HOOK [ EXPORT_ARGS ]
1151 Runs the provided export hook (i.e. "suspend", "unsuspend") for this service.
1156 my( $self, $method ) = ( shift, shift );
1158 # $method must start with export_, $action must be the part after that
1159 $method = "export_$method" unless $method =~ /^export_/;
1160 my ($action) = $method =~ /^export_(\w+)/;
1162 local $SIG{HUP} = 'IGNORE';
1163 local $SIG{INT} = 'IGNORE';
1164 local $SIG{QUIT} = 'IGNORE';
1165 local $SIG{TERM} = 'IGNORE';
1166 local $SIG{TSTP} = 'IGNORE';
1167 local $SIG{PIPE} = 'IGNORE';
1169 my $oldAutoCommit = $FS::UID::AutoCommit;
1170 local $FS::UID::AutoCommit = 0;
1174 unless ( $noexport_hack ) {
1175 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
1176 next unless $part_export->can($method);
1177 next if $part_export->get("no_$action"); # currently only 'no_suspend'
1178 my $error = $part_export->$method($self, @_);
1180 $dbh->rollback if $oldAutoCommit;
1181 return "error exporting $method event to ". $part_export->exporttype.
1182 " (transaction rolled back): $error";
1187 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1194 Sets or retrieves overlimit date.
1200 #$self->cust_svc->overlimit(@_);
1201 my $cust_svc = $self->cust_svc;
1202 unless ( $cust_svc ) { #wtf?
1203 my $error = "$me overlimit: missing cust_svc record for svc_acct svcnum ".
1205 if ( $overlimit_missing_cust_svc_nonfatal_kludge ) {
1206 cluck "$error; continuing anyway as requested";
1212 $cust_svc->overlimit(@_);
1217 Stub - returns false (no error) so derived classes don't need to define this
1218 methods. Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
1220 This method is called *before* the deletion step which actually deletes the
1221 services. This method should therefore only be used for "pre-deletion"
1222 cancellation steps, if necessary.
1228 =item clone_suspended
1230 Constructor used by FS::part_export::_export_suspend fallback. Stub returning
1231 same object for svc_ classes which don't implement a suspension fallback
1232 (everything except svc_acct at the moment). Document better.
1236 sub clone_suspended {
1240 =item clone_kludge_unsuspend
1242 Constructor used by FS::part_export::_export_unsuspend fallback. Stub returning
1243 same object for svc_ classes which don't implement a suspension fallback
1244 (everything except svc_acct at the moment). Document better.
1248 sub clone_kludge_unsuspend {
1252 =item find_duplicates MODE FIELDS...
1254 Method used by _check_duplicate routines to find services with duplicate
1255 values in specified fields. Set MODE to 'global' to search across all
1256 services, or 'export' to limit to those that share one or more exports
1257 with this service. FIELDS is a list of field names; only services
1258 matching in all fields will be returned. Empty fields will be skipped.
1262 sub find_duplicates {
1267 my %search = map { $_ => $self->getfield($_) }
1268 grep { length($self->getfield($_)) } @fields;
1269 return () if !%search;
1270 my @dup = grep { ! $self->svcnum or $_->svcnum != $self->svcnum }
1271 qsearch( $self->table, \%search );
1273 return @dup if $mode eq 'global';
1274 die "incorrect find_duplicates mode '$mode'" if $mode ne 'export';
1276 my $exports = FS::part_export::export_info($self->table);
1277 my %conflict_svcparts;
1278 my $part_svc = $self->part_svc;
1279 foreach my $part_export ( $part_svc->part_export ) {
1280 %conflict_svcparts = map { $_->svcpart => 1 } $part_export->export_svc;
1282 return grep { $conflict_svcparts{$_->cust_svc->svcpart} } @dup;
1285 =item getstatus_html
1289 sub getstatus_html {
1292 my $part_svc = $self->cust_svc->part_svc;
1296 foreach my $export ( grep $_->can('export_getstatus'), $part_svc->part_export ) {
1297 my $export_html = '';
1299 $export->export_getstatus( $self, \$export_html, \%hash );
1300 $html .= $export_html;
1313 my $conf = new FS::Conf;
1314 return '' unless grep { $self->table eq $_ }
1315 $conf->config('nms-auto_add-svc_ips');
1316 my $ip_field = $self->table_info->{'ip_field'};
1318 my $queue = FS::queue->new( {
1319 'job' => 'FS::NetworkMonitoringSystem::queued_add_router',
1320 'svcnum' => $self->svcnum,
1322 $queue->insert( 'FS::NetworkMonitoringSystem',
1324 $conf->config('nms-auto_add-community')
1333 #XXX not yet implemented
1336 =item search_sql_field FIELD STRING
1338 Class method which returns an SQL fragment to search for STRING in FIELD.
1340 It is now case-insensitive by default.
1344 sub search_sql_field {
1345 my( $class, $field, $string ) = @_;
1346 my $table = $class->table;
1347 my $q_string = dbh->quote($string);
1348 "LOWER($table.$field) = LOWER($q_string)";
1351 #fallback for services that don't provide a search...
1353 #my( $class, $string ) = @_;
1356 sub search_sql_addl_from {
1360 =item search HASHREF
1362 Class method which returns a qsearch hash expression to search for parameters
1363 specified in HASHREF.
1369 =item unlinked - set to search for all unlinked services. Overrides all other options.
1379 =item pkgpart - arrayref
1381 =item routernum - arrayref
1383 =item sectornum - arrayref
1385 =item towernum - arrayref
1389 =item cancelled - if true, only returns svcs attached to cancelled pkgs;
1390 if defined and false, only returns svcs not attached to cancelled packages
1396 ### Don't call the 'cancelled' option 'Service Status'
1397 ### There is no such thing
1398 ### See cautionary note in httemplate/browse/part_svc.cgi
1401 my ($class, $params) = @_;
1404 'LEFT JOIN cust_svc USING ( svcnum )',
1405 'LEFT JOIN part_svc USING ( svcpart )',
1406 'LEFT JOIN cust_pkg USING ( pkgnum )',
1407 FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg'),
1412 $class->_search_svc($params, \@from, \@where) if $class->can('_search_svc');
1415 # if ( $params->{'domain'} ) {
1416 # my $svc_domain = qsearchs('svc_domain', { 'domain'=>$params->{'domain'} } );
1417 # #preserve previous behavior & bubble up an error if $svc_domain not found?
1418 # push @where, 'domsvc = '. $svc_domain->svcnum if $svc_domain;
1422 # if ( $params->{'domsvc'} =~ /^(\d+)$/ ) {
1423 # push @where, "domsvc = $1";
1427 push @where, 'pkgnum IS NULL' if $params->{'unlinked'};
1430 if ( $params->{'agentnum'} =~ /^(\d+)$/ && $1 ) {
1431 push @where, "cust_main.agentnum = $1";
1435 if ( $params->{'custnum'} =~ /^(\d+)$/ && $1 ) {
1436 push @where, "cust_pkg.custnum = $1";
1440 if ( $params->{'cust_status'} =~ /^([a-z]+)$/ ) {
1441 push @where, FS::cust_main->cust_status_sql . " = '$1'";
1445 if ( $params->{'balance'} =~ /^\s*(\-?\d*(\.\d{1,2})?)\s*$/ && length($1) ) {
1449 if ( $params->{'balance_days'} =~ /^\s*(\d*(\.\d{1,3})?)\s*$/ && length($1) ) {
1450 $age = time - 86400 * $1;
1452 push @where, FS::cust_main->balance_date_sql($age) . " > $balance";
1456 if ( $params->{'payby'} && scalar(@{ $params->{'payby'} }) ) {
1457 my @payby = map "'$_'", grep /^(\w+)$/, @{ $params->{'payby'} };
1458 push @where, 'payby IN ('. join(',', @payby ). ')';
1462 ##pkgpart, now properly untainted, can be arrayref
1463 #for my $pkgpart ( $params->{'pkgpart'} ) {
1464 # if ( ref $pkgpart ) {
1465 # my $where = join(',', map { /^(\d+)$/ ? $1 : () } @$pkgpart );
1466 # push @where, "cust_pkg.pkgpart IN ($where)" if $where;
1468 # elsif ( $pkgpart =~ /^(\d+)$/ ) {
1469 # push @where, "cust_pkg.pkgpart = $1";
1472 if ( $params->{'pkgpart'} ) {
1473 my @pkgpart = ref( $params->{'pkgpart'} )
1474 ? @{ $params->{'pkgpart'} }
1475 : $params->{'pkgpart'}
1476 ? ( $params->{'pkgpart'} )
1478 @pkgpart = grep /^(\d+)$/, @pkgpart;
1479 push @where, 'cust_pkg.pkgpart IN ('. join(',', @pkgpart ). ')' if @pkgpart;
1483 if ( $params->{'svcnum'} ) {
1484 my @svcnum = ref( $params->{'svcnum'} )
1485 ? @{ $params->{'svcnum'} }
1486 : $params->{'svcnum'};
1487 @svcnum = grep /^\d+$/, @svcnum;
1488 push @where, 'svcnum IN ('. join(',', @svcnum) . ')' if @svcnum;
1492 if ( $params->{'svcpart'} ) {
1493 my @svcpart = ref( $params->{'svcpart'} )
1494 ? @{ $params->{'svcpart'} }
1495 : $params->{'svcpart'}
1496 ? ( $params->{'svcpart'} )
1498 @svcpart = grep /^(\d+)$/, @svcpart;
1499 push @where, 'svcpart IN ('. join(',', @svcpart ). ')' if @svcpart;
1502 if ( $params->{'exportnum'} =~ /^(\d+)$/ ) {
1503 push @from, ' LEFT JOIN export_svc USING ( svcpart )';
1504 push @where, "exportnum = $1";
1507 if ( defined($params->{'cancelled'}) ) {
1508 if ($params->{'cancelled'}) {
1509 push @where, "cust_pkg.cancel IS NOT NULL";
1511 push @where, "cust_pkg.cancel IS NULL";
1515 # # sector and tower
1516 # my @where_sector = $class->tower_sector_sql($params);
1517 # if ( @where_sector ) {
1518 # push @where, @where_sector;
1519 # push @from, ' LEFT JOIN tower_sector USING ( sectornum )';
1522 # here is the agent virtualization
1523 #if ($params->{CurrentUser}) {
1525 # qsearchs('access_user', { username => $params->{CurrentUser} });
1527 # if ($access_user) {
1528 # push @where, $access_user->agentnums_sql('table'=>'cust_main');
1530 # push @where, "1=0";
1533 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql(
1534 'table' => 'cust_main',
1535 'null_right' => 'View/link unlinked services',
1539 push @where, @{ $params->{'where'} } if $params->{'where'};
1541 my $addl_from = join(' ', @from);
1542 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
1544 my $table = $class->table;
1546 my $count_query = "SELECT COUNT(*) FROM $table $addl_from $extra_sql";
1547 #if ( keys %svc_X ) {
1548 # $count_query .= ' WHERE '.
1549 # join(' AND ', map "$_ = ". dbh->quote($svc_X{$_}),
1557 'select' => join(', ',
1560 'cust_main.custnum',
1561 @{ $params->{'addl_select'} || [] },
1562 FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
1564 'addl_from' => $addl_from,
1565 'extra_sql' => $extra_sql,
1566 'order_by' => $params->{'order_by'},
1567 'count_query' => $count_query,
1576 The setfixed method return value.
1578 B<export> method isn't used by insert and replace methods yet.
1582 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
1583 from the base documentation.