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 Returns a label to identify a record of this service.
126 Label may be displayed on freeside screens, and within customer bills.
128 For example, $obj->label may return:
130 - A provisioned phone number for svc_phone
131 - The mailing list name and e-mail address for svc_mailinglist
132 - The address of a rental property svc_realestate
134 svc_Common provides a fallback label subroutine that just returns the svcnum.
140 cluck "warning: ". ref($self). " not loaded or missing label method; ".
152 (($self->cust_svc || return)->cust_pkg || return)->cust_main || return
157 defined($self->cust_main);
162 Checks the validity of fields in this record.
164 Only checks fields marked as required in table_info or
165 part_svc_column definition. Should be invoked by service-specific
166 check using SUPER. Invokes FS::Record::check using SUPER.
173 ## Checking required fields
175 # get fields marked as required in table_info
178 my $tinfo = $self->can('table_info') ? $self->table_info : {};
179 if ($tinfo->{'manual_require'}) {
180 my $fields = $tinfo->{'fields'} || {};
181 foreach my $field (keys %$fields) {
182 if (ref($fields->{$field}) && $fields->{$field}->{'required'}) {
183 $required->{$field} = 1;
184 $labels->{$field} = $fields->{$field}->{'label'};
187 # add fields marked as required in database
189 qsearch('part_svc_column',{
190 'svcpart' => $self->svcpart,
194 $required->{$column->columnname} = 1;
195 $labels->{$column->columnname} = $column->columnlabel;
197 # do the actual checking
198 foreach my $field (keys %$required) {
199 unless (length($self->get($field)) > 0) {
200 my $name = $labels->{$field} || $field;
201 return "$name is required\n"
209 =item insert [ , OPTION => VALUE ... ]
211 Adds this record to the database. If there is an error, returns the error,
212 otherwise returns false.
214 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
215 defined. An FS::cust_svc record will be created and inserted.
217 Currently available options are: I<jobnums>, I<child_objects> and
220 If I<jobnum> is set to an array reference, the jobnums of any export jobs will
221 be added to the referenced array.
223 If I<child_objects> is set to an array reference of FS::tablename objects
224 (for example, FS::svc_export_machine or FS::acct_snarf objects), they
225 will have their svcnum field set and will be inserted after this record,
226 but before any exports are run. Each element of the array can also
227 optionally be a two-element array reference containing the child object
228 and the name of an alternate field to be filled in with the newly-inserted
229 svcnum, for example C<[ $svc_forward, 'srcsvc' ]>
231 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
232 jobnums), all provisioning jobs will have a dependancy on the supplied
233 jobnum(s) (they will not run until the specific job(s) complete(s)).
235 If I<export_args> is set to an array reference, the referenced list will be
236 passed to export commands.
243 warn "[$me] insert called with options ".
244 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
248 local $FS::queue::jobnums = \@jobnums;
249 warn "[$me] insert: set \$FS::queue::jobnums to $FS::queue::jobnums\n"
251 my $objects = $options{'child_objects'} || [];
252 my $depend_jobnums = $options{'depend_jobnum'} || [];
253 $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
255 local $SIG{HUP} = 'IGNORE';
256 local $SIG{INT} = 'IGNORE';
257 local $SIG{QUIT} = 'IGNORE';
258 local $SIG{TERM} = 'IGNORE';
259 local $SIG{TSTP} = 'IGNORE';
260 local $SIG{PIPE} = 'IGNORE';
262 my $oldAutoCommit = $FS::UID::AutoCommit;
263 local $FS::UID::AutoCommit = 0;
266 my $svcnum = $self->svcnum;
267 my $cust_svc = $svcnum ? qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) : '';
268 my $inserted_cust_svc = 0;
269 #unless ( $svcnum ) {
270 if ( !$svcnum or !$cust_svc ) {
271 $cust_svc = new FS::cust_svc ( {
272 #hua?# 'svcnum' => $svcnum,
273 'svcnum' => $self->svcnum,
274 'pkgnum' => $self->pkgnum,
275 'svcpart' => $self->svcpart,
277 my $error = $cust_svc->insert;
279 $dbh->rollback if $oldAutoCommit;
282 $inserted_cust_svc = 1;
283 $svcnum = $self->svcnum($cust_svc->svcnum);
285 #$cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
286 unless ( $cust_svc ) {
287 $dbh->rollback if $oldAutoCommit;
288 return "no cust_svc record found for svcnum ". $self->svcnum;
290 $self->pkgnum($cust_svc->pkgnum);
291 $self->svcpart($cust_svc->svcpart);
294 my $error = $self->preinsert_hook_first(%options)
295 || $self->set_auto_inventory
297 || $self->_check_duplicate
298 || $self->preinsert_hook
299 || $self->SUPER::insert;
301 if ( $inserted_cust_svc ) {
302 my $derror = $cust_svc->delete;
303 die $derror if $derror;
305 $dbh->rollback if $oldAutoCommit;
309 foreach my $object ( @$objects ) {
311 if ( ref($object) eq 'ARRAY' ) {
312 ($obj, $field) = @$object;
317 $obj->$field($self->svcnum);
318 $error = $obj->insert;
320 $dbh->rollback if $oldAutoCommit;
326 unless ( $noexport_hack ) {
328 warn "[$me] insert: \$FS::queue::jobnums is $FS::queue::jobnums\n"
331 my $export_args = $options{'export_args'} || [];
333 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
334 my $error = $part_export->export_insert($self, @$export_args);
336 $dbh->rollback if $oldAutoCommit;
337 return "exporting to ". $part_export->exporttype.
338 " (transaction rolled back): $error";
342 foreach my $depend_jobnum ( @$depend_jobnums ) {
343 warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
345 foreach my $jobnum ( @jobnums ) {
346 my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
347 warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
349 my $error = $queue->depend_insert($depend_jobnum);
351 $dbh->rollback if $oldAutoCommit;
352 return "error queuing job dependancy: $error";
359 my $nms_ip_error = $self->nms_ip_insert;
360 if ( $nms_ip_error ) {
361 $dbh->rollback if $oldAutoCommit;
362 return "error queuing IP insert: $nms_ip_error";
365 if ( exists $options{'jobnums'} ) {
366 push @{ $options{'jobnums'} }, @jobnums;
369 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
375 sub preinsert_hook_first { ''; }
376 sub _check_duplcate { ''; }
377 sub preinsert_hook { ''; }
378 sub table_dupcheck_fields { (); }
379 sub prereplace_hook { ''; }
380 sub prereplace_hook_first { ''; }
381 sub predelete_hook { ''; }
382 sub predelete_hook_first { ''; }
384 =item delete [ , OPTION => VALUE ... ]
386 Deletes this account from the database. If there is an error, returns the
387 error, otherwise returns false.
389 The corresponding FS::cust_svc record will be deleted as well.
396 my $export_args = $options{'export_args'} || [];
398 local $SIG{HUP} = 'IGNORE';
399 local $SIG{INT} = 'IGNORE';
400 local $SIG{QUIT} = 'IGNORE';
401 local $SIG{TERM} = 'IGNORE';
402 local $SIG{TSTP} = 'IGNORE';
403 local $SIG{PIPE} = 'IGNORE';
405 my $oldAutoCommit = $FS::UID::AutoCommit;
406 local $FS::UID::AutoCommit = 0;
409 my $error = $self->cust_svc->check_part_svc_link_unprovision
410 || $self->predelete_hook_first
411 || $self->SUPER::delete
412 || $self->export('delete', @$export_args)
413 || $self->return_inventory
414 || $self->release_router
415 || $self->predelete_hook
416 || $self->cust_svc->delete
419 $dbh->rollback if $oldAutoCommit;
423 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
430 Currently this will only run expire exports if any are attached
435 my($self,$date) = (shift,shift);
437 return 'Expire date must be specified' unless $date;
439 local $SIG{HUP} = 'IGNORE';
440 local $SIG{INT} = 'IGNORE';
441 local $SIG{QUIT} = 'IGNORE';
442 local $SIG{TERM} = 'IGNORE';
443 local $SIG{TSTP} = 'IGNORE';
444 local $SIG{PIPE} = 'IGNORE';
446 my $oldAutoCommit = $FS::UID::AutoCommit;
447 local $FS::UID::AutoCommit = 0;
450 my $export_args = [$date];
451 my $error = $self->export('expire', @$export_args);
453 $dbh->rollback if $oldAutoCommit;
457 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
462 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ]
464 Replaces OLD_RECORD with this one. If there is an error, returns the error,
465 otherwise returns false.
467 Currently available options are: I<child_objects>, I<export_args> and
470 If I<child_objects> is set to an array reference of FS::tablename objects
471 (for example, FS::svc_export_machine or FS::acct_snarf objects), they
472 will have their svcnum field set and will be inserted or replaced after
473 this record, but before any exports are run. Each element of the array
474 can also optionally be a two-element array reference containing the
475 child object and the name of an alternate field to be filled in with
476 the newly-inserted svcnum, for example C<[ $svc_forward, 'srcsvc' ]>
478 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
479 jobnums), all provisioning jobs will have a dependancy on the supplied
480 jobnum(s) (they will not run until the specific job(s) complete(s)).
482 If I<export_args> is set to an array reference, the referenced list will be
483 passed to export commands.
489 $noexport_hack = $new->no_export if $new->no_export;
491 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
496 ( ref($_[0]) eq 'HASH' )
500 my $objects = $options->{'child_objects'} || [];
503 local $FS::queue::jobnums = \@jobnums;
504 warn "[$me] replace: set \$FS::queue::jobnums to $FS::queue::jobnums\n"
506 my $depend_jobnums = $options->{'depend_jobnum'} || [];
507 $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
509 local $SIG{HUP} = 'IGNORE';
510 local $SIG{INT} = 'IGNORE';
511 local $SIG{QUIT} = 'IGNORE';
512 local $SIG{TERM} = 'IGNORE';
513 local $SIG{TSTP} = 'IGNORE';
514 local $SIG{PIPE} = 'IGNORE';
516 my $oldAutoCommit = $FS::UID::AutoCommit;
517 local $FS::UID::AutoCommit = 0;
520 my $error = $new->prereplace_hook_first($old)
521 || $new->set_auto_inventory($old)
522 || $new->check; #redundant, but so any duplicate fields are
523 #maniuplated as appropriate (svc_phone.phonenum)
525 $dbh->rollback if $oldAutoCommit;
529 #if ( $old->username ne $new->username || $old->domsvc != $new->domsvc ) {
530 if ( grep { $old->$_ ne $new->$_ } $new->table_dupcheck_fields ) {
532 $new->svcpart( $new->cust_svc->svcpart ) unless $new->svcpart;
533 $error = $new->_check_duplicate;
535 $dbh->rollback if $oldAutoCommit;
540 $error = $new->SUPER::replace($old);
542 $dbh->rollback if $oldAutoCommit;
546 foreach my $object ( @$objects ) {
548 if ( ref($object) eq 'ARRAY' ) {
549 ($obj, $field) = @$object;
554 $obj->$field($new->svcnum);
556 my $oldobj = qsearchs( $obj->table, {
557 $field => $new->svcnum,
558 map { $_ => $obj->$_ } $obj->_svc_child_partfields,
562 my $pkey = $oldobj->primary_key;
563 $obj->$pkey($oldobj->$pkey);
564 $obj->replace($oldobj);
566 $error = $obj->insert;
569 $dbh->rollback if $oldAutoCommit;
575 unless ( $noexport_hack ) {
577 warn "[$me] replace: \$FS::queue::jobnums is $FS::queue::jobnums\n"
580 my $export_args = $options->{'export_args'} || [];
582 #not quite false laziness, but same pattern as FS::svc_acct::replace and
583 #FS::part_export::sqlradius::_export_replace. List::Compare or something
584 #would be useful but too much of a pain in the ass to deploy
586 my @old_part_export = $old->cust_svc->part_svc->part_export;
587 my %old_exportnum = map { $_->exportnum => 1 } @old_part_export;
588 my @new_part_export =
590 ? qsearchs('part_svc', { svcpart=>$new->svcpart } )->part_export
591 : $new->cust_svc->part_svc->part_export;
592 my %new_exportnum = map { $_->exportnum => 1 } @new_part_export;
594 foreach my $delete_part_export (
595 grep { ! $new_exportnum{$_->exportnum} } @old_part_export
597 my $error = $delete_part_export->export_delete($old, @$export_args);
599 $dbh->rollback if $oldAutoCommit;
600 return "error deleting, export to ". $delete_part_export->exporttype.
601 " (transaction rolled back): $error";
605 foreach my $replace_part_export (
606 grep { $old_exportnum{$_->exportnum} } @new_part_export
609 $replace_part_export->export_replace( $new, $old, @$export_args);
611 $dbh->rollback if $oldAutoCommit;
612 return "error exporting to ". $replace_part_export->exporttype.
613 " (transaction rolled back): $error";
617 foreach my $insert_part_export (
618 grep { ! $old_exportnum{$_->exportnum} } @new_part_export
620 my $error = $insert_part_export->export_insert($new, @$export_args );
622 $dbh->rollback if $oldAutoCommit;
623 return "error inserting export to ". $insert_part_export->exporttype.
624 " (transaction rolled back): $error";
628 foreach my $depend_jobnum ( @$depend_jobnums ) {
629 warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
631 foreach my $jobnum ( @jobnums ) {
632 my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
633 warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
635 my $error = $queue->depend_insert($depend_jobnum);
637 $dbh->rollback if $oldAutoCommit;
638 return "error queuing job dependancy: $error";
645 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
651 Sets any fixed fields for this service (see L<FS::part_svc>). If there is an
652 error, returns the error, otherwise returns the FS::part_svc object (use ref()
653 to test the return). Usually called by the check method.
659 $self->setx('F', @_);
664 Sets all fields to their defaults (see L<FS::part_svc>), overriding their
665 current values. If there is an error, returns the error, otherwise returns
666 the FS::part_svc object (use ref() to test the return).
672 $self->setx('D', @_ );
675 =item set_default_and_fixed
679 sub set_default_and_fixed {
681 $self->setx( [ 'D', 'F' ], @_ );
684 =item setx FLAG | FLAG_ARRAYREF , [ CALLBACK_HASHREF ]
686 Sets fields according to the passed in flag or arrayref of flags.
688 Optionally, a hashref of field names and callback coderefs can be passed.
689 If a coderef exists for a given field name, instead of setting the field,
690 the coderef is called with the column value (part_svc_column.columnvalue)
691 as the single parameter.
698 my @x = ref($x) ? @$x : ($x);
699 my $coderef = scalar(@_) ? shift : $self->_fieldhandlers;
702 $self->ut_numbern('svcnum')
704 return $error if $error;
706 my $part_svc = $self->part_svc;
707 return "Unknown svcpart" unless $part_svc;
709 #set default/fixed/whatever fields from part_svc
711 foreach my $part_svc_column (
712 grep { my $f = $_->columnflag; grep { $f eq $_ } @x } #columnflag in @x
713 $part_svc->all_part_svc_column
716 my $columnname = $part_svc_column->columnname;
717 my $columnvalue = $part_svc_column->columnvalue;
719 $columnvalue = &{ $coderef->{$columnname} }( $self, $columnvalue )
720 if exists( $coderef->{$columnname} );
721 $self->setfield( $columnname, $columnvalue );
732 cluck 'svc_X->part_svc called' if $DEBUG;
736 if ( $self->get('svcpart') ) {
737 $svcpart = $self->get('svcpart');
738 } elsif ( $self->svcnum && qsearchs('cust_svc', {'svcnum'=>$self->svcnum}) ) {
739 my $cust_svc = $self->cust_svc;
740 return "Unknown svcnum" unless $cust_svc;
741 $svcpart = $cust_svc->svcpart;
744 qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
750 Returns the FS::svc_pbx record for this service, if any (see L<FS::svc_pbx>).
752 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
757 # XXX FS::h_svc_{acct,phone} could have a history-aware svc_pbx override
761 return '' unless $self->pbxsvc;
762 qsearchs( 'svc_pbx', { 'svcnum' => $self->pbxsvc } );
767 Returns the title of the FS::svc_pbx record associated with this service, if
770 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
777 my $svc_pbx = $self->svc_pbx or return '';
781 =item pbx_select_hash %OPTIONS
783 Can be called as an object method or a class method.
785 Returns a hash SVCNUM => TITLE ... representing the PBXes this customer
786 that may be associated with this service.
788 Currently available options are: I<pkgnum> I<svcpart>
790 Only makes sense if the service has a pbxsvc field (currently, svc_phone and
795 #false laziness w/svc_acct::domain_select_hash
796 sub pbx_select_hash {
797 my ($self, %options) = @_;
803 $part_svc = $self->part_svc;
804 $cust_pkg = $self->cust_svc->cust_pkg
808 $part_svc = qsearchs('part_svc', { 'svcpart' => $options{svcpart} })
809 if $options{'svcpart'};
811 $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $options{pkgnum} })
812 if $options{'pkgnum'};
814 if ($part_svc && ( $part_svc->part_svc_column('pbxsvc')->columnflag eq 'S'
815 || $part_svc->part_svc_column('pbxsvc')->columnflag eq 'F')) {
816 %pbxes = map { $_->svcnum => $_->title }
817 map { qsearchs('svc_pbx', { 'svcnum' => $_ }) }
818 split(',', $part_svc->part_svc_column('pbxsvc')->columnvalue);
819 } elsif ($cust_pkg) { # && !$conf->exists('svc_acct-alldomains') ) {
820 %pbxes = map { $_->svcnum => $_->title }
821 map { qsearchs('svc_pbx', { 'svcnum' => $_->svcnum }) }
822 map { qsearch('cust_svc', { 'pkgnum' => $_->pkgnum } ) }
823 qsearch('cust_pkg', { 'custnum' => $cust_pkg->custnum });
826 %pbxes = map { $_->svcnum => $_->title } qsearch('svc_pbx', {} );
829 if ($part_svc && $part_svc->part_svc_column('pbxsvc')->columnflag eq 'D') {
830 my $svc_pbx = qsearchs('svc_pbx',
831 { 'svcnum' => $part_svc->part_svc_column('pbxsvc')->columnvalue } );
833 $pbxes{$svc_pbx->svcnum} = $svc_pbx->title;
835 warn "unknown svc_pbx.svcnum for part_svc_column pbxsvc: ".
836 $part_svc->part_svc_column('pbxsvc')->columnvalue;
845 =item set_auto_inventory
847 Sets any fields which auto-populate from inventory (see L<FS::part_svc>), and
848 also check any manually populated inventory fields.
850 If there is an error, returns the error, otherwise returns false.
854 sub set_auto_inventory {
855 # don't try to do this during an upgrade
856 return '' if $FS::CurrentUser::upgrade_hack;
859 my $old = @_ ? shift : '';
862 $self->ut_numbern('svcnum')
864 return $error if $error;
866 my $part_svc = $self->part_svc;
867 return "Unkonwn svcpart" unless $part_svc;
869 local $SIG{HUP} = 'IGNORE';
870 local $SIG{INT} = 'IGNORE';
871 local $SIG{QUIT} = 'IGNORE';
872 local $SIG{TERM} = 'IGNORE';
873 local $SIG{TSTP} = 'IGNORE';
874 local $SIG{PIPE} = 'IGNORE';
876 my $oldAutoCommit = $FS::UID::AutoCommit;
877 local $FS::UID::AutoCommit = 0;
880 #set default/fixed/whatever fields from part_svc
881 my $table = $self->table;
882 foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
884 my $part_svc_column = $part_svc->part_svc_column($field);
885 my $columnflag = $part_svc_column->columnflag;
886 next unless $columnflag =~ /^[AM]$/;
888 next if $columnflag eq 'A' && $self->$field() ne '';
890 my $classnum = $part_svc_column->columnvalue;
893 if ( $columnflag eq 'A' && $self->$field() eq '' ) {
894 $hash{'svcnum'} = '';
895 } elsif ( $columnflag eq 'M' ) {
896 return "Select inventory item for $field" unless $self->getfield($field);
897 $hash{'item'} = $self->getfield($field);
898 my $chosen_classnum = $self->getfield($field.'_classnum');
899 if ( grep {$_ == $chosen_classnum} split(',', $classnum) ) {
900 $classnum = $chosen_classnum;
902 # otherwise the chosen classnum is either (all), or somehow not on
903 # the list, so ignore it and choose the first item that's in any
907 my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql(
909 'table' => 'inventory_item',
912 my $inventory_item = qsearchs({
913 'table' => 'inventory_item',
915 'extra_sql' => "AND classnum IN ($classnum) AND $agentnums_sql",
916 'order_by' => 'ORDER BY ( agentnum IS NULL ) '. #agent inventory first
917 ' LIMIT 1 FOR UPDATE',
920 unless ( $inventory_item ) {
921 # should really only be shown if columnflag eq 'A'...
922 $dbh->rollback if $oldAutoCommit;
923 my $message = 'Out of ';
924 my @classnums = split(',', $classnum);
925 foreach ( @classnums ) {
926 my $class = FS::inventory_class->by_key($_)
927 or return "Can't find inventory_class.classnum $_";
928 $message .= PL_N($class->classname);
929 if ( scalar(@classnums) > 2 ) { # english is hard
930 if ( $_ != $classnums[-1] ) {
934 if ( scalar(@classnums) > 1 and $_ == $classnums[-2] ) {
941 next if $columnflag eq 'M' && $inventory_item->svcnum == $self->svcnum;
943 $self->setfield( $field, $inventory_item->item );
944 #if $columnflag eq 'A' && $self->$field() eq '';
946 # release the old inventory item, if there was one
947 if ( $old && $old->$field() && $old->$field() ne $self->$field() ) {
948 my $old_inv = qsearchs({
949 'table' => 'inventory_item',
951 'svcnum' => $old->svcnum,
953 'extra_sql' => "AND classnum IN ($classnum) AND ".
954 '( ( svc_field IS NOT NULL AND svc_field = '.$dbh->quote($field).' )'.
955 ' OR ( svc_field IS NULL AND item = '. dbh->quote($old->$field).' )'.
959 $old_inv->svcnum('');
960 $old_inv->svc_field('');
961 my $oerror = $old_inv->replace;
963 $dbh->rollback if $oldAutoCommit;
964 return "Error unprovisioning inventory: $oerror";
967 warn "old inventory_item not found for $field ". $self->$field;
971 $inventory_item->svcnum( $self->svcnum );
972 $inventory_item->svc_field( $field );
973 my $ierror = $inventory_item->replace();
975 $dbh->rollback if $oldAutoCommit;
976 return "Error provisioning inventory: $ierror";
981 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
987 =item return_inventory
989 Release all inventory items attached to this service's fields. Call
990 when unprovisioning the service.
994 sub return_inventory {
997 local $SIG{HUP} = 'IGNORE';
998 local $SIG{INT} = 'IGNORE';
999 local $SIG{QUIT} = 'IGNORE';
1000 local $SIG{TERM} = 'IGNORE';
1001 local $SIG{TSTP} = 'IGNORE';
1002 local $SIG{PIPE} = 'IGNORE';
1004 my $oldAutoCommit = $FS::UID::AutoCommit;
1005 local $FS::UID::AutoCommit = 0;
1008 foreach my $inventory_item ( $self->inventory_item ) {
1009 $inventory_item->svcnum('');
1010 $inventory_item->svc_field('');
1011 my $error = $inventory_item->replace();
1013 $dbh->rollback if $oldAutoCommit;
1014 return "Error returning inventory: $error";
1018 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1023 =item inventory_item
1025 Returns the inventory items associated with this svc_ record, as
1026 FS::inventory_item objects (see L<FS::inventory_item>.
1030 sub inventory_item {
1033 'table' => 'inventory_item',
1034 'hashref' => { 'svcnum' => $self->svcnum, },
1038 =item release_router
1040 Delete any routers associated with this service. This will release their
1041 address blocks, also.
1045 sub release_router {
1047 my @routers = qsearch('router', { svcnum => $self->svcnum });
1048 foreach (@routers) {
1049 my $error = $_->delete;
1050 return "$error (removing router '".$_->routername."')" if $error;
1058 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
1059 object (see L<FS::cust_svc>).
1063 Runs export_suspend callbacks.
1070 my $export_args = $options{'export_args'} || [];
1071 $self->export('suspend', @$export_args);
1076 Runs export_unsuspend callbacks.
1083 my $export_args = $options{'export_args'} || [];
1084 $self->export('unsuspend', @$export_args);
1089 Runs export_links callbacks and returns the links.
1096 $self->export('links', $return);
1100 =item export_getsettings
1102 Runs export_getsettings callbacks and returns the two hashrefs.
1106 sub export_getsettings {
1110 my $error = $self->export('getsettings', \%settings, \%defaults);
1112 warn "error running export_getsetings: $error";
1113 return ( { 'error' => $error }, {} );
1115 ( \%settings, \%defaults );
1118 =item export_getstatus
1120 Runs export_getstatus callbacks and returns a two item list consisting of an
1121 HTML status and a status hashref.
1125 sub export_getstatus {
1129 my $error = $self->export('getstatus', \$html, \%hash);
1131 warn "error running export_getstatus: $error";
1132 return ( '', { 'error' => $error } );
1137 =item export_setstatus
1139 Runs export_setstatus callbacks. If there is an error, returns the error,
1140 otherwise returns false.
1144 sub export_setstatus { shift->_export_setstatus_X('setstatus', @_) }
1145 sub export_setstatus_listadd { shift->_export_setstatus_X('setstatus_listadd', @_) }
1146 sub export_setstatus_listdel { shift->_export_setstatus_X('setstatus_listdel', @_) }
1147 sub export_setstatus_vacationadd { shift->_export_setstatus_X('setstatus_vacationadd', @_) }
1148 sub export_setstatus_vacationdel { shift->_export_setstatus_X('setstatus_vacationdel', @_) }
1150 sub _export_setstatus_X {
1151 my( $self, $method, @args ) = @_;
1152 my $error = $self->export($method, @args);
1154 warn "error running export_$method: $error";
1160 =item export HOOK [ EXPORT_ARGS ]
1162 Runs the provided export hook (i.e. "suspend", "unsuspend") for this service.
1167 my( $self, $method ) = ( shift, shift );
1169 # $method must start with export_, $action must be the part after that
1170 $method = "export_$method" unless $method =~ /^export_/;
1171 my ($action) = $method =~ /^export_(\w+)/;
1173 local $SIG{HUP} = 'IGNORE';
1174 local $SIG{INT} = 'IGNORE';
1175 local $SIG{QUIT} = 'IGNORE';
1176 local $SIG{TERM} = 'IGNORE';
1177 local $SIG{TSTP} = 'IGNORE';
1178 local $SIG{PIPE} = 'IGNORE';
1180 my $oldAutoCommit = $FS::UID::AutoCommit;
1181 local $FS::UID::AutoCommit = 0;
1185 unless ( $noexport_hack ) {
1186 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
1187 next unless $part_export->can($method);
1188 next if $part_export->get("no_$action"); # currently only 'no_suspend'
1189 my $error = $part_export->$method($self, @_);
1191 $dbh->rollback if $oldAutoCommit;
1192 return "error exporting $method event to ". $part_export->exporttype.
1193 " (transaction rolled back): $error";
1198 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1205 Sets or retrieves overlimit date.
1211 #$self->cust_svc->overlimit(@_);
1212 my $cust_svc = $self->cust_svc;
1213 unless ( $cust_svc ) { #wtf?
1214 my $error = "$me overlimit: missing cust_svc record for svc_acct svcnum ".
1216 if ( $overlimit_missing_cust_svc_nonfatal_kludge ) {
1217 cluck "$error; continuing anyway as requested";
1223 $cust_svc->overlimit(@_);
1228 Stub - returns false (no error) so derived classes don't need to define this
1229 methods. Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
1231 This method is called *before* the deletion step which actually deletes the
1232 services. This method should therefore only be used for "pre-deletion"
1233 cancellation steps, if necessary.
1239 =item clone_suspended
1241 Constructor used by FS::part_export::_export_suspend fallback. Stub returning
1242 same object for svc_ classes which don't implement a suspension fallback
1243 (everything except svc_acct at the moment). Document better.
1247 sub clone_suspended {
1251 =item clone_kludge_unsuspend
1253 Constructor used by FS::part_export::_export_unsuspend fallback. Stub returning
1254 same object for svc_ classes which don't implement a suspension fallback
1255 (everything except svc_acct at the moment). Document better.
1259 sub clone_kludge_unsuspend {
1263 =item find_duplicates MODE FIELDS...
1265 Method used by _check_duplicate routines to find services with duplicate
1266 values in specified fields. Set MODE to 'global' to search across all
1267 services, or 'export' to limit to those that share one or more exports
1268 with this service. FIELDS is a list of field names; only services
1269 matching in all fields will be returned. Empty fields will be skipped.
1273 sub find_duplicates {
1278 my %search = map { $_ => $self->getfield($_) }
1279 grep { length($self->getfield($_)) } @fields;
1280 return () if !%search;
1281 my @dup = grep { ! $self->svcnum or $_->svcnum != $self->svcnum }
1282 qsearch( $self->table, \%search );
1284 return @dup if $mode eq 'global';
1285 die "incorrect find_duplicates mode '$mode'" if $mode ne 'export';
1287 my $exports = FS::part_export::export_info($self->table);
1288 my %conflict_svcparts;
1289 my $part_svc = $self->part_svc;
1290 foreach my $part_export ( $part_svc->part_export ) {
1291 %conflict_svcparts = map { $_->svcpart => 1 } $part_export->export_svc;
1293 return grep { $conflict_svcparts{$_->cust_svc->svcpart} } @dup;
1296 =item getstatus_html
1300 sub getstatus_html {
1303 my $part_svc = $self->cust_svc->part_svc;
1307 foreach my $export ( grep $_->can('export_getstatus'), $part_svc->part_export ) {
1308 my $export_html = '';
1310 $export->export_getstatus( $self, \$export_html, \%hash );
1311 $html .= $export_html;
1324 my $conf = new FS::Conf;
1325 return '' unless grep { $self->table eq $_ }
1326 $conf->config('nms-auto_add-svc_ips');
1327 my $ip_field = $self->table_info->{'ip_field'};
1329 my $queue = FS::queue->new( {
1330 'job' => 'FS::NetworkMonitoringSystem::queued_add_router',
1331 'svcnum' => $self->svcnum,
1333 $queue->insert( 'FS::NetworkMonitoringSystem',
1335 $conf->config('nms-auto_add-community')
1344 #XXX not yet implemented
1347 =item search_sql_field FIELD STRING
1349 Class method which returns an SQL fragment to search for STRING in FIELD.
1351 It is now case-insensitive by default.
1355 sub search_sql_field {
1356 my( $class, $field, $string ) = @_;
1357 my $table = $class->table;
1358 my $q_string = dbh->quote($string);
1359 "LOWER($table.$field) = LOWER($q_string)";
1362 #fallback for services that don't provide a search...
1364 #my( $class, $string ) = @_;
1367 sub search_sql_addl_from {
1371 =item search HASHREF
1373 Class method which returns a qsearch hash expression to search for parameters
1374 specified in HASHREF.
1380 =item unlinked - set to search for all unlinked services. Overrides all other options.
1390 =item pkgpart - arrayref
1392 =item routernum - arrayref
1394 =item sectornum - arrayref
1396 =item towernum - arrayref
1400 =item cancelled - if true, only returns svcs attached to cancelled pkgs;
1401 if defined and false, only returns svcs not attached to cancelled packages
1407 ### Don't call the 'cancelled' option 'Service Status'
1408 ### There is no such thing
1409 ### See cautionary note in httemplate/browse/part_svc.cgi
1412 my ($class, $params) = @_;
1415 'LEFT JOIN cust_svc USING ( svcnum )',
1416 'LEFT JOIN part_svc USING ( svcpart )',
1417 'LEFT JOIN cust_pkg USING ( pkgnum )',
1418 FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg'),
1423 $class->_search_svc($params, \@from, \@where) if $class->can('_search_svc');
1426 # if ( $params->{'domain'} ) {
1427 # my $svc_domain = qsearchs('svc_domain', { 'domain'=>$params->{'domain'} } );
1428 # #preserve previous behavior & bubble up an error if $svc_domain not found?
1429 # push @where, 'domsvc = '. $svc_domain->svcnum if $svc_domain;
1433 # if ( $params->{'domsvc'} =~ /^(\d+)$/ ) {
1434 # push @where, "domsvc = $1";
1438 push @where, 'pkgnum IS NULL' if $params->{'unlinked'};
1441 if ( $params->{'agentnum'} =~ /^(\d+)$/ && $1 ) {
1442 push @where, "cust_main.agentnum = $1";
1446 if ( $params->{'custnum'} =~ /^(\d+)$/ && $1 ) {
1447 push @where, "cust_pkg.custnum = $1";
1451 if ( $params->{'cust_status'} =~ /^([a-z]+)$/ ) {
1452 push @where, FS::cust_main->cust_status_sql . " = '$1'";
1456 if ( $params->{'balance'} =~ /^\s*(\-?\d*(\.\d{1,2})?)\s*$/ && length($1) ) {
1460 if ( $params->{'balance_days'} =~ /^\s*(\d*(\.\d{1,3})?)\s*$/ && length($1) ) {
1461 $age = time - 86400 * $1;
1463 push @where, FS::cust_main->balance_date_sql($age) . " > $balance";
1467 if ( $params->{'payby'} && scalar(@{ $params->{'payby'} }) ) {
1468 my @payby = map "'$_'", grep /^(\w+)$/, @{ $params->{'payby'} };
1469 push @where, 'payby IN ('. join(',', @payby ). ')';
1473 ##pkgpart, now properly untainted, can be arrayref
1474 #for my $pkgpart ( $params->{'pkgpart'} ) {
1475 # if ( ref $pkgpart ) {
1476 # my $where = join(',', map { /^(\d+)$/ ? $1 : () } @$pkgpart );
1477 # push @where, "cust_pkg.pkgpart IN ($where)" if $where;
1479 # elsif ( $pkgpart =~ /^(\d+)$/ ) {
1480 # push @where, "cust_pkg.pkgpart = $1";
1483 if ( $params->{'pkgpart'} ) {
1484 my @pkgpart = ref( $params->{'pkgpart'} )
1485 ? @{ $params->{'pkgpart'} }
1486 : $params->{'pkgpart'}
1487 ? ( $params->{'pkgpart'} )
1489 @pkgpart = grep /^(\d+)$/, @pkgpart;
1490 push @where, 'cust_pkg.pkgpart IN ('. join(',', @pkgpart ). ')' if @pkgpart;
1494 if ( $params->{'svcnum'} ) {
1495 my @svcnum = ref( $params->{'svcnum'} )
1496 ? @{ $params->{'svcnum'} }
1497 : $params->{'svcnum'};
1498 @svcnum = grep /^\d+$/, @svcnum;
1499 push @where, 'svcnum IN ('. join(',', @svcnum) . ')' if @svcnum;
1503 if ( $params->{'svcpart'} ) {
1504 my @svcpart = ref( $params->{'svcpart'} )
1505 ? @{ $params->{'svcpart'} }
1506 : $params->{'svcpart'}
1507 ? ( $params->{'svcpart'} )
1509 @svcpart = grep /^(\d+)$/, @svcpart;
1510 push @where, 'svcpart IN ('. join(',', @svcpart ). ')' if @svcpart;
1513 if ( $params->{'exportnum'} =~ /^(\d+)$/ ) {
1514 push @from, ' LEFT JOIN export_svc USING ( svcpart )';
1515 push @where, "exportnum = $1";
1518 if ( defined($params->{'cancelled'}) ) {
1519 if ($params->{'cancelled'}) {
1520 push @where, "cust_pkg.cancel IS NOT NULL";
1522 push @where, "cust_pkg.cancel IS NULL";
1526 # # sector and tower
1527 # my @where_sector = $class->tower_sector_sql($params);
1528 # if ( @where_sector ) {
1529 # push @where, @where_sector;
1530 # push @from, ' LEFT JOIN tower_sector USING ( sectornum )';
1533 # here is the agent virtualization
1534 #if ($params->{CurrentUser}) {
1536 # qsearchs('access_user', { username => $params->{CurrentUser} });
1538 # if ($access_user) {
1539 # push @where, $access_user->agentnums_sql('table'=>'cust_main');
1541 # push @where, "1=0";
1544 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql(
1545 'table' => 'cust_main',
1546 'null_right' => 'View/link unlinked services',
1550 push @where, @{ $params->{'where'} } if $params->{'where'};
1552 my $addl_from = join(' ', @from);
1553 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
1555 my $table = $class->table;
1557 my $count_query = "SELECT COUNT(*) FROM $table $addl_from $extra_sql";
1558 #if ( keys %svc_X ) {
1559 # $count_query .= ' WHERE '.
1560 # join(' AND ', map "$_ = ". dbh->quote($svc_X{$_}),
1568 'select' => join(', ',
1571 'cust_main.custnum',
1572 @{ $params->{'addl_select'} || [] },
1573 FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
1575 'addl_from' => $addl_from,
1576 'extra_sql' => $extra_sql,
1577 'order_by' => $params->{'order_by'},
1578 'count_query' => $count_query,
1587 The setfixed method return value.
1589 B<export> method isn't used by insert and replace methods yet.
1593 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
1594 from the base documentation.