1 package FS::svc_Common;
4 use vars qw( @ISA $noexport_hack $DEBUG $me );
5 use Carp qw( cluck carp croak ); #specify cluck have to specify them all..
6 use Scalar::Util qw( blessed );
7 use FS::Record qw( qsearch qsearchs fields dbh );
8 use FS::cust_main_Mixin;
13 use FS::inventory_item;
14 use FS::inventory_class;
16 @ISA = qw( FS::cust_main_Mixin FS::Record );
18 $me = '[FS::svc_Common]';
23 FS::svc_Common - Object method for all svc_ records
29 @ISA = qw( FS::svc_Common );
33 FS::svc_Common is intended as a base class for table-specific classes to
34 inherit from, i.e. FS::svc_acct. FS::svc_Common inherits from FS::Record.
40 =item search_sql_field FIELD STRING
42 Class method which returns an SQL fragment to search for STRING in FIELD.
46 sub search_sql_field {
47 my( $class, $field, $string ) = @_;
48 my $table = $class->table;
49 my $q_string = dbh->quote($string);
50 "$table.$field = $q_string";
53 #fallback for services that don't provide a search...
55 #my( $class, $string ) = @_;
65 my $class = ref($proto) || $proto;
67 bless ($self, $class);
69 unless ( defined ( $self->table ) ) {
70 $self->{'Table'} = shift;
71 carp "warning: FS::Record::new called with table name ". $self->{'Table'};
74 #$self->{'Hash'} = shift;
76 $self->{'Hash'} = { map { $_ => $newhash->{$_} } qw(svcnum svcpart) };
78 $self->setdefault( $self->_fieldhandlers )
81 $self->{'Hash'}{$_} = $newhash->{$_}
82 foreach grep { defined($newhash->{$_}) && length($newhash->{$_}) }
85 foreach my $field ( grep !defined($self->{'Hash'}{$_}), $self->fields ) {
86 $self->{'Hash'}{$field}='';
89 $self->_rebless if $self->can('_rebless');
91 $self->{'modified'} = 0;
93 $self->_cache($self->{'Hash'}, shift) if $self->can('_cache') && @_;
99 sub _fieldhandlers { {}; }
103 # This restricts the fields based on part_svc_column and the svcpart of
104 # the service. There are four possible cases:
105 # 1. svcpart passed as part of the svc_x hash.
106 # 2. svcpart fetched via cust_svc based on svcnum.
107 # 3. No svcnum or svcpart. In this case, return ALL the fields with
108 # dbtable eq $self->table.
109 # 4. Called via "fields('svc_acct')" or something similar. In this case
110 # there is no $self object.
114 my @vfields = $self->SUPER::virtual_fields;
116 return @vfields unless (ref $self); # Case 4
118 if ($self->svcpart) { # Case 1
119 $svcpart = $self->svcpart;
120 } elsif ( $self->svcnum
121 && qsearchs('cust_svc',{'svcnum'=>$self->svcnum} )
123 $svcpart = $self->cust_svc->svcpart;
128 if ($svcpart) { #Cases 1 and 2
129 my %flags = map { $_->columnname, $_->columnflag } (
130 qsearch ('part_svc_column', { svcpart => $svcpart } )
132 return grep { not ( defined($flags{$_}) && $flags{$_} eq 'X') } @vfields;
141 svc_Common provides a fallback label subroutine that just returns the svcnum.
147 cluck "warning: ". ref($self). " not loaded or missing label method; ".
154 Checks the validity of fields in this record.
156 At present, this does nothing but call FS::Record::check (which, in turn,
157 does nothing but run virtual field checks).
166 =item insert [ , OPTION => VALUE ... ]
168 Adds this record to the database. If there is an error, returns the error,
169 otherwise returns false.
171 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
172 defined. An FS::cust_svc record will be created and inserted.
174 Currently available options are: I<jobnums>, I<child_objects> and
177 If I<jobnum> is set to an array reference, the jobnums of any export jobs will
178 be added to the referenced array.
180 If I<child_objects> is set to an array reference of FS::tablename objects (for
181 example, FS::acct_snarf objects), they will have their svcnum field set and
182 will be inserted after this record, but before any exports are run. Each
183 element of the array can also optionally be a two-element array reference
184 containing the child object and the name of an alternate field to be filled in
185 with the newly-inserted svcnum, for example C<[ $svc_forward, 'srcsvc' ]>
187 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
188 jobnums), all provisioning jobs will have a dependancy on the supplied
189 jobnum(s) (they will not run until the specific job(s) complete(s)).
191 If I<export_args> is set to an array reference, the referenced list will be
192 passed to export commands.
199 warn "[$me] insert called with options ".
200 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
204 local $FS::queue::jobnums = \@jobnums;
205 warn "[$me] insert: set \$FS::queue::jobnums to $FS::queue::jobnums\n"
207 my $objects = $options{'child_objects'} || [];
208 my $depend_jobnums = $options{'depend_jobnum'} || [];
209 $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
212 local $SIG{HUP} = 'IGNORE';
213 local $SIG{INT} = 'IGNORE';
214 local $SIG{QUIT} = 'IGNORE';
215 local $SIG{TERM} = 'IGNORE';
216 local $SIG{TSTP} = 'IGNORE';
217 local $SIG{PIPE} = 'IGNORE';
219 my $oldAutoCommit = $FS::UID::AutoCommit;
220 local $FS::UID::AutoCommit = 0;
223 $error = $self->check;
224 return $error if $error;
226 my $svcnum = $self->svcnum;
227 my $cust_svc = $svcnum ? qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) : '';
228 #unless ( $svcnum ) {
229 if ( !$svcnum or !$cust_svc ) {
230 $cust_svc = new FS::cust_svc ( {
231 #hua?# 'svcnum' => $svcnum,
232 'svcnum' => $self->svcnum,
233 'pkgnum' => $self->pkgnum,
234 'svcpart' => $self->svcpart,
236 $error = $cust_svc->insert;
238 $dbh->rollback if $oldAutoCommit;
241 $svcnum = $self->svcnum($cust_svc->svcnum);
243 #$cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
244 unless ( $cust_svc ) {
245 $dbh->rollback if $oldAutoCommit;
246 return "no cust_svc record found for svcnum ". $self->svcnum;
248 $self->pkgnum($cust_svc->pkgnum);
249 $self->svcpart($cust_svc->svcpart);
252 $error = $self->set_auto_inventory;
254 $dbh->rollback if $oldAutoCommit;
258 $error = $self->SUPER::insert;
260 $dbh->rollback if $oldAutoCommit;
264 foreach my $object ( @$objects ) {
266 if ( ref($object) eq 'ARRAY' ) {
267 ($obj, $field) = @$object;
272 $obj->$field($self->svcnum);
273 $error = $obj->insert;
275 $dbh->rollback if $oldAutoCommit;
281 unless ( $noexport_hack ) {
283 warn "[$me] insert: \$FS::queue::jobnums is $FS::queue::jobnums\n"
286 my $export_args = $options{'export_args'} || [];
288 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
289 my $error = $part_export->export_insert($self, @$export_args);
291 $dbh->rollback if $oldAutoCommit;
292 return "exporting to ". $part_export->exporttype.
293 " (transaction rolled back): $error";
297 foreach my $depend_jobnum ( @$depend_jobnums ) {
298 warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
300 foreach my $jobnum ( @jobnums ) {
301 my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
302 warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
304 my $error = $queue->depend_insert($depend_jobnum);
306 $dbh->rollback if $oldAutoCommit;
307 return "error queuing job dependancy: $error";
314 if ( exists $options{'jobnums'} ) {
315 push @{ $options{'jobnums'} }, @jobnums;
318 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
323 =item delete [ , OPTION => VALUE ... ]
325 Deletes this account from the database. If there is an error, returns the
326 error, otherwise returns false.
328 The corresponding FS::cust_svc record will be deleted as well.
335 my $export_args = $options{'export_args'} || [];
337 local $SIG{HUP} = 'IGNORE';
338 local $SIG{INT} = 'IGNORE';
339 local $SIG{QUIT} = 'IGNORE';
340 local $SIG{TERM} = 'IGNORE';
341 local $SIG{TSTP} = 'IGNORE';
342 local $SIG{PIPE} = 'IGNORE';
344 my $oldAutoCommit = $FS::UID::AutoCommit;
345 local $FS::UID::AutoCommit = 0;
348 my $error = $self->SUPER::delete
349 || $self->export('delete', @$export_args)
350 || $self->return_inventory
351 || $self->cust_svc->delete
354 $dbh->rollback if $oldAutoCommit;
358 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
363 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ]
365 Replaces OLD_RECORD with this one. If there is an error, returns the error,
366 otherwise returns false.
373 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
378 ( ref($_[0]) eq 'HASH' )
382 local $SIG{HUP} = 'IGNORE';
383 local $SIG{INT} = 'IGNORE';
384 local $SIG{QUIT} = 'IGNORE';
385 local $SIG{TERM} = 'IGNORE';
386 local $SIG{TSTP} = 'IGNORE';
387 local $SIG{PIPE} = 'IGNORE';
389 my $oldAutoCommit = $FS::UID::AutoCommit;
390 local $FS::UID::AutoCommit = 0;
393 my $error = $new->set_auto_inventory;
395 $dbh->rollback if $oldAutoCommit;
399 $error = $new->SUPER::replace($old);
401 $dbh->rollback if $oldAutoCommit;
406 unless ( $noexport_hack ) {
408 my $export_args = $options->{'export_args'} || [];
410 #not quite false laziness, but same pattern as FS::svc_acct::replace and
411 #FS::part_export::sqlradius::_export_replace. List::Compare or something
412 #would be useful but too much of a pain in the ass to deploy
414 my @old_part_export = $old->cust_svc->part_svc->part_export;
415 my %old_exportnum = map { $_->exportnum => 1 } @old_part_export;
416 my @new_part_export =
418 ? qsearchs('part_svc', { svcpart=>$new->svcpart } )->part_export
419 : $new->cust_svc->part_svc->part_export;
420 my %new_exportnum = map { $_->exportnum => 1 } @new_part_export;
422 foreach my $delete_part_export (
423 grep { ! $new_exportnum{$_->exportnum} } @old_part_export
425 my $error = $delete_part_export->export_delete($old, @$export_args);
427 $dbh->rollback if $oldAutoCommit;
428 return "error deleting, export to ". $delete_part_export->exporttype.
429 " (transaction rolled back): $error";
433 foreach my $replace_part_export (
434 grep { $old_exportnum{$_->exportnum} } @new_part_export
437 $replace_part_export->export_replace( $new, $old, @$export_args);
439 $dbh->rollback if $oldAutoCommit;
440 return "error exporting to ". $replace_part_export->exporttype.
441 " (transaction rolled back): $error";
445 foreach my $insert_part_export (
446 grep { ! $old_exportnum{$_->exportnum} } @new_part_export
448 my $error = $insert_part_export->export_insert($new, @$export_args );
450 $dbh->rollback if $oldAutoCommit;
451 return "error inserting export to ". $insert_part_export->exporttype.
452 " (transaction rolled back): $error";
458 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
464 Sets any fixed fields for this service (see L<FS::part_svc>). If there is an
465 error, returns the error, otherwise returns the FS::part_svc object (use ref()
466 to test the return). Usually called by the check method.
472 $self->setx('F', @_);
477 Sets all fields to their defaults (see L<FS::part_svc>), overriding their
478 current values. If there is an error, returns the error, otherwise returns
479 the FS::part_svc object (use ref() to test the return).
485 $self->setx('D', @_ );
488 =item set_default_and_fixed
492 sub set_default_and_fixed {
494 $self->setx( [ 'D', 'F' ], @_ );
497 =item setx FLAG | FLAG_ARRAYREF , [ CALLBACK_HASHREF ]
499 Sets fields according to the passed in flag or arrayref of flags.
501 Optionally, a hashref of field names and callback coderefs can be passed.
502 If a coderef exists for a given field name, instead of setting the field,
503 the coderef is called with the column value (part_svc_column.columnvalue)
504 as the single parameter.
511 my @x = ref($x) ? @$x : ($x);
512 my $coderef = scalar(@_) ? shift : $self->_fieldhandlers;
515 $self->ut_numbern('svcnum')
517 return $error if $error;
519 my $part_svc = $self->part_svc;
520 return "Unkonwn svcpart" unless $part_svc;
522 #set default/fixed/whatever fields from part_svc
524 foreach my $part_svc_column (
525 grep { my $f = $_->columnflag; grep { $f eq $_ } @x } #columnflag in @x
526 $part_svc->all_part_svc_column
529 my $columnname = $part_svc_column->columnname;
530 my $columnvalue = $part_svc_column->columnvalue;
532 $columnvalue = &{ $coderef->{$columnname} }( $self, $columnvalue )
533 if exists( $coderef->{$columnname} );
534 $self->setfield( $columnname, $columnvalue );
547 if ( $self->get('svcpart') ) {
548 $svcpart = $self->get('svcpart');
549 } elsif ( $self->svcnum && qsearchs('cust_svc', {'svcnum'=>$self->svcnum}) ) {
550 my $cust_svc = $self->cust_svc;
551 return "Unknown svcnum" unless $cust_svc;
552 $svcpart = $cust_svc->svcpart;
555 qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
559 =item set_auto_inventory
561 Sets any fields which auto-populate from inventory (see L<FS::part_svc>).
562 If there is an error, returns the error, otherwise returns false.
566 sub set_auto_inventory {
570 $self->ut_numbern('svcnum')
572 return $error if $error;
574 my $part_svc = $self->part_svc;
575 return "Unkonwn svcpart" unless $part_svc;
577 local $SIG{HUP} = 'IGNORE';
578 local $SIG{INT} = 'IGNORE';
579 local $SIG{QUIT} = 'IGNORE';
580 local $SIG{TERM} = 'IGNORE';
581 local $SIG{TSTP} = 'IGNORE';
582 local $SIG{PIPE} = 'IGNORE';
584 my $oldAutoCommit = $FS::UID::AutoCommit;
585 local $FS::UID::AutoCommit = 0;
588 #set default/fixed/whatever fields from part_svc
589 my $table = $self->table;
590 foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
591 my $part_svc_column = $part_svc->part_svc_column($field);
592 if ( $part_svc_column->columnflag eq 'A' && $self->$field() eq '' ) {
594 my $classnum = $part_svc_column->columnvalue;
595 my $inventory_item = qsearchs({
596 'table' => 'inventory_item',
597 'hashref' => { 'classnum' => $classnum,
600 'extra_sql' => 'LIMIT 1 FOR UPDATE',
603 unless ( $inventory_item ) {
604 $dbh->rollback if $oldAutoCommit;
605 my $inventory_class =
606 qsearchs('inventory_class', { 'classnum' => $classnum } );
607 return "Can't find inventory_class.classnum $classnum"
608 unless $inventory_class;
609 return "Out of ". $inventory_class->classname. "s\n"; #Lingua:: BS
613 $inventory_item->svcnum( $self->svcnum );
614 my $ierror = $inventory_item->replace();
616 $dbh->rollback if $oldAutoCommit;
617 return "Error provisioning inventory: $ierror";
621 $self->setfield( $field, $inventory_item->item );
626 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
632 =item return_inventory
636 sub return_inventory {
639 local $SIG{HUP} = 'IGNORE';
640 local $SIG{INT} = 'IGNORE';
641 local $SIG{QUIT} = 'IGNORE';
642 local $SIG{TERM} = 'IGNORE';
643 local $SIG{TSTP} = 'IGNORE';
644 local $SIG{PIPE} = 'IGNORE';
646 my $oldAutoCommit = $FS::UID::AutoCommit;
647 local $FS::UID::AutoCommit = 0;
650 foreach my $inventory_item ( $self->inventory_item ) {
651 $inventory_item->svcnum('');
652 my $error = $inventory_item->replace();
654 $dbh->rollback if $oldAutoCommit;
655 return "Error returning inventory: $error";
659 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
666 Returns the inventory items associated with this svc_ record, as
667 FS::inventory_item objects (see L<FS::inventory_item>.
674 'table' => 'inventory_item',
675 'hashref' => { 'svcnum' => $self->svcnum, },
681 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
682 object (see L<FS::cust_svc>).
688 qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
693 Runs export_suspend callbacks.
700 my $export_args = $options{'export_args'} || [];
701 $self->export('suspend', @$export_args);
706 Runs export_unsuspend callbacks.
713 my $export_args = $options{'export_args'} || [];
714 $self->export('unsuspend', @$export_args);
719 Runs export_links callbacks and returns the links.
726 $self->export('links', $return);
730 =item export HOOK [ EXPORT_ARGS ]
732 Runs the provided export hook (i.e. "suspend", "unsuspend") for this service.
737 my( $self, $method ) = ( shift, shift );
739 $method = "export_$method" unless $method =~ /^export_/;
741 local $SIG{HUP} = 'IGNORE';
742 local $SIG{INT} = 'IGNORE';
743 local $SIG{QUIT} = 'IGNORE';
744 local $SIG{TERM} = 'IGNORE';
745 local $SIG{TSTP} = 'IGNORE';
746 local $SIG{PIPE} = 'IGNORE';
748 my $oldAutoCommit = $FS::UID::AutoCommit;
749 local $FS::UID::AutoCommit = 0;
753 unless ( $noexport_hack ) {
754 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
755 next unless $part_export->can($method);
756 my $error = $part_export->$method($self, @_);
758 $dbh->rollback if $oldAutoCommit;
759 return "error exporting $method event to ". $part_export->exporttype.
760 " (transaction rolled back): $error";
765 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
772 Sets or retrieves overlimit date.
778 $self->cust_svc->overlimit(@_);
783 Stub - returns false (no error) so derived classes don't need to define this
784 methods. Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
786 This method is called *before* the deletion step which actually deletes the
787 services. This method should therefore only be used for "pre-deletion"
788 cancellation steps, if necessary.
794 =item clone_suspended
796 Constructor used by FS::part_export::_export_suspend fallback. Stub returning
797 same object for svc_ classes which don't implement a suspension fallback
798 (everything except svc_acct at the moment). Document better.
802 sub clone_suspended {
806 =item clone_kludge_unsuspend
808 Constructor used by FS::part_export::_export_unsuspend fallback. Stub returning
809 same object for svc_ classes which don't implement a suspension fallback
810 (everything except svc_acct at the moment). Document better.
814 sub clone_kludge_unsuspend {
822 The setfixed method return value.
824 B<export> method isn't used by insert and replace methods yet.
828 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
829 from the base documentation.