1 package FS::svc_Common;
4 use vars qw( @ISA $noexport_hack $DEBUG $me
5 $overlimit_missing_cust_svc_nonfatal_kludge );
6 use Carp qw( cluck carp croak confess ); #specify cluck have to specify them all
7 use Scalar::Util qw( blessed );
8 use FS::Record qw( qsearch qsearchs fields dbh );
9 use FS::cust_main_Mixin;
14 use FS::inventory_item;
15 use FS::inventory_class;
17 @ISA = qw( FS::cust_main_Mixin FS::Record );
19 $me = '[FS::svc_Common]';
22 $overlimit_missing_cust_svc_nonfatal_kludge = 0;
26 FS::svc_Common - Object method for all svc_ records
32 @ISA = 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.
43 =item search_sql_field FIELD STRING
45 Class method which returns an SQL fragment to search for STRING in FIELD.
47 It is now case-insensitive by default.
51 sub search_sql_field {
52 my( $class, $field, $string ) = @_;
53 my $table = $class->table;
54 my $q_string = dbh->quote($string);
55 "LOWER($table.$field) = LOWER($q_string)";
58 #fallback for services that don't provide a search...
60 #my( $class, $string ) = @_;
70 my $class = ref($proto) || $proto;
72 bless ($self, $class);
74 unless ( defined ( $self->table ) ) {
75 $self->{'Table'} = shift;
76 carp "warning: FS::Record::new called with table name ". $self->{'Table'};
79 #$self->{'Hash'} = shift;
81 $self->{'Hash'} = { map { $_ => $newhash->{$_} } qw(svcnum svcpart) };
83 $self->setdefault( $self->_fieldhandlers )
86 $self->{'Hash'}{$_} = $newhash->{$_}
87 foreach grep { defined($newhash->{$_}) && length($newhash->{$_}) }
90 foreach my $field ( grep !defined($self->{'Hash'}{$_}), $self->fields ) {
91 $self->{'Hash'}{$field}='';
94 $self->_rebless if $self->can('_rebless');
96 $self->{'modified'} = 0;
98 $self->_cache($self->{'Hash'}, shift) if $self->can('_cache') && @_;
104 sub _fieldhandlers { {}; }
108 # This restricts the fields based on part_svc_column and the svcpart of
109 # the service. There are four possible cases:
110 # 1. svcpart passed as part of the svc_x hash.
111 # 2. svcpart fetched via cust_svc based on svcnum.
112 # 3. No svcnum or svcpart. In this case, return ALL the fields with
113 # dbtable eq $self->table.
114 # 4. Called via "fields('svc_acct')" or something similar. In this case
115 # there is no $self object.
119 my @vfields = $self->SUPER::virtual_fields;
121 return @vfields unless (ref $self); # Case 4
123 if ($self->svcpart) { # Case 1
124 $svcpart = $self->svcpart;
125 } elsif ( $self->svcnum
126 && qsearchs('cust_svc',{'svcnum'=>$self->svcnum} )
128 $svcpart = $self->cust_svc->svcpart;
133 if ($svcpart) { #Cases 1 and 2
134 my %flags = map { $_->columnname, $_->columnflag } (
135 qsearch ('part_svc_column', { svcpart => $svcpart } )
137 return grep { not ( defined($flags{$_}) && $flags{$_} eq 'X') } @vfields;
146 svc_Common provides a fallback label subroutine that just returns the svcnum.
152 cluck "warning: ". ref($self). " not loaded or missing label method; ".
164 Checks the validity of fields in this record.
166 At present, this does nothing but call FS::Record::check (which, in turn,
167 does nothing but run virtual field checks).
176 =item insert [ , OPTION => VALUE ... ]
178 Adds this record to the database. If there is an error, returns the error,
179 otherwise returns false.
181 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
182 defined. An FS::cust_svc record will be created and inserted.
184 Currently available options are: I<jobnums>, I<child_objects> and
187 If I<jobnum> is set to an array reference, the jobnums of any export jobs will
188 be added to the referenced array.
190 If I<child_objects> is set to an array reference of FS::tablename objects (for
191 example, FS::acct_snarf objects), they will have their svcnum field set and
192 will be inserted after this record, but before any exports are run. Each
193 element of the array can also optionally be a two-element array reference
194 containing the child object and the name of an alternate field to be filled in
195 with the newly-inserted svcnum, for example C<[ $svc_forward, 'srcsvc' ]>
197 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
198 jobnums), all provisioning jobs will have a dependancy on the supplied
199 jobnum(s) (they will not run until the specific job(s) complete(s)).
201 If I<export_args> is set to an array reference, the referenced list will be
202 passed to export commands.
209 warn "[$me] insert called with options ".
210 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
214 local $FS::queue::jobnums = \@jobnums;
215 warn "[$me] insert: set \$FS::queue::jobnums to $FS::queue::jobnums\n"
217 my $objects = $options{'child_objects'} || [];
218 my $depend_jobnums = $options{'depend_jobnum'} || [];
219 $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
221 local $SIG{HUP} = 'IGNORE';
222 local $SIG{INT} = 'IGNORE';
223 local $SIG{QUIT} = 'IGNORE';
224 local $SIG{TERM} = 'IGNORE';
225 local $SIG{TSTP} = 'IGNORE';
226 local $SIG{PIPE} = 'IGNORE';
228 my $oldAutoCommit = $FS::UID::AutoCommit;
229 local $FS::UID::AutoCommit = 0;
232 my $svcnum = $self->svcnum;
233 my $cust_svc = $svcnum ? qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) : '';
234 #unless ( $svcnum ) {
235 if ( !$svcnum or !$cust_svc ) {
236 $cust_svc = new FS::cust_svc ( {
237 #hua?# 'svcnum' => $svcnum,
238 'svcnum' => $self->svcnum,
239 'pkgnum' => $self->pkgnum,
240 'svcpart' => $self->svcpart,
242 my $error = $cust_svc->insert;
244 $dbh->rollback if $oldAutoCommit;
247 $svcnum = $self->svcnum($cust_svc->svcnum);
249 #$cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
250 unless ( $cust_svc ) {
251 $dbh->rollback if $oldAutoCommit;
252 return "no cust_svc record found for svcnum ". $self->svcnum;
254 $self->pkgnum($cust_svc->pkgnum);
255 $self->svcpart($cust_svc->svcpart);
258 my $error = $self->preinsert_hook_first
259 || $self->set_auto_inventory
261 || $self->_check_duplicate
262 || $self->preinsert_hook
263 || $self->SUPER::insert;
265 $dbh->rollback if $oldAutoCommit;
269 foreach my $object ( @$objects ) {
271 if ( ref($object) eq 'ARRAY' ) {
272 ($obj, $field) = @$object;
277 $obj->$field($self->svcnum);
278 $error = $obj->insert;
280 $dbh->rollback if $oldAutoCommit;
286 unless ( $noexport_hack ) {
288 warn "[$me] insert: \$FS::queue::jobnums is $FS::queue::jobnums\n"
291 my $export_args = $options{'export_args'} || [];
293 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
294 my $error = $part_export->export_insert($self, @$export_args);
296 $dbh->rollback if $oldAutoCommit;
297 return "exporting to ". $part_export->exporttype.
298 " (transaction rolled back): $error";
302 foreach my $depend_jobnum ( @$depend_jobnums ) {
303 warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
305 foreach my $jobnum ( @jobnums ) {
306 my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
307 warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
309 my $error = $queue->depend_insert($depend_jobnum);
311 $dbh->rollback if $oldAutoCommit;
312 return "error queuing job dependancy: $error";
319 if ( exists $options{'jobnums'} ) {
320 push @{ $options{'jobnums'} }, @jobnums;
323 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
329 sub preinsert_hook_first { ''; }
330 sub _check_duplcate { ''; }
331 sub preinsert_hook { ''; }
332 sub table_dupcheck_fields { (); }
334 =item delete [ , OPTION => VALUE ... ]
336 Deletes this account from the database. If there is an error, returns the
337 error, otherwise returns false.
339 The corresponding FS::cust_svc record will be deleted as well.
346 my $export_args = $options{'export_args'} || [];
348 local $SIG{HUP} = 'IGNORE';
349 local $SIG{INT} = 'IGNORE';
350 local $SIG{QUIT} = 'IGNORE';
351 local $SIG{TERM} = 'IGNORE';
352 local $SIG{TSTP} = 'IGNORE';
353 local $SIG{PIPE} = 'IGNORE';
355 my $oldAutoCommit = $FS::UID::AutoCommit;
356 local $FS::UID::AutoCommit = 0;
359 my $error = $self->SUPER::delete
360 || $self->export('delete', @$export_args)
361 || $self->return_inventory
362 || $self->cust_svc->delete
365 $dbh->rollback if $oldAutoCommit;
369 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
374 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ]
376 Replaces OLD_RECORD with this one. If there is an error, returns the error,
377 otherwise returns false.
384 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
389 ( ref($_[0]) eq 'HASH' )
393 local $SIG{HUP} = 'IGNORE';
394 local $SIG{INT} = 'IGNORE';
395 local $SIG{QUIT} = 'IGNORE';
396 local $SIG{TERM} = 'IGNORE';
397 local $SIG{TSTP} = 'IGNORE';
398 local $SIG{PIPE} = 'IGNORE';
400 my $oldAutoCommit = $FS::UID::AutoCommit;
401 local $FS::UID::AutoCommit = 0;
404 my $error = $new->set_auto_inventory;
406 $dbh->rollback if $oldAutoCommit;
410 #redundant, but so any duplicate fields are maniuplated as appropriate
411 # (svc_phone.phonenum)
412 $error = $new->check;
414 $dbh->rollback if $oldAutoCommit;
418 #if ( $old->username ne $new->username || $old->domsvc != $new->domsvc ) {
419 if ( grep { $old->$_ ne $new->$_ } $new->table_dupcheck_fields ) {
421 $new->svcpart( $new->cust_svc->svcpart ) unless $new->svcpart;
422 $error = $new->_check_duplicate;
424 $dbh->rollback if $oldAutoCommit;
429 $error = $new->SUPER::replace($old);
431 $dbh->rollback if $oldAutoCommit;
436 unless ( $noexport_hack ) {
438 my $export_args = $options->{'export_args'} || [];
440 #not quite false laziness, but same pattern as FS::svc_acct::replace and
441 #FS::part_export::sqlradius::_export_replace. List::Compare or something
442 #would be useful but too much of a pain in the ass to deploy
444 my @old_part_export = $old->cust_svc->part_svc->part_export;
445 my %old_exportnum = map { $_->exportnum => 1 } @old_part_export;
446 my @new_part_export =
448 ? qsearchs('part_svc', { svcpart=>$new->svcpart } )->part_export
449 : $new->cust_svc->part_svc->part_export;
450 my %new_exportnum = map { $_->exportnum => 1 } @new_part_export;
452 foreach my $delete_part_export (
453 grep { ! $new_exportnum{$_->exportnum} } @old_part_export
455 my $error = $delete_part_export->export_delete($old, @$export_args);
457 $dbh->rollback if $oldAutoCommit;
458 return "error deleting, export to ". $delete_part_export->exporttype.
459 " (transaction rolled back): $error";
463 foreach my $replace_part_export (
464 grep { $old_exportnum{$_->exportnum} } @new_part_export
467 $replace_part_export->export_replace( $new, $old, @$export_args);
469 $dbh->rollback if $oldAutoCommit;
470 return "error exporting to ". $replace_part_export->exporttype.
471 " (transaction rolled back): $error";
475 foreach my $insert_part_export (
476 grep { ! $old_exportnum{$_->exportnum} } @new_part_export
478 my $error = $insert_part_export->export_insert($new, @$export_args );
480 $dbh->rollback if $oldAutoCommit;
481 return "error inserting export to ". $insert_part_export->exporttype.
482 " (transaction rolled back): $error";
488 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
494 Sets any fixed fields for this service (see L<FS::part_svc>). If there is an
495 error, returns the error, otherwise returns the FS::part_svc object (use ref()
496 to test the return). Usually called by the check method.
502 $self->setx('F', @_);
507 Sets all fields to their defaults (see L<FS::part_svc>), overriding their
508 current values. If there is an error, returns the error, otherwise returns
509 the FS::part_svc object (use ref() to test the return).
515 $self->setx('D', @_ );
518 =item set_default_and_fixed
522 sub set_default_and_fixed {
524 $self->setx( [ 'D', 'F' ], @_ );
527 =item setx FLAG | FLAG_ARRAYREF , [ CALLBACK_HASHREF ]
529 Sets fields according to the passed in flag or arrayref of flags.
531 Optionally, a hashref of field names and callback coderefs can be passed.
532 If a coderef exists for a given field name, instead of setting the field,
533 the coderef is called with the column value (part_svc_column.columnvalue)
534 as the single parameter.
541 my @x = ref($x) ? @$x : ($x);
542 my $coderef = scalar(@_) ? shift : $self->_fieldhandlers;
545 $self->ut_numbern('svcnum')
547 return $error if $error;
549 my $part_svc = $self->part_svc;
550 return "Unknown svcpart" unless $part_svc;
552 #set default/fixed/whatever fields from part_svc
554 foreach my $part_svc_column (
555 grep { my $f = $_->columnflag; grep { $f eq $_ } @x } #columnflag in @x
556 $part_svc->all_part_svc_column
559 my $columnname = $part_svc_column->columnname;
560 my $columnvalue = $part_svc_column->columnvalue;
562 $columnvalue = &{ $coderef->{$columnname} }( $self, $columnvalue )
563 if exists( $coderef->{$columnname} );
564 $self->setfield( $columnname, $columnvalue );
577 if ( $self->get('svcpart') ) {
578 $svcpart = $self->get('svcpart');
579 } elsif ( $self->svcnum && qsearchs('cust_svc', {'svcnum'=>$self->svcnum}) ) {
580 my $cust_svc = $self->cust_svc;
581 return "Unknown svcnum" unless $cust_svc;
582 $svcpart = $cust_svc->svcpart;
585 qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
589 =item set_auto_inventory
591 Sets any fields which auto-populate from inventory (see L<FS::part_svc>).
592 If there is an error, returns the error, otherwise returns false.
596 sub set_auto_inventory {
600 $self->ut_numbern('svcnum')
602 return $error if $error;
604 my $part_svc = $self->part_svc;
605 return "Unkonwn svcpart" unless $part_svc;
607 local $SIG{HUP} = 'IGNORE';
608 local $SIG{INT} = 'IGNORE';
609 local $SIG{QUIT} = 'IGNORE';
610 local $SIG{TERM} = 'IGNORE';
611 local $SIG{TSTP} = 'IGNORE';
612 local $SIG{PIPE} = 'IGNORE';
614 my $oldAutoCommit = $FS::UID::AutoCommit;
615 local $FS::UID::AutoCommit = 0;
618 #set default/fixed/whatever fields from part_svc
619 my $table = $self->table;
620 foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
621 my $part_svc_column = $part_svc->part_svc_column($field);
622 if ( $part_svc_column->columnflag eq 'A' && $self->$field() eq '' ) {
624 my $classnum = $part_svc_column->columnvalue;
625 my $inventory_item = qsearchs({
626 'table' => 'inventory_item',
627 'hashref' => { 'classnum' => $classnum,
630 'extra_sql' => 'LIMIT 1 FOR UPDATE',
633 unless ( $inventory_item ) {
634 $dbh->rollback if $oldAutoCommit;
635 my $inventory_class =
636 qsearchs('inventory_class', { 'classnum' => $classnum } );
637 return "Can't find inventory_class.classnum $classnum"
638 unless $inventory_class;
639 return "Out of ". $inventory_class->classname. "s\n"; #Lingua:: BS
643 $inventory_item->svcnum( $self->svcnum );
644 my $ierror = $inventory_item->replace();
646 $dbh->rollback if $oldAutoCommit;
647 return "Error provisioning inventory: $ierror";
651 $self->setfield( $field, $inventory_item->item );
656 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
662 =item return_inventory
666 sub return_inventory {
669 local $SIG{HUP} = 'IGNORE';
670 local $SIG{INT} = 'IGNORE';
671 local $SIG{QUIT} = 'IGNORE';
672 local $SIG{TERM} = 'IGNORE';
673 local $SIG{TSTP} = 'IGNORE';
674 local $SIG{PIPE} = 'IGNORE';
676 my $oldAutoCommit = $FS::UID::AutoCommit;
677 local $FS::UID::AutoCommit = 0;
680 foreach my $inventory_item ( $self->inventory_item ) {
681 $inventory_item->svcnum('');
682 my $error = $inventory_item->replace();
684 $dbh->rollback if $oldAutoCommit;
685 return "Error returning inventory: $error";
689 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
696 Returns the inventory items associated with this svc_ record, as
697 FS::inventory_item objects (see L<FS::inventory_item>.
704 'table' => 'inventory_item',
705 'hashref' => { 'svcnum' => $self->svcnum, },
711 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
712 object (see L<FS::cust_svc>).
718 qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
723 Runs export_suspend callbacks.
730 my $export_args = $options{'export_args'} || [];
731 $self->export('suspend', @$export_args);
736 Runs export_unsuspend callbacks.
743 my $export_args = $options{'export_args'} || [];
744 $self->export('unsuspend', @$export_args);
749 Runs export_links callbacks and returns the links.
756 $self->export('links', $return);
760 =item export HOOK [ EXPORT_ARGS ]
762 Runs the provided export hook (i.e. "suspend", "unsuspend") for this service.
767 my( $self, $method ) = ( shift, shift );
769 $method = "export_$method" unless $method =~ /^export_/;
771 local $SIG{HUP} = 'IGNORE';
772 local $SIG{INT} = 'IGNORE';
773 local $SIG{QUIT} = 'IGNORE';
774 local $SIG{TERM} = 'IGNORE';
775 local $SIG{TSTP} = 'IGNORE';
776 local $SIG{PIPE} = 'IGNORE';
778 my $oldAutoCommit = $FS::UID::AutoCommit;
779 local $FS::UID::AutoCommit = 0;
783 unless ( $noexport_hack ) {
784 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
785 next unless $part_export->can($method);
786 my $error = $part_export->$method($self, @_);
788 $dbh->rollback if $oldAutoCommit;
789 return "error exporting $method event to ". $part_export->exporttype.
790 " (transaction rolled back): $error";
795 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
802 Sets or retrieves overlimit date.
808 #$self->cust_svc->overlimit(@_);
809 my $cust_svc = $self->cust_svc;
810 unless ( $cust_svc ) { #wtf?
811 my $error = "$me overlimit: missing cust_svc record for svc_acct svcnum ".
813 if ( $overlimit_missing_cust_svc_nonfatal_kludge ) {
814 cluck "$error; continuing anyway as requested";
820 $cust_svc->overlimit(@_);
825 Stub - returns false (no error) so derived classes don't need to define this
826 methods. Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
828 This method is called *before* the deletion step which actually deletes the
829 services. This method should therefore only be used for "pre-deletion"
830 cancellation steps, if necessary.
836 =item clone_suspended
838 Constructor used by FS::part_export::_export_suspend fallback. Stub returning
839 same object for svc_ classes which don't implement a suspension fallback
840 (everything except svc_acct at the moment). Document better.
844 sub clone_suspended {
848 =item clone_kludge_unsuspend
850 Constructor used by FS::part_export::_export_unsuspend fallback. Stub returning
851 same object for svc_ classes which don't implement a suspension fallback
852 (everything except svc_acct at the moment). Document better.
856 sub clone_kludge_unsuspend {
864 The setfixed method return value.
866 B<export> method isn't used by insert and replace methods yet.
870 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
871 from the base documentation.