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 );
57 $self->{'Hash'}{$_} = $newhash->{$_}
58 foreach grep { defined($newhash->{$_}) && length($newhash->{$_}) }
61 foreach my $field ( grep !defined($self->{'Hash'}{$_}), $self->fields ) {
62 $self->{'Hash'}{$field}='';
65 $self->_rebless if $self->can('_rebless');
67 $self->{'modified'} = 0;
69 $self->_cache($self->{'Hash'}, shift) if $self->can('_cache') && @_;
75 sub _fieldhandlers { (); }
79 # This restricts the fields based on part_svc_column and the svcpart of
80 # the service. There are four possible cases:
81 # 1. svcpart passed as part of the svc_x hash.
82 # 2. svcpart fetched via cust_svc based on svcnum.
83 # 3. No svcnum or svcpart. In this case, return ALL the fields with
84 # dbtable eq $self->table.
85 # 4. Called via "fields('svc_acct')" or something similar. In this case
86 # there is no $self object.
90 my @vfields = $self->SUPER::virtual_fields;
92 return @vfields unless (ref $self); # Case 4
94 if ($self->svcpart) { # Case 1
95 $svcpart = $self->svcpart;
96 } elsif ( $self->svcnum
97 && qsearchs('cust_svc',{'svcnum'=>$self->svcnum} )
99 $svcpart = $self->cust_svc->svcpart;
104 if ($svcpart) { #Cases 1 and 2
105 my %flags = map { $_->columnname, $_->columnflag } (
106 qsearch ('part_svc_column', { svcpart => $svcpart } )
108 return grep { not ($flags{$_} eq 'X') } @vfields;
117 Checks the validity of fields in this record.
119 At present, this does nothing but call FS::Record::check (which, in turn,
120 does nothing but run virtual field checks).
129 =item insert [ , OPTION => VALUE ... ]
131 Adds this record to the database. If there is an error, returns the error,
132 otherwise returns false.
134 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
135 defined. An FS::cust_svc record will be created and inserted.
137 Currently available options are: I<jobnums>, I<child_objects> and
140 If I<jobnum> is set to an array reference, the jobnums of any export jobs will
141 be added to the referenced array.
143 If I<child_objects> is set to an array reference of FS::tablename objects (for
144 example, FS::acct_snarf objects), they will have their svcnum field set and
145 will be inserted after this record, but before any exports are run. Each
146 element of the array can also optionally be a two-element array reference
147 containing the child object and the name of an alternate field to be filled in
148 with the newly-inserted svcnum, for example C<[ $svc_forward, 'srcsvc' ]>
150 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
151 jobnums), all provisioning jobs will have a dependancy on the supplied
152 jobnum(s) (they will not run until the specific job(s) complete(s)).
159 warn "FS::svc_Common::insert called with options ".
160 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
164 local $FS::queue::jobnums = \@jobnums;
165 warn "FS::svc_Common::insert: set \$FS::queue::jobnums to $FS::queue::jobnums"
167 my $objects = $options{'child_objects'} || [];
168 my $depend_jobnums = $options{'depend_jobnum'} || [];
169 $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
172 local $SIG{HUP} = 'IGNORE';
173 local $SIG{INT} = 'IGNORE';
174 local $SIG{QUIT} = 'IGNORE';
175 local $SIG{TERM} = 'IGNORE';
176 local $SIG{TSTP} = 'IGNORE';
177 local $SIG{PIPE} = 'IGNORE';
179 my $oldAutoCommit = $FS::UID::AutoCommit;
180 local $FS::UID::AutoCommit = 0;
183 $error = $self->check;
184 return $error if $error;
186 my $svcnum = $self->svcnum;
187 my $cust_svc = $svcnum ? qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) : '';
188 #unless ( $svcnum ) {
189 if ( !$svcnum or !$cust_svc ) {
190 $cust_svc = new FS::cust_svc ( {
191 #hua?# 'svcnum' => $svcnum,
192 'svcnum' => $self->svcnum,
193 'pkgnum' => $self->pkgnum,
194 'svcpart' => $self->svcpart,
196 $error = $cust_svc->insert;
198 $dbh->rollback if $oldAutoCommit;
201 $svcnum = $self->svcnum($cust_svc->svcnum);
203 #$cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
204 unless ( $cust_svc ) {
205 $dbh->rollback if $oldAutoCommit;
206 return "no cust_svc record found for svcnum ". $self->svcnum;
208 $self->pkgnum($cust_svc->pkgnum);
209 $self->svcpart($cust_svc->svcpart);
212 $error = $self->set_auto_inventory;
214 $dbh->rollback if $oldAutoCommit;
218 $error = $self->SUPER::insert;
220 $dbh->rollback if $oldAutoCommit;
224 foreach my $object ( @$objects ) {
226 if ( ref($object) eq 'ARRAY' ) {
227 ($obj, $field) = @$object;
232 $obj->$field($self->svcnum);
233 $error = $obj->insert;
235 $dbh->rollback if $oldAutoCommit;
241 unless ( $noexport_hack ) {
243 warn "FS::svc_Common::insert: \$FS::queue::jobnums is $FS::queue::jobnums"
246 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
247 my $error = $part_export->export_insert($self);
249 $dbh->rollback if $oldAutoCommit;
250 return "exporting to ". $part_export->exporttype.
251 " (transaction rolled back): $error";
255 foreach my $depend_jobnum ( @$depend_jobnums ) {
256 warn "inserting dependancies on supplied job $depend_jobnum\n"
258 foreach my $jobnum ( @jobnums ) {
259 my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
260 warn "inserting dependancy for job $jobnum on $depend_jobnum\n"
262 my $error = $queue->depend_insert($depend_jobnum);
264 $dbh->rollback if $oldAutoCommit;
265 return "error queuing job dependancy: $error";
272 if ( exists $options{'jobnums'} ) {
273 push @{ $options{'jobnums'} }, @jobnums;
276 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
283 Deletes this account from the database. If there is an error, returns the
284 error, otherwise returns false.
286 The corresponding FS::cust_svc record will be deleted as well.
294 local $SIG{HUP} = 'IGNORE';
295 local $SIG{INT} = 'IGNORE';
296 local $SIG{QUIT} = 'IGNORE';
297 local $SIG{TERM} = 'IGNORE';
298 local $SIG{TSTP} = 'IGNORE';
299 local $SIG{PIPE} = 'IGNORE';
301 my $svcnum = $self->svcnum;
303 my $oldAutoCommit = $FS::UID::AutoCommit;
304 local $FS::UID::AutoCommit = 0;
307 $error = $self->SUPER::delete;
308 return $error if $error;
311 unless ( $noexport_hack ) {
312 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
313 $error = $part_export->export_delete($self);
315 $dbh->rollback if $oldAutoCommit;
316 return "exporting to ". $part_export->exporttype.
317 " (transaction rolled back): $error";
322 $error = $self->return_inventory;
324 $dbh->rollback if $oldAutoCommit;
325 return "error returning inventory: $error";
328 my $cust_svc = $self->cust_svc;
329 $error = $cust_svc->delete;
331 $dbh->rollback if $oldAutoCommit;
335 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
340 =item replace OLD_RECORD
342 Replaces OLD_RECORD with this one. If there is an error, returns the error,
343 otherwise returns false.
348 my ($new, $old) = (shift, shift);
350 local $SIG{HUP} = 'IGNORE';
351 local $SIG{INT} = 'IGNORE';
352 local $SIG{QUIT} = 'IGNORE';
353 local $SIG{TERM} = 'IGNORE';
354 local $SIG{TSTP} = 'IGNORE';
355 local $SIG{PIPE} = 'IGNORE';
357 my $oldAutoCommit = $FS::UID::AutoCommit;
358 local $FS::UID::AutoCommit = 0;
361 my $error = $new->set_auto_inventory;
363 $dbh->rollback if $oldAutoCommit;
367 $error = $new->SUPER::replace($old);
369 $dbh->rollback if $oldAutoCommit;
374 unless ( $noexport_hack ) {
376 #not quite false laziness, but same pattern as FS::svc_acct::replace and
377 #FS::part_export::sqlradius::_export_replace. List::Compare or something
378 #would be useful but too much of a pain in the ass to deploy
380 my @old_part_export = $old->cust_svc->part_svc->part_export;
381 my %old_exportnum = map { $_->exportnum => 1 } @old_part_export;
382 my @new_part_export =
384 ? qsearchs('part_svc', { svcpart=>$new->svcpart } )->part_export
385 : $new->cust_svc->part_svc->part_export;
386 my %new_exportnum = map { $_->exportnum => 1 } @new_part_export;
388 foreach my $delete_part_export (
389 grep { ! $new_exportnum{$_->exportnum} } @old_part_export
391 my $error = $delete_part_export->export_delete($old);
393 $dbh->rollback if $oldAutoCommit;
394 return "error deleting, export to ". $delete_part_export->exporttype.
395 " (transaction rolled back): $error";
399 foreach my $replace_part_export (
400 grep { $old_exportnum{$_->exportnum} } @new_part_export
402 my $error = $replace_part_export->export_replace($new,$old);
404 $dbh->rollback if $oldAutoCommit;
405 return "error exporting to ". $replace_part_export->exporttype.
406 " (transaction rolled back): $error";
410 foreach my $insert_part_export (
411 grep { ! $old_exportnum{$_->exportnum} } @new_part_export
413 my $error = $insert_part_export->export_insert($new);
415 $dbh->rollback if $oldAutoCommit;
416 return "error inserting export to ". $insert_part_export->exporttype.
417 " (transaction rolled back): $error";
423 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
430 Sets any fixed fields for this service (see L<FS::part_svc>). If there is an
431 error, returns the error, otherwise returns the FS::part_svc object (use ref()
432 to test the return). Usually called by the check method.
438 $self->setx('F', @_);
443 Sets all fields to their defaults (see L<FS::part_svc>), overriding their
444 current values. If there is an error, returns the error, otherwise returns
445 the FS::part_svc object (use ref() to test the return).
451 $self->setx('D', @_ );
454 =item set_default_and_fixed
458 sub set_default_and_fixed {
460 $self->setx( [ 'D', 'F' ], @_ );
463 =item setx FLAG | FLAG_ARRAYREF , [ CALLBACK_HASHREF ]
465 Sets fields according to the passed in flag or arrayref of flags.
467 Optionally, a hashref of field names and callback coderefs can be passed.
468 If a coderef exists for a given field name, instead of setting the field,
469 the coderef is called with the column value (part_svc_column.columnvalue)
470 as the single parameter.
477 my @x = ref($x) ? @$x : ($x);
478 my $coderef = scalar(@_) ? shift : {};
481 $self->ut_numbern('svcnum')
483 return $error if $error;
485 my $part_svc = $self->part_svc;
486 return "Unkonwn svcpart" unless $part_svc;
488 #set default/fixed/whatever fields from part_svc
490 foreach my $part_svc_column (
491 grep { my $f = $_->columnflag; grep { $f eq $_ } @x } #columnflag in @x
492 $part_svc->all_part_svc_column
495 my $columnname = $part_svc_column->columnname;
496 my $columnvalue = $part_svc_column->columnvalue;
498 $columnvalue = &{ $coderef->{$columnname} }( $self, $columnvalue )
499 if exists( $coderef->{$columnname} );
500 $self->setfield( $columnname, $columnvalue );
513 if ( $self->get('svcpart') ) {
514 $svcpart = $self->get('svcpart');
515 } elsif ( $self->svcnum && qsearchs('cust_svc', {'svcnum'=>$self->svcnum}) ) {
516 my $cust_svc = $self->cust_svc;
517 return "Unknown svcnum" unless $cust_svc;
518 $svcpart = $cust_svc->svcpart;
521 qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
525 =item set_auto_inventory
527 Sets any fields which auto-populate from inventory (see L<FS::part_svc>).
528 If there is an error, returns the error, otherwise returns false.
532 sub set_auto_inventory {
536 $self->ut_numbern('svcnum')
538 return $error if $error;
540 my $part_svc = $self->part_svc;
541 return "Unkonwn svcpart" unless $part_svc;
543 local $SIG{HUP} = 'IGNORE';
544 local $SIG{INT} = 'IGNORE';
545 local $SIG{QUIT} = 'IGNORE';
546 local $SIG{TERM} = 'IGNORE';
547 local $SIG{TSTP} = 'IGNORE';
548 local $SIG{PIPE} = 'IGNORE';
550 my $oldAutoCommit = $FS::UID::AutoCommit;
551 local $FS::UID::AutoCommit = 0;
554 #set default/fixed/whatever fields from part_svc
555 my $table = $self->table;
556 foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
557 my $part_svc_column = $part_svc->part_svc_column($field);
558 if ( $part_svc_column->columnflag eq 'A' && $self->$field() eq '' ) {
560 my $classnum = $part_svc_column->columnvalue;
561 my $inventory_item = qsearchs({
562 'table' => 'inventory_item',
563 'hashref' => { 'classnum' => $classnum,
566 'extra_sql' => 'LIMIT 1 FOR UPDATE',
569 unless ( $inventory_item ) {
570 $dbh->rollback if $oldAutoCommit;
571 my $inventory_class =
572 qsearchs('inventory_class', { 'classnum' => $classnum } );
573 return "Can't find inventory_class.classnum $classnum"
574 unless $inventory_class;
575 return "Out of ". $inventory_class->classname. "s\n"; #Lingua:: BS
579 $inventory_item->svcnum( $self->svcnum );
580 my $ierror = $inventory_item->replace();
582 $dbh->rollback if $oldAutoCommit;
583 return "Error provisioning inventory: $ierror";
587 $self->setfield( $field, $inventory_item->item );
592 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
598 =item return_inventory
602 sub return_inventory {
605 local $SIG{HUP} = 'IGNORE';
606 local $SIG{INT} = 'IGNORE';
607 local $SIG{QUIT} = 'IGNORE';
608 local $SIG{TERM} = 'IGNORE';
609 local $SIG{TSTP} = 'IGNORE';
610 local $SIG{PIPE} = 'IGNORE';
612 my $oldAutoCommit = $FS::UID::AutoCommit;
613 local $FS::UID::AutoCommit = 0;
616 foreach my $inventory_item ( $self->inventory_item ) {
617 $inventory_item->svcnum('');
618 my $error = $inventory_item->replace();
620 $dbh->rollback if $oldAutoCommit;
621 return "Error returning inventory: $error";
625 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
632 Returns the inventory items associated with this svc_ record, as
633 FS::inventory_item objects (see L<FS::inventory_item>.
640 'table' => 'inventory_item',
641 'hashref' => { 'svcnum' => $self->svcnum, },
647 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
648 object (see L<FS::cust_svc>).
654 qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
659 Runs export_suspend callbacks.
666 local $SIG{HUP} = 'IGNORE';
667 local $SIG{INT} = 'IGNORE';
668 local $SIG{QUIT} = 'IGNORE';
669 local $SIG{TERM} = 'IGNORE';
670 local $SIG{TSTP} = 'IGNORE';
671 local $SIG{PIPE} = 'IGNORE';
673 my $oldAutoCommit = $FS::UID::AutoCommit;
674 local $FS::UID::AutoCommit = 0;
678 unless ( $noexport_hack ) {
679 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
680 my $error = $part_export->export_suspend($self);
682 $dbh->rollback if $oldAutoCommit;
683 return "error exporting to ". $part_export->exporttype.
684 " (transaction rolled back): $error";
689 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
696 Runs export_unsuspend callbacks.
703 local $SIG{HUP} = 'IGNORE';
704 local $SIG{INT} = 'IGNORE';
705 local $SIG{QUIT} = 'IGNORE';
706 local $SIG{TERM} = 'IGNORE';
707 local $SIG{TSTP} = 'IGNORE';
708 local $SIG{PIPE} = 'IGNORE';
710 my $oldAutoCommit = $FS::UID::AutoCommit;
711 local $FS::UID::AutoCommit = 0;
715 unless ( $noexport_hack ) {
716 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
717 my $error = $part_export->export_unsuspend($self);
719 $dbh->rollback if $oldAutoCommit;
720 return "error exporting to ". $part_export->exporttype.
721 " (transaction rolled back): $error";
726 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
733 Stub - returns false (no error) so derived classes don't need to define these
734 methods. Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
740 =item clone_suspended
742 Constructor used by FS::part_export::_export_suspend fallback. Stub returning
743 same object for svc_ classes which don't implement a suspension fallback
744 (everything except svc_acct at the moment). Document better.
748 sub clone_suspended {
752 =item clone_kludge_unsuspend
754 Constructor used by FS::part_export::_export_unsuspend fallback. Stub returning
755 same object for svc_ classes which don't implement a suspension fallback
756 (everything except svc_acct at the moment). Document better.
760 sub clone_kludge_unsuspend {
768 The setfixed method return value.
772 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
773 from the base documentation.