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 FS::Record qw( qsearch qsearchs fields dbh );
7 use FS::cust_main_Mixin;
12 use FS::inventory_item;
13 use FS::inventory_class;
15 @ISA = qw( FS::cust_main_Mixin FS::Record );
17 $me = '[FS::svc_Common]';
22 FS::svc_Common - Object method for all svc_ records
28 @ISA = qw( FS::svc_Common );
32 FS::svc_Common is intended as a base class for table-specific classes to
33 inherit from, i.e. FS::svc_acct. FS::svc_Common inherits from FS::Record.
39 =item search_sql_field FIELD STRING
41 Class method which returns an SQL fragment to search for STRING in FIELD.
45 sub search_sql_field {
46 my( $class, $field, $string ) = @_;
47 my $table = $class->table;
48 my $q_string = dbh->quote($string);
49 "$table.$field = $q_string";
52 #fallback for services that don't provide a search...
54 #my( $class, $string ) = @_;
64 my $class = ref($proto) || $proto;
66 bless ($self, $class);
68 unless ( defined ( $self->table ) ) {
69 $self->{'Table'} = shift;
70 carp "warning: FS::Record::new called with table name ". $self->{'Table'};
73 #$self->{'Hash'} = shift;
75 $self->{'Hash'} = { map { $_ => $newhash->{$_} } qw(svcnum svcpart) };
77 $self->setdefault( $self->_fieldhandlers )
80 $self->{'Hash'}{$_} = $newhash->{$_}
81 foreach grep { defined($newhash->{$_}) && length($newhash->{$_}) }
84 foreach my $field ( grep !defined($self->{'Hash'}{$_}), $self->fields ) {
85 $self->{'Hash'}{$field}='';
88 $self->_rebless if $self->can('_rebless');
90 $self->{'modified'} = 0;
92 $self->_cache($self->{'Hash'}, shift) if $self->can('_cache') && @_;
98 sub _fieldhandlers { {}; }
102 # This restricts the fields based on part_svc_column and the svcpart of
103 # the service. There are four possible cases:
104 # 1. svcpart passed as part of the svc_x hash.
105 # 2. svcpart fetched via cust_svc based on svcnum.
106 # 3. No svcnum or svcpart. In this case, return ALL the fields with
107 # dbtable eq $self->table.
108 # 4. Called via "fields('svc_acct')" or something similar. In this case
109 # there is no $self object.
113 my @vfields = $self->SUPER::virtual_fields;
115 return @vfields unless (ref $self); # Case 4
117 if ($self->svcpart) { # Case 1
118 $svcpart = $self->svcpart;
119 } elsif ( $self->svcnum
120 && qsearchs('cust_svc',{'svcnum'=>$self->svcnum} )
122 $svcpart = $self->cust_svc->svcpart;
127 if ($svcpart) { #Cases 1 and 2
128 my %flags = map { $_->columnname, $_->columnflag } (
129 qsearch ('part_svc_column', { svcpart => $svcpart } )
131 return grep { not ( defined($flags{$_}) && $flags{$_} eq 'X') } @vfields;
140 svc_Common provides a fallback label subroutine that just returns the svcnum.
146 cluck "warning: ". ref($self). " not loaded or missing label method; ".
153 Checks the validity of fields in this record.
155 At present, this does nothing but call FS::Record::check (which, in turn,
156 does nothing but run virtual field checks).
165 =item insert [ , OPTION => VALUE ... ]
167 Adds this record to the database. If there is an error, returns the error,
168 otherwise returns false.
170 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
171 defined. An FS::cust_svc record will be created and inserted.
173 Currently available options are: I<jobnums>, I<child_objects> and
176 If I<jobnum> is set to an array reference, the jobnums of any export jobs will
177 be added to the referenced array.
179 If I<child_objects> is set to an array reference of FS::tablename objects (for
180 example, FS::acct_snarf objects), they will have their svcnum field set and
181 will be inserted after this record, but before any exports are run. Each
182 element of the array can also optionally be a two-element array reference
183 containing the child object and the name of an alternate field to be filled in
184 with the newly-inserted svcnum, for example C<[ $svc_forward, 'srcsvc' ]>
186 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
187 jobnums), all provisioning jobs will have a dependancy on the supplied
188 jobnum(s) (they will not run until the specific job(s) complete(s)).
190 If I<export_args> is set to an array reference, the referenced list will be
191 passed to export commands.
198 warn "[$me] insert called with options ".
199 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
203 local $FS::queue::jobnums = \@jobnums;
204 warn "[$me] insert: set \$FS::queue::jobnums to $FS::queue::jobnums\n"
206 my $objects = $options{'child_objects'} || [];
207 my $depend_jobnums = $options{'depend_jobnum'} || [];
208 $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
211 local $SIG{HUP} = 'IGNORE';
212 local $SIG{INT} = 'IGNORE';
213 local $SIG{QUIT} = 'IGNORE';
214 local $SIG{TERM} = 'IGNORE';
215 local $SIG{TSTP} = 'IGNORE';
216 local $SIG{PIPE} = 'IGNORE';
218 my $oldAutoCommit = $FS::UID::AutoCommit;
219 local $FS::UID::AutoCommit = 0;
222 $error = $self->check;
223 return $error if $error;
225 my $svcnum = $self->svcnum;
226 my $cust_svc = $svcnum ? qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) : '';
227 #unless ( $svcnum ) {
228 if ( !$svcnum or !$cust_svc ) {
229 $cust_svc = new FS::cust_svc ( {
230 #hua?# 'svcnum' => $svcnum,
231 'svcnum' => $self->svcnum,
232 'pkgnum' => $self->pkgnum,
233 'svcpart' => $self->svcpart,
235 $error = $cust_svc->insert;
237 $dbh->rollback if $oldAutoCommit;
240 $svcnum = $self->svcnum($cust_svc->svcnum);
242 #$cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
243 unless ( $cust_svc ) {
244 $dbh->rollback if $oldAutoCommit;
245 return "no cust_svc record found for svcnum ". $self->svcnum;
247 $self->pkgnum($cust_svc->pkgnum);
248 $self->svcpart($cust_svc->svcpart);
251 $error = $self->set_auto_inventory;
253 $dbh->rollback if $oldAutoCommit;
257 $error = $self->SUPER::insert;
259 $dbh->rollback if $oldAutoCommit;
263 foreach my $object ( @$objects ) {
265 if ( ref($object) eq 'ARRAY' ) {
266 ($obj, $field) = @$object;
271 $obj->$field($self->svcnum);
272 $error = $obj->insert;
274 $dbh->rollback if $oldAutoCommit;
280 unless ( $noexport_hack ) {
282 warn "[$me] insert: \$FS::queue::jobnums is $FS::queue::jobnums\n"
285 my $export_args = $options{'export_args'} || [];
287 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
288 my $error = $part_export->export_insert($self, @$export_args);
290 $dbh->rollback if $oldAutoCommit;
291 return "exporting to ". $part_export->exporttype.
292 " (transaction rolled back): $error";
296 foreach my $depend_jobnum ( @$depend_jobnums ) {
297 warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
299 foreach my $jobnum ( @jobnums ) {
300 my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
301 warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
303 my $error = $queue->depend_insert($depend_jobnum);
305 $dbh->rollback if $oldAutoCommit;
306 return "error queuing job dependancy: $error";
313 if ( exists $options{'jobnums'} ) {
314 push @{ $options{'jobnums'} }, @jobnums;
317 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
322 =item delete [ , OPTION => VALUE ... ]
324 Deletes this account from the database. If there is an error, returns the
325 error, otherwise returns false.
327 The corresponding FS::cust_svc record will be deleted as well.
334 my $export_args = $options{'export_args'} || [];
336 local $SIG{HUP} = 'IGNORE';
337 local $SIG{INT} = 'IGNORE';
338 local $SIG{QUIT} = 'IGNORE';
339 local $SIG{TERM} = 'IGNORE';
340 local $SIG{TSTP} = 'IGNORE';
341 local $SIG{PIPE} = 'IGNORE';
343 my $oldAutoCommit = $FS::UID::AutoCommit;
344 local $FS::UID::AutoCommit = 0;
347 my $error = $self->SUPER::delete
348 || $self->export('delete', @$export_args)
349 || $self->return_inventory
350 || $self->cust_svc->delete
353 $dbh->rollback if $oldAutoCommit;
357 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
362 =item replace OLD_RECORD
364 Replaces OLD_RECORD with this one. If there is an error, returns the error,
365 otherwise returns false.
370 my ($new, $old) = (shift, shift);
373 local $SIG{HUP} = 'IGNORE';
374 local $SIG{INT} = 'IGNORE';
375 local $SIG{QUIT} = 'IGNORE';
376 local $SIG{TERM} = 'IGNORE';
377 local $SIG{TSTP} = 'IGNORE';
378 local $SIG{PIPE} = 'IGNORE';
380 my $oldAutoCommit = $FS::UID::AutoCommit;
381 local $FS::UID::AutoCommit = 0;
384 # We absolutely have to have an old vs. new record to make this work.
385 $old = $new->replace_old unless defined($old);
387 my $error = $new->set_auto_inventory;
389 $dbh->rollback if $oldAutoCommit;
393 $error = $new->SUPER::replace($old);
395 $dbh->rollback if $oldAutoCommit;
400 unless ( $noexport_hack ) {
402 my $export_args = $options{'export_args'} || [];
404 #not quite false laziness, but same pattern as FS::svc_acct::replace and
405 #FS::part_export::sqlradius::_export_replace. List::Compare or something
406 #would be useful but too much of a pain in the ass to deploy
408 my @old_part_export = $old->cust_svc->part_svc->part_export;
409 my %old_exportnum = map { $_->exportnum => 1 } @old_part_export;
410 my @new_part_export =
412 ? qsearchs('part_svc', { svcpart=>$new->svcpart } )->part_export
413 : $new->cust_svc->part_svc->part_export;
414 my %new_exportnum = map { $_->exportnum => 1 } @new_part_export;
416 foreach my $delete_part_export (
417 grep { ! $new_exportnum{$_->exportnum} } @old_part_export
419 my $error = $delete_part_export->export_delete($old, @$export_args);
421 $dbh->rollback if $oldAutoCommit;
422 return "error deleting, export to ". $delete_part_export->exporttype.
423 " (transaction rolled back): $error";
427 foreach my $replace_part_export (
428 grep { $old_exportnum{$_->exportnum} } @new_part_export
431 $replace_part_export->export_replace( $new, $old, @$export_args);
433 $dbh->rollback if $oldAutoCommit;
434 return "error exporting to ". $replace_part_export->exporttype.
435 " (transaction rolled back): $error";
439 foreach my $insert_part_export (
440 grep { ! $old_exportnum{$_->exportnum} } @new_part_export
442 my $error = $insert_part_export->export_insert($new, @$export_args );
444 $dbh->rollback if $oldAutoCommit;
445 return "error inserting export to ". $insert_part_export->exporttype.
446 " (transaction rolled back): $error";
452 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
458 Sets any fixed fields for this service (see L<FS::part_svc>). If there is an
459 error, returns the error, otherwise returns the FS::part_svc object (use ref()
460 to test the return). Usually called by the check method.
466 $self->setx('F', @_);
471 Sets all fields to their defaults (see L<FS::part_svc>), overriding their
472 current values. If there is an error, returns the error, otherwise returns
473 the FS::part_svc object (use ref() to test the return).
479 $self->setx('D', @_ );
482 =item set_default_and_fixed
486 sub set_default_and_fixed {
488 $self->setx( [ 'D', 'F' ], @_ );
491 =item setx FLAG | FLAG_ARRAYREF , [ CALLBACK_HASHREF ]
493 Sets fields according to the passed in flag or arrayref of flags.
495 Optionally, a hashref of field names and callback coderefs can be passed.
496 If a coderef exists for a given field name, instead of setting the field,
497 the coderef is called with the column value (part_svc_column.columnvalue)
498 as the single parameter.
505 my @x = ref($x) ? @$x : ($x);
506 my $coderef = scalar(@_) ? shift : $self->_fieldhandlers;
509 $self->ut_numbern('svcnum')
511 return $error if $error;
513 my $part_svc = $self->part_svc;
514 return "Unkonwn svcpart" unless $part_svc;
516 #set default/fixed/whatever fields from part_svc
518 foreach my $part_svc_column (
519 grep { my $f = $_->columnflag; grep { $f eq $_ } @x } #columnflag in @x
520 $part_svc->all_part_svc_column
523 my $columnname = $part_svc_column->columnname;
524 my $columnvalue = $part_svc_column->columnvalue;
526 $columnvalue = &{ $coderef->{$columnname} }( $self, $columnvalue )
527 if exists( $coderef->{$columnname} );
528 $self->setfield( $columnname, $columnvalue );
541 if ( $self->get('svcpart') ) {
542 $svcpart = $self->get('svcpart');
543 } elsif ( $self->svcnum && qsearchs('cust_svc', {'svcnum'=>$self->svcnum}) ) {
544 my $cust_svc = $self->cust_svc;
545 return "Unknown svcnum" unless $cust_svc;
546 $svcpart = $cust_svc->svcpart;
549 qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
553 =item set_auto_inventory
555 Sets any fields which auto-populate from inventory (see L<FS::part_svc>).
556 If there is an error, returns the error, otherwise returns false.
560 sub set_auto_inventory {
564 $self->ut_numbern('svcnum')
566 return $error if $error;
568 my $part_svc = $self->part_svc;
569 return "Unkonwn svcpart" unless $part_svc;
571 local $SIG{HUP} = 'IGNORE';
572 local $SIG{INT} = 'IGNORE';
573 local $SIG{QUIT} = 'IGNORE';
574 local $SIG{TERM} = 'IGNORE';
575 local $SIG{TSTP} = 'IGNORE';
576 local $SIG{PIPE} = 'IGNORE';
578 my $oldAutoCommit = $FS::UID::AutoCommit;
579 local $FS::UID::AutoCommit = 0;
582 #set default/fixed/whatever fields from part_svc
583 my $table = $self->table;
584 foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
585 my $part_svc_column = $part_svc->part_svc_column($field);
586 if ( $part_svc_column->columnflag eq 'A' && $self->$field() eq '' ) {
588 my $classnum = $part_svc_column->columnvalue;
589 my $inventory_item = qsearchs({
590 'table' => 'inventory_item',
591 'hashref' => { 'classnum' => $classnum,
594 'extra_sql' => 'LIMIT 1 FOR UPDATE',
597 unless ( $inventory_item ) {
598 $dbh->rollback if $oldAutoCommit;
599 my $inventory_class =
600 qsearchs('inventory_class', { 'classnum' => $classnum } );
601 return "Can't find inventory_class.classnum $classnum"
602 unless $inventory_class;
603 return "Out of ". $inventory_class->classname. "s\n"; #Lingua:: BS
607 $inventory_item->svcnum( $self->svcnum );
608 my $ierror = $inventory_item->replace();
610 $dbh->rollback if $oldAutoCommit;
611 return "Error provisioning inventory: $ierror";
615 $self->setfield( $field, $inventory_item->item );
620 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
626 =item return_inventory
630 sub return_inventory {
633 local $SIG{HUP} = 'IGNORE';
634 local $SIG{INT} = 'IGNORE';
635 local $SIG{QUIT} = 'IGNORE';
636 local $SIG{TERM} = 'IGNORE';
637 local $SIG{TSTP} = 'IGNORE';
638 local $SIG{PIPE} = 'IGNORE';
640 my $oldAutoCommit = $FS::UID::AutoCommit;
641 local $FS::UID::AutoCommit = 0;
644 foreach my $inventory_item ( $self->inventory_item ) {
645 $inventory_item->svcnum('');
646 my $error = $inventory_item->replace();
648 $dbh->rollback if $oldAutoCommit;
649 return "Error returning inventory: $error";
653 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
660 Returns the inventory items associated with this svc_ record, as
661 FS::inventory_item objects (see L<FS::inventory_item>.
668 'table' => 'inventory_item',
669 'hashref' => { 'svcnum' => $self->svcnum, },
675 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
676 object (see L<FS::cust_svc>).
682 qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
687 Runs export_suspend callbacks.
694 my $export_args = $options{'export_args'} || [];
695 $self->export('suspend', @$export_args);
700 Runs export_unsuspend callbacks.
707 my $export_args = $options{'export_args'} || [];
708 $self->export('unsuspend', @$export_args);
711 =item export HOOK [ EXPORT_ARGS ]
713 Runs the provided export hook (i.e. "suspend", "unsuspend") for this service.
718 my( $self, $method ) = ( shift, shift );
720 $method = "export_$method" unless $method =~ /^export_/;
722 local $SIG{HUP} = 'IGNORE';
723 local $SIG{INT} = 'IGNORE';
724 local $SIG{QUIT} = 'IGNORE';
725 local $SIG{TERM} = 'IGNORE';
726 local $SIG{TSTP} = 'IGNORE';
727 local $SIG{PIPE} = 'IGNORE';
729 my $oldAutoCommit = $FS::UID::AutoCommit;
730 local $FS::UID::AutoCommit = 0;
734 unless ( $noexport_hack ) {
735 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
736 next unless $part_export->can($method);
737 my $error = $part_export->$method($self, @_);
739 $dbh->rollback if $oldAutoCommit;
740 return "error exporting $method event to ". $part_export->exporttype.
741 " (transaction rolled back): $error";
746 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
753 Sets or retrieves overlimit date.
759 $self->cust_svc->overlimit(@_);
764 Stub - returns false (no error) so derived classes don't need to define this
765 methods. Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
767 This method is called *before* the deletion step which actually deletes the
768 services. This method should therefore only be used for "pre-deletion"
769 cancellation steps, if necessary.
775 =item clone_suspended
777 Constructor used by FS::part_export::_export_suspend fallback. Stub returning
778 same object for svc_ classes which don't implement a suspension fallback
779 (everything except svc_acct at the moment). Document better.
783 sub clone_suspended {
787 =item clone_kludge_unsuspend
789 Constructor used by FS::part_export::_export_unsuspend fallback. Stub returning
790 same object for svc_ classes which don't implement a suspension fallback
791 (everything except svc_acct at the moment). Document better.
795 sub clone_kludge_unsuspend {
803 The setfixed method return value.
805 B<export> method isn't used by insert and replace methods yet.
809 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
810 from the base documentation.