1 package FS::svc_Common;
4 use vars qw( @ISA $noexport_hack $DEBUG );
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 );
21 FS::svc_Common - Object method for all svc_ records
27 @ISA = qw( FS::svc_Common );
31 FS::svc_Common is intended as a base class for table-specific classes to
32 inherit from, i.e. FS::svc_acct. FS::svc_Common inherits from FS::Record.
42 my $class = ref($proto) || $proto;
44 bless ($self, $class);
46 unless ( defined ( $self->table ) ) {
47 $self->{'Table'} = shift;
48 carp "warning: FS::Record::new called with table name ". $self->{'Table'};
51 #$self->{'Hash'} = shift;
53 $self->{'Hash'} = { map { $_ => $newhash->{$_} } qw(svcnum svcpart) };
55 $self->setdefault( $self->_fieldhandlers )
58 $self->{'Hash'}{$_} = $newhash->{$_}
59 foreach grep { defined($newhash->{$_}) && length($newhash->{$_}) }
62 foreach my $field ( grep !defined($self->{'Hash'}{$_}), $self->fields ) {
63 $self->{'Hash'}{$field}='';
66 $self->_rebless if $self->can('_rebless');
68 $self->{'modified'} = 0;
70 $self->_cache($self->{'Hash'}, shift) if $self->can('_cache') && @_;
76 sub _fieldhandlers { {}; }
80 # This restricts the fields based on part_svc_column and the svcpart of
81 # the service. There are four possible cases:
82 # 1. svcpart passed as part of the svc_x hash.
83 # 2. svcpart fetched via cust_svc based on svcnum.
84 # 3. No svcnum or svcpart. In this case, return ALL the fields with
85 # dbtable eq $self->table.
86 # 4. Called via "fields('svc_acct')" or something similar. In this case
87 # there is no $self object.
91 my @vfields = $self->SUPER::virtual_fields;
93 return @vfields unless (ref $self); # Case 4
95 if ($self->svcpart) { # Case 1
96 $svcpart = $self->svcpart;
97 } elsif ( $self->svcnum
98 && qsearchs('cust_svc',{'svcnum'=>$self->svcnum} )
100 $svcpart = $self->cust_svc->svcpart;
105 if ($svcpart) { #Cases 1 and 2
106 my %flags = map { $_->columnname, $_->columnflag } (
107 qsearch ('part_svc_column', { svcpart => $svcpart } )
109 return grep { not ($flags{$_} eq 'X') } @vfields;
118 Checks the validity of fields in this record.
120 At present, this does nothing but call FS::Record::check (which, in turn,
121 does nothing but run virtual field checks).
130 =item insert [ , OPTION => VALUE ... ]
132 Adds this record to the database. If there is an error, returns the error,
133 otherwise returns false.
135 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
136 defined. An FS::cust_svc record will be created and inserted.
138 Currently available options are: I<jobnums>, I<child_objects> and
141 If I<jobnum> is set to an array reference, the jobnums of any export jobs will
142 be added to the referenced array.
144 If I<child_objects> is set to an array reference of FS::tablename objects (for
145 example, FS::acct_snarf objects), they will have their svcnum field set and
146 will be inserted after this record, but before any exports are run. Each
147 element of the array can also optionally be a two-element array reference
148 containing the child object and the name of an alternate field to be filled in
149 with the newly-inserted svcnum, for example C<[ $svc_forward, 'srcsvc' ]>
151 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
152 jobnums), all provisioning jobs will have a dependancy on the supplied
153 jobnum(s) (they will not run until the specific job(s) complete(s)).
160 warn "FS::svc_Common::insert called with options ".
161 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
165 local $FS::queue::jobnums = \@jobnums;
166 warn "FS::svc_Common::insert: set \$FS::queue::jobnums to $FS::queue::jobnums"
168 my $objects = $options{'child_objects'} || [];
169 my $depend_jobnums = $options{'depend_jobnum'} || [];
170 $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
173 local $SIG{HUP} = 'IGNORE';
174 local $SIG{INT} = 'IGNORE';
175 local $SIG{QUIT} = 'IGNORE';
176 local $SIG{TERM} = 'IGNORE';
177 local $SIG{TSTP} = 'IGNORE';
178 local $SIG{PIPE} = 'IGNORE';
180 my $oldAutoCommit = $FS::UID::AutoCommit;
181 local $FS::UID::AutoCommit = 0;
184 $error = $self->check;
185 return $error if $error;
187 my $svcnum = $self->svcnum;
188 my $cust_svc = $svcnum ? qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) : '';
189 #unless ( $svcnum ) {
190 if ( !$svcnum or !$cust_svc ) {
191 $cust_svc = new FS::cust_svc ( {
192 #hua?# 'svcnum' => $svcnum,
193 'svcnum' => $self->svcnum,
194 'pkgnum' => $self->pkgnum,
195 'svcpart' => $self->svcpart,
197 $error = $cust_svc->insert;
199 $dbh->rollback if $oldAutoCommit;
202 $svcnum = $self->svcnum($cust_svc->svcnum);
204 #$cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
205 unless ( $cust_svc ) {
206 $dbh->rollback if $oldAutoCommit;
207 return "no cust_svc record found for svcnum ". $self->svcnum;
209 $self->pkgnum($cust_svc->pkgnum);
210 $self->svcpart($cust_svc->svcpart);
213 $error = $self->set_auto_inventory;
215 $dbh->rollback if $oldAutoCommit;
219 $error = $self->SUPER::insert;
221 $dbh->rollback if $oldAutoCommit;
225 foreach my $object ( @$objects ) {
227 if ( ref($object) eq 'ARRAY' ) {
228 ($obj, $field) = @$object;
233 $obj->$field($self->svcnum);
234 $error = $obj->insert;
236 $dbh->rollback if $oldAutoCommit;
242 unless ( $noexport_hack ) {
244 warn "FS::svc_Common::insert: \$FS::queue::jobnums is $FS::queue::jobnums"
247 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
248 my $error = $part_export->export_insert($self);
250 $dbh->rollback if $oldAutoCommit;
251 return "exporting to ". $part_export->exporttype.
252 " (transaction rolled back): $error";
256 foreach my $depend_jobnum ( @$depend_jobnums ) {
257 warn "inserting dependancies on supplied job $depend_jobnum\n"
259 foreach my $jobnum ( @jobnums ) {
260 my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
261 warn "inserting dependancy for job $jobnum on $depend_jobnum\n"
263 my $error = $queue->depend_insert($depend_jobnum);
265 $dbh->rollback if $oldAutoCommit;
266 return "error queuing job dependancy: $error";
273 if ( exists $options{'jobnums'} ) {
274 push @{ $options{'jobnums'} }, @jobnums;
277 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
284 Deletes this account from the database. If there is an error, returns the
285 error, otherwise returns false.
287 The corresponding FS::cust_svc record will be deleted as well.
295 local $SIG{HUP} = 'IGNORE';
296 local $SIG{INT} = 'IGNORE';
297 local $SIG{QUIT} = 'IGNORE';
298 local $SIG{TERM} = 'IGNORE';
299 local $SIG{TSTP} = 'IGNORE';
300 local $SIG{PIPE} = 'IGNORE';
302 my $svcnum = $self->svcnum;
304 my $oldAutoCommit = $FS::UID::AutoCommit;
305 local $FS::UID::AutoCommit = 0;
308 $error = $self->SUPER::delete;
309 return $error if $error;
312 unless ( $noexport_hack ) {
313 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
314 $error = $part_export->export_delete($self);
316 $dbh->rollback if $oldAutoCommit;
317 return "exporting to ". $part_export->exporttype.
318 " (transaction rolled back): $error";
323 $error = $self->return_inventory;
325 $dbh->rollback if $oldAutoCommit;
326 return "error returning inventory: $error";
329 my $cust_svc = $self->cust_svc;
330 $error = $cust_svc->delete;
332 $dbh->rollback if $oldAutoCommit;
336 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
341 =item replace OLD_RECORD
343 Replaces OLD_RECORD with this one. If there is an error, returns the error,
344 otherwise returns false.
349 my ($new, $old) = (shift, shift);
351 local $SIG{HUP} = 'IGNORE';
352 local $SIG{INT} = 'IGNORE';
353 local $SIG{QUIT} = 'IGNORE';
354 local $SIG{TERM} = 'IGNORE';
355 local $SIG{TSTP} = 'IGNORE';
356 local $SIG{PIPE} = 'IGNORE';
358 my $oldAutoCommit = $FS::UID::AutoCommit;
359 local $FS::UID::AutoCommit = 0;
362 my $error = $new->set_auto_inventory;
364 $dbh->rollback if $oldAutoCommit;
368 $error = $new->SUPER::replace($old);
370 $dbh->rollback if $oldAutoCommit;
375 unless ( $noexport_hack ) {
377 #not quite false laziness, but same pattern as FS::svc_acct::replace and
378 #FS::part_export::sqlradius::_export_replace. List::Compare or something
379 #would be useful but too much of a pain in the ass to deploy
381 my @old_part_export = $old->cust_svc->part_svc->part_export;
382 my %old_exportnum = map { $_->exportnum => 1 } @old_part_export;
383 my @new_part_export =
385 ? qsearchs('part_svc', { svcpart=>$new->svcpart } )->part_export
386 : $new->cust_svc->part_svc->part_export;
387 my %new_exportnum = map { $_->exportnum => 1 } @new_part_export;
389 foreach my $delete_part_export (
390 grep { ! $new_exportnum{$_->exportnum} } @old_part_export
392 my $error = $delete_part_export->export_delete($old);
394 $dbh->rollback if $oldAutoCommit;
395 return "error deleting, export to ". $delete_part_export->exporttype.
396 " (transaction rolled back): $error";
400 foreach my $replace_part_export (
401 grep { $old_exportnum{$_->exportnum} } @new_part_export
403 my $error = $replace_part_export->export_replace($new,$old);
405 $dbh->rollback if $oldAutoCommit;
406 return "error exporting to ". $replace_part_export->exporttype.
407 " (transaction rolled back): $error";
411 foreach my $insert_part_export (
412 grep { ! $old_exportnum{$_->exportnum} } @new_part_export
414 my $error = $insert_part_export->export_insert($new);
416 $dbh->rollback if $oldAutoCommit;
417 return "error inserting export to ". $insert_part_export->exporttype.
418 " (transaction rolled back): $error";
424 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
431 Sets any fixed fields for this service (see L<FS::part_svc>). If there is an
432 error, returns the error, otherwise returns the FS::part_svc object (use ref()
433 to test the return). Usually called by the check method.
439 $self->setx('F', @_);
444 Sets all fields to their defaults (see L<FS::part_svc>), overriding their
445 current values. If there is an error, returns the error, otherwise returns
446 the FS::part_svc object (use ref() to test the return).
452 $self->setx('D', @_ );
455 =item set_default_and_fixed
459 sub set_default_and_fixed {
461 $self->setx( [ 'D', 'F' ], @_ );
464 =item setx FLAG | FLAG_ARRAYREF , [ CALLBACK_HASHREF ]
466 Sets fields according to the passed in flag or arrayref of flags.
468 Optionally, a hashref of field names and callback coderefs can be passed.
469 If a coderef exists for a given field name, instead of setting the field,
470 the coderef is called with the column value (part_svc_column.columnvalue)
471 as the single parameter.
478 my @x = ref($x) ? @$x : ($x);
479 my $coderef = scalar(@_) ? shift : $self->_fieldhandlers;
482 $self->ut_numbern('svcnum')
484 return $error if $error;
486 my $part_svc = $self->part_svc;
487 return "Unkonwn svcpart" unless $part_svc;
489 #set default/fixed/whatever fields from part_svc
491 foreach my $part_svc_column (
492 grep { my $f = $_->columnflag; grep { $f eq $_ } @x } #columnflag in @x
493 $part_svc->all_part_svc_column
496 my $columnname = $part_svc_column->columnname;
497 my $columnvalue = $part_svc_column->columnvalue;
499 $columnvalue = &{ $coderef->{$columnname} }( $self, $columnvalue )
500 if exists( $coderef->{$columnname} );
501 $self->setfield( $columnname, $columnvalue );
514 if ( $self->get('svcpart') ) {
515 $svcpart = $self->get('svcpart');
516 } elsif ( $self->svcnum && qsearchs('cust_svc', {'svcnum'=>$self->svcnum}) ) {
517 my $cust_svc = $self->cust_svc;
518 return "Unknown svcnum" unless $cust_svc;
519 $svcpart = $cust_svc->svcpart;
522 qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
526 =item set_auto_inventory
528 Sets any fields which auto-populate from inventory (see L<FS::part_svc>).
529 If there is an error, returns the error, otherwise returns false.
533 sub set_auto_inventory {
537 $self->ut_numbern('svcnum')
539 return $error if $error;
541 my $part_svc = $self->part_svc;
542 return "Unkonwn svcpart" unless $part_svc;
544 local $SIG{HUP} = 'IGNORE';
545 local $SIG{INT} = 'IGNORE';
546 local $SIG{QUIT} = 'IGNORE';
547 local $SIG{TERM} = 'IGNORE';
548 local $SIG{TSTP} = 'IGNORE';
549 local $SIG{PIPE} = 'IGNORE';
551 my $oldAutoCommit = $FS::UID::AutoCommit;
552 local $FS::UID::AutoCommit = 0;
555 #set default/fixed/whatever fields from part_svc
556 my $table = $self->table;
557 foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
558 my $part_svc_column = $part_svc->part_svc_column($field);
559 if ( $part_svc_column->columnflag eq 'A' && $self->$field() eq '' ) {
561 my $classnum = $part_svc_column->columnvalue;
562 my $inventory_item = qsearchs({
563 'table' => 'inventory_item',
564 'hashref' => { 'classnum' => $classnum,
567 'extra_sql' => 'LIMIT 1 FOR UPDATE',
570 unless ( $inventory_item ) {
571 $dbh->rollback if $oldAutoCommit;
572 my $inventory_class =
573 qsearchs('inventory_class', { 'classnum' => $classnum } );
574 return "Can't find inventory_class.classnum $classnum"
575 unless $inventory_class;
576 return "Out of ". $inventory_class->classname. "s\n"; #Lingua:: BS
580 $inventory_item->svcnum( $self->svcnum );
581 my $ierror = $inventory_item->replace();
583 $dbh->rollback if $oldAutoCommit;
584 return "Error provisioning inventory: $ierror";
588 $self->setfield( $field, $inventory_item->item );
593 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
599 =item return_inventory
603 sub return_inventory {
606 local $SIG{HUP} = 'IGNORE';
607 local $SIG{INT} = 'IGNORE';
608 local $SIG{QUIT} = 'IGNORE';
609 local $SIG{TERM} = 'IGNORE';
610 local $SIG{TSTP} = 'IGNORE';
611 local $SIG{PIPE} = 'IGNORE';
613 my $oldAutoCommit = $FS::UID::AutoCommit;
614 local $FS::UID::AutoCommit = 0;
617 foreach my $inventory_item ( $self->inventory_item ) {
618 $inventory_item->svcnum('');
619 my $error = $inventory_item->replace();
621 $dbh->rollback if $oldAutoCommit;
622 return "Error returning inventory: $error";
626 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
633 Returns the inventory items associated with this svc_ record, as
634 FS::inventory_item objects (see L<FS::inventory_item>.
641 'table' => 'inventory_item',
642 'hashref' => { 'svcnum' => $self->svcnum, },
648 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
649 object (see L<FS::cust_svc>).
655 qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
660 Runs export_suspend callbacks.
667 local $SIG{HUP} = 'IGNORE';
668 local $SIG{INT} = 'IGNORE';
669 local $SIG{QUIT} = 'IGNORE';
670 local $SIG{TERM} = 'IGNORE';
671 local $SIG{TSTP} = 'IGNORE';
672 local $SIG{PIPE} = 'IGNORE';
674 my $oldAutoCommit = $FS::UID::AutoCommit;
675 local $FS::UID::AutoCommit = 0;
679 unless ( $noexport_hack ) {
680 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
681 my $error = $part_export->export_suspend($self);
683 $dbh->rollback if $oldAutoCommit;
684 return "error exporting to ". $part_export->exporttype.
685 " (transaction rolled back): $error";
690 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
697 Runs export_unsuspend callbacks.
704 local $SIG{HUP} = 'IGNORE';
705 local $SIG{INT} = 'IGNORE';
706 local $SIG{QUIT} = 'IGNORE';
707 local $SIG{TERM} = 'IGNORE';
708 local $SIG{TSTP} = 'IGNORE';
709 local $SIG{PIPE} = 'IGNORE';
711 my $oldAutoCommit = $FS::UID::AutoCommit;
712 local $FS::UID::AutoCommit = 0;
716 unless ( $noexport_hack ) {
717 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
718 my $error = $part_export->export_unsuspend($self);
720 $dbh->rollback if $oldAutoCommit;
721 return "error exporting to ". $part_export->exporttype.
722 " (transaction rolled back): $error";
727 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
734 Stub - returns false (no error) so derived classes don't need to define these
735 methods. Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
741 =item clone_suspended
743 Constructor used by FS::part_export::_export_suspend fallback. Stub returning
744 same object for svc_ classes which don't implement a suspension fallback
745 (everything except svc_acct at the moment). Document better.
749 sub clone_suspended {
753 =item clone_kludge_unsuspend
755 Constructor used by FS::part_export::_export_unsuspend fallback. Stub returning
756 same object for svc_ classes which don't implement a suspension fallback
757 (everything except svc_acct at the moment). Document better.
761 sub clone_kludge_unsuspend {
769 The setfixed method return value.
773 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
774 from the base documentation.