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->set_auto_inventory
260 || $self->_check_duplicate
261 || $self->SUPER::insert;
263 $dbh->rollback if $oldAutoCommit;
267 foreach my $object ( @$objects ) {
269 if ( ref($object) eq 'ARRAY' ) {
270 ($obj, $field) = @$object;
275 $obj->$field($self->svcnum);
276 $error = $obj->insert;
278 $dbh->rollback if $oldAutoCommit;
284 unless ( $noexport_hack ) {
286 warn "[$me] insert: \$FS::queue::jobnums is $FS::queue::jobnums\n"
289 my $export_args = $options{'export_args'} || [];
291 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
292 my $error = $part_export->export_insert($self, @$export_args);
294 $dbh->rollback if $oldAutoCommit;
295 return "exporting to ". $part_export->exporttype.
296 " (transaction rolled back): $error";
300 foreach my $depend_jobnum ( @$depend_jobnums ) {
301 warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
303 foreach my $jobnum ( @jobnums ) {
304 my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
305 warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
307 my $error = $queue->depend_insert($depend_jobnum);
309 $dbh->rollback if $oldAutoCommit;
310 return "error queuing job dependancy: $error";
317 if ( exists $options{'jobnums'} ) {
318 push @{ $options{'jobnums'} }, @jobnums;
321 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
327 sub _check_duplcate { ''; }
328 sub table_dupcheck_fields { (); }
330 =item delete [ , OPTION => VALUE ... ]
332 Deletes this account from the database. If there is an error, returns the
333 error, otherwise returns false.
335 The corresponding FS::cust_svc record will be deleted as well.
342 my $export_args = $options{'export_args'} || [];
344 local $SIG{HUP} = 'IGNORE';
345 local $SIG{INT} = 'IGNORE';
346 local $SIG{QUIT} = 'IGNORE';
347 local $SIG{TERM} = 'IGNORE';
348 local $SIG{TSTP} = 'IGNORE';
349 local $SIG{PIPE} = 'IGNORE';
351 my $oldAutoCommit = $FS::UID::AutoCommit;
352 local $FS::UID::AutoCommit = 0;
355 my $error = $self->SUPER::delete
356 || $self->export('delete', @$export_args)
357 || $self->return_inventory
358 || $self->cust_svc->delete
361 $dbh->rollback if $oldAutoCommit;
365 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
370 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ]
372 Replaces OLD_RECORD with this one. If there is an error, returns the error,
373 otherwise returns false.
380 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
385 ( ref($_[0]) eq 'HASH' )
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 = $new->set_auto_inventory;
402 $dbh->rollback if $oldAutoCommit;
406 #redundant, but so any duplicate fields are maniuplated as appropriate
407 # (svc_phone.phonenum)
408 $error = $new->check;
410 $dbh->rollback if $oldAutoCommit;
414 #if ( $old->username ne $new->username || $old->domsvc != $new->domsvc ) {
415 if ( grep { $old->$_ ne $new->$_ } $new->table_dupcheck_fields ) {
417 $new->svcpart( $new->cust_svc->svcpart ) unless $new->svcpart;
418 $error = $new->_check_duplicate;
420 $dbh->rollback if $oldAutoCommit;
425 $error = $new->SUPER::replace($old);
427 $dbh->rollback if $oldAutoCommit;
432 unless ( $noexport_hack ) {
434 my $export_args = $options->{'export_args'} || [];
436 #not quite false laziness, but same pattern as FS::svc_acct::replace and
437 #FS::part_export::sqlradius::_export_replace. List::Compare or something
438 #would be useful but too much of a pain in the ass to deploy
440 my @old_part_export = $old->cust_svc->part_svc->part_export;
441 my %old_exportnum = map { $_->exportnum => 1 } @old_part_export;
442 my @new_part_export =
444 ? qsearchs('part_svc', { svcpart=>$new->svcpart } )->part_export
445 : $new->cust_svc->part_svc->part_export;
446 my %new_exportnum = map { $_->exportnum => 1 } @new_part_export;
448 foreach my $delete_part_export (
449 grep { ! $new_exportnum{$_->exportnum} } @old_part_export
451 my $error = $delete_part_export->export_delete($old, @$export_args);
453 $dbh->rollback if $oldAutoCommit;
454 return "error deleting, export to ". $delete_part_export->exporttype.
455 " (transaction rolled back): $error";
459 foreach my $replace_part_export (
460 grep { $old_exportnum{$_->exportnum} } @new_part_export
463 $replace_part_export->export_replace( $new, $old, @$export_args);
465 $dbh->rollback if $oldAutoCommit;
466 return "error exporting to ". $replace_part_export->exporttype.
467 " (transaction rolled back): $error";
471 foreach my $insert_part_export (
472 grep { ! $old_exportnum{$_->exportnum} } @new_part_export
474 my $error = $insert_part_export->export_insert($new, @$export_args );
476 $dbh->rollback if $oldAutoCommit;
477 return "error inserting export to ". $insert_part_export->exporttype.
478 " (transaction rolled back): $error";
484 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
490 Sets any fixed fields for this service (see L<FS::part_svc>). If there is an
491 error, returns the error, otherwise returns the FS::part_svc object (use ref()
492 to test the return). Usually called by the check method.
498 $self->setx('F', @_);
503 Sets all fields to their defaults (see L<FS::part_svc>), overriding their
504 current values. If there is an error, returns the error, otherwise returns
505 the FS::part_svc object (use ref() to test the return).
511 $self->setx('D', @_ );
514 =item set_default_and_fixed
518 sub set_default_and_fixed {
520 $self->setx( [ 'D', 'F' ], @_ );
523 =item setx FLAG | FLAG_ARRAYREF , [ CALLBACK_HASHREF ]
525 Sets fields according to the passed in flag or arrayref of flags.
527 Optionally, a hashref of field names and callback coderefs can be passed.
528 If a coderef exists for a given field name, instead of setting the field,
529 the coderef is called with the column value (part_svc_column.columnvalue)
530 as the single parameter.
537 my @x = ref($x) ? @$x : ($x);
538 my $coderef = scalar(@_) ? shift : $self->_fieldhandlers;
541 $self->ut_numbern('svcnum')
543 return $error if $error;
545 my $part_svc = $self->part_svc;
546 return "Unknown svcpart" unless $part_svc;
548 #set default/fixed/whatever fields from part_svc
550 foreach my $part_svc_column (
551 grep { my $f = $_->columnflag; grep { $f eq $_ } @x } #columnflag in @x
552 $part_svc->all_part_svc_column
555 my $columnname = $part_svc_column->columnname;
556 my $columnvalue = $part_svc_column->columnvalue;
558 $columnvalue = &{ $coderef->{$columnname} }( $self, $columnvalue )
559 if exists( $coderef->{$columnname} );
560 $self->setfield( $columnname, $columnvalue );
573 if ( $self->get('svcpart') ) {
574 $svcpart = $self->get('svcpart');
575 } elsif ( $self->svcnum && qsearchs('cust_svc', {'svcnum'=>$self->svcnum}) ) {
576 my $cust_svc = $self->cust_svc;
577 return "Unknown svcnum" unless $cust_svc;
578 $svcpart = $cust_svc->svcpart;
581 qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
585 =item set_auto_inventory
587 Sets any fields which auto-populate from inventory (see L<FS::part_svc>).
588 If there is an error, returns the error, otherwise returns false.
592 sub set_auto_inventory {
596 $self->ut_numbern('svcnum')
598 return $error if $error;
600 my $part_svc = $self->part_svc;
601 return "Unkonwn svcpart" unless $part_svc;
603 local $SIG{HUP} = 'IGNORE';
604 local $SIG{INT} = 'IGNORE';
605 local $SIG{QUIT} = 'IGNORE';
606 local $SIG{TERM} = 'IGNORE';
607 local $SIG{TSTP} = 'IGNORE';
608 local $SIG{PIPE} = 'IGNORE';
610 my $oldAutoCommit = $FS::UID::AutoCommit;
611 local $FS::UID::AutoCommit = 0;
614 #set default/fixed/whatever fields from part_svc
615 my $table = $self->table;
616 foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
617 my $part_svc_column = $part_svc->part_svc_column($field);
618 if ( $part_svc_column->columnflag eq 'A' && $self->$field() eq '' ) {
620 my $classnum = $part_svc_column->columnvalue;
621 my $inventory_item = qsearchs({
622 'table' => 'inventory_item',
623 'hashref' => { 'classnum' => $classnum,
626 'extra_sql' => 'LIMIT 1 FOR UPDATE',
629 unless ( $inventory_item ) {
630 $dbh->rollback if $oldAutoCommit;
631 my $inventory_class =
632 qsearchs('inventory_class', { 'classnum' => $classnum } );
633 return "Can't find inventory_class.classnum $classnum"
634 unless $inventory_class;
635 return "Out of ". $inventory_class->classname. "s\n"; #Lingua:: BS
639 $inventory_item->svcnum( $self->svcnum );
640 my $ierror = $inventory_item->replace();
642 $dbh->rollback if $oldAutoCommit;
643 return "Error provisioning inventory: $ierror";
647 $self->setfield( $field, $inventory_item->item );
652 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
658 =item return_inventory
662 sub return_inventory {
665 local $SIG{HUP} = 'IGNORE';
666 local $SIG{INT} = 'IGNORE';
667 local $SIG{QUIT} = 'IGNORE';
668 local $SIG{TERM} = 'IGNORE';
669 local $SIG{TSTP} = 'IGNORE';
670 local $SIG{PIPE} = 'IGNORE';
672 my $oldAutoCommit = $FS::UID::AutoCommit;
673 local $FS::UID::AutoCommit = 0;
676 foreach my $inventory_item ( $self->inventory_item ) {
677 $inventory_item->svcnum('');
678 my $error = $inventory_item->replace();
680 $dbh->rollback if $oldAutoCommit;
681 return "Error returning inventory: $error";
685 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
692 Returns the inventory items associated with this svc_ record, as
693 FS::inventory_item objects (see L<FS::inventory_item>.
700 'table' => 'inventory_item',
701 'hashref' => { 'svcnum' => $self->svcnum, },
707 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
708 object (see L<FS::cust_svc>).
714 qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
719 Runs export_suspend callbacks.
726 my $export_args = $options{'export_args'} || [];
727 $self->export('suspend', @$export_args);
732 Runs export_unsuspend callbacks.
739 my $export_args = $options{'export_args'} || [];
740 $self->export('unsuspend', @$export_args);
745 Runs export_links callbacks and returns the links.
752 $self->export('links', $return);
756 =item export HOOK [ EXPORT_ARGS ]
758 Runs the provided export hook (i.e. "suspend", "unsuspend") for this service.
763 my( $self, $method ) = ( shift, shift );
765 $method = "export_$method" unless $method =~ /^export_/;
767 local $SIG{HUP} = 'IGNORE';
768 local $SIG{INT} = 'IGNORE';
769 local $SIG{QUIT} = 'IGNORE';
770 local $SIG{TERM} = 'IGNORE';
771 local $SIG{TSTP} = 'IGNORE';
772 local $SIG{PIPE} = 'IGNORE';
774 my $oldAutoCommit = $FS::UID::AutoCommit;
775 local $FS::UID::AutoCommit = 0;
779 unless ( $noexport_hack ) {
780 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
781 next unless $part_export->can($method);
782 my $error = $part_export->$method($self, @_);
784 $dbh->rollback if $oldAutoCommit;
785 return "error exporting $method event to ". $part_export->exporttype.
786 " (transaction rolled back): $error";
791 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
798 Sets or retrieves overlimit date.
804 #$self->cust_svc->overlimit(@_);
805 my $cust_svc = $self->cust_svc;
806 unless ( $cust_svc ) { #wtf?
807 my $error = "$me overlimit: missing cust_svc record for svc_acct svcnum ".
809 if ( $overlimit_missing_cust_svc_nonfatal_kludge ) {
810 cluck "$error; continuing anyway as requested";
816 $cust_svc->overlimit(@_);
821 Stub - returns false (no error) so derived classes don't need to define this
822 methods. Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
824 This method is called *before* the deletion step which actually deletes the
825 services. This method should therefore only be used for "pre-deletion"
826 cancellation steps, if necessary.
832 =item clone_suspended
834 Constructor used by FS::part_export::_export_suspend fallback. Stub returning
835 same object for svc_ classes which don't implement a suspension fallback
836 (everything except svc_acct at the moment). Document better.
840 sub clone_suspended {
844 =item clone_kludge_unsuspend
846 Constructor used by FS::part_export::_export_unsuspend fallback. Stub returning
847 same object for svc_ classes which don't implement a suspension fallback
848 (everything except svc_acct at the moment). Document better.
852 sub clone_kludge_unsuspend {
860 The setfixed method return value.
862 B<export> method isn't used by insert and replace methods yet.
866 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
867 from the base documentation.