1 package FS::svc_Common;
4 use vars qw( @ISA $noexport_hack $DEBUG $me );
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.
43 my $class = ref($proto) || $proto;
45 bless ($self, $class);
47 unless ( defined ( $self->table ) ) {
48 $self->{'Table'} = shift;
49 carp "warning: FS::Record::new called with table name ". $self->{'Table'};
52 #$self->{'Hash'} = shift;
54 $self->{'Hash'} = { map { $_ => $newhash->{$_} } qw(svcnum svcpart) };
56 $self->setdefault( $self->_fieldhandlers )
59 $self->{'Hash'}{$_} = $newhash->{$_}
60 foreach grep { defined($newhash->{$_}) && length($newhash->{$_}) }
63 foreach my $field ( grep !defined($self->{'Hash'}{$_}), $self->fields ) {
64 $self->{'Hash'}{$field}='';
67 $self->_rebless if $self->can('_rebless');
69 $self->{'modified'} = 0;
71 $self->_cache($self->{'Hash'}, shift) if $self->can('_cache') && @_;
77 sub _fieldhandlers { {}; }
81 # This restricts the fields based on part_svc_column and the svcpart of
82 # the service. There are four possible cases:
83 # 1. svcpart passed as part of the svc_x hash.
84 # 2. svcpart fetched via cust_svc based on svcnum.
85 # 3. No svcnum or svcpart. In this case, return ALL the fields with
86 # dbtable eq $self->table.
87 # 4. Called via "fields('svc_acct')" or something similar. In this case
88 # there is no $self object.
92 my @vfields = $self->SUPER::virtual_fields;
94 return @vfields unless (ref $self); # Case 4
96 if ($self->svcpart) { # Case 1
97 $svcpart = $self->svcpart;
98 } elsif ( $self->svcnum
99 && qsearchs('cust_svc',{'svcnum'=>$self->svcnum} )
101 $svcpart = $self->cust_svc->svcpart;
106 if ($svcpart) { #Cases 1 and 2
107 my %flags = map { $_->columnname, $_->columnflag } (
108 qsearch ('part_svc_column', { svcpart => $svcpart } )
110 return grep { not ($flags{$_} eq 'X') } @vfields;
119 Checks the validity of fields in this record.
121 At present, this does nothing but call FS::Record::check (which, in turn,
122 does nothing but run virtual field checks).
131 =item insert [ , OPTION => VALUE ... ]
133 Adds this record to the database. If there is an error, returns the error,
134 otherwise returns false.
136 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
137 defined. An FS::cust_svc record will be created and inserted.
139 Currently available options are: I<jobnums>, I<child_objects> and
142 If I<jobnum> is set to an array reference, the jobnums of any export jobs will
143 be added to the referenced array.
145 If I<child_objects> is set to an array reference of FS::tablename objects (for
146 example, FS::acct_snarf objects), they will have their svcnum field set and
147 will be inserted after this record, but before any exports are run. Each
148 element of the array can also optionally be a two-element array reference
149 containing the child object and the name of an alternate field to be filled in
150 with the newly-inserted svcnum, for example C<[ $svc_forward, 'srcsvc' ]>
152 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
153 jobnums), all provisioning jobs will have a dependancy on the supplied
154 jobnum(s) (they will not run until the specific job(s) complete(s)).
161 warn "[$me] insert called with options ".
162 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
166 local $FS::queue::jobnums = \@jobnums;
167 warn "[$me] insert: set \$FS::queue::jobnums to $FS::queue::jobnums\n"
169 my $objects = $options{'child_objects'} || [];
170 my $depend_jobnums = $options{'depend_jobnum'} || [];
171 $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
174 local $SIG{HUP} = 'IGNORE';
175 local $SIG{INT} = 'IGNORE';
176 local $SIG{QUIT} = 'IGNORE';
177 local $SIG{TERM} = 'IGNORE';
178 local $SIG{TSTP} = 'IGNORE';
179 local $SIG{PIPE} = 'IGNORE';
181 my $oldAutoCommit = $FS::UID::AutoCommit;
182 local $FS::UID::AutoCommit = 0;
185 $error = $self->check;
186 return $error if $error;
188 my $svcnum = $self->svcnum;
189 my $cust_svc = $svcnum ? qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) : '';
190 #unless ( $svcnum ) {
191 if ( !$svcnum or !$cust_svc ) {
192 $cust_svc = new FS::cust_svc ( {
193 #hua?# 'svcnum' => $svcnum,
194 'svcnum' => $self->svcnum,
195 'pkgnum' => $self->pkgnum,
196 'svcpart' => $self->svcpart,
198 $error = $cust_svc->insert;
200 $dbh->rollback if $oldAutoCommit;
203 $svcnum = $self->svcnum($cust_svc->svcnum);
205 #$cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
206 unless ( $cust_svc ) {
207 $dbh->rollback if $oldAutoCommit;
208 return "no cust_svc record found for svcnum ". $self->svcnum;
210 $self->pkgnum($cust_svc->pkgnum);
211 $self->svcpart($cust_svc->svcpart);
214 $error = $self->set_auto_inventory;
216 $dbh->rollback if $oldAutoCommit;
220 $error = $self->SUPER::insert;
222 $dbh->rollback if $oldAutoCommit;
226 foreach my $object ( @$objects ) {
228 if ( ref($object) eq 'ARRAY' ) {
229 ($obj, $field) = @$object;
234 $obj->$field($self->svcnum);
235 $error = $obj->insert;
237 $dbh->rollback if $oldAutoCommit;
243 unless ( $noexport_hack ) {
245 warn "[$me] insert: \$FS::queue::jobnums is $FS::queue::jobnums\n"
248 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
249 my $error = $part_export->export_insert($self);
251 $dbh->rollback if $oldAutoCommit;
252 return "exporting to ". $part_export->exporttype.
253 " (transaction rolled back): $error";
257 foreach my $depend_jobnum ( @$depend_jobnums ) {
258 warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
260 foreach my $jobnum ( @jobnums ) {
261 my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
262 warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
264 my $error = $queue->depend_insert($depend_jobnum);
266 $dbh->rollback if $oldAutoCommit;
267 return "error queuing job dependancy: $error";
274 if ( exists $options{'jobnums'} ) {
275 push @{ $options{'jobnums'} }, @jobnums;
278 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
285 Deletes this account from the database. If there is an error, returns the
286 error, otherwise returns false.
288 The corresponding FS::cust_svc record will be deleted as well.
296 local $SIG{HUP} = 'IGNORE';
297 local $SIG{INT} = 'IGNORE';
298 local $SIG{QUIT} = 'IGNORE';
299 local $SIG{TERM} = 'IGNORE';
300 local $SIG{TSTP} = 'IGNORE';
301 local $SIG{PIPE} = 'IGNORE';
303 my $svcnum = $self->svcnum;
305 my $oldAutoCommit = $FS::UID::AutoCommit;
306 local $FS::UID::AutoCommit = 0;
309 $error = $self->SUPER::delete;
310 return $error if $error;
313 unless ( $noexport_hack ) {
314 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
315 $error = $part_export->export_delete($self);
317 $dbh->rollback if $oldAutoCommit;
318 return "exporting to ". $part_export->exporttype.
319 " (transaction rolled back): $error";
324 $error = $self->return_inventory;
326 $dbh->rollback if $oldAutoCommit;
327 return "error returning inventory: $error";
330 my $cust_svc = $self->cust_svc;
331 $error = $cust_svc->delete;
333 $dbh->rollback if $oldAutoCommit;
337 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
342 =item replace OLD_RECORD
344 Replaces OLD_RECORD with this one. If there is an error, returns the error,
345 otherwise returns false.
350 my ($new, $old) = (shift, shift);
352 local $SIG{HUP} = 'IGNORE';
353 local $SIG{INT} = 'IGNORE';
354 local $SIG{QUIT} = 'IGNORE';
355 local $SIG{TERM} = 'IGNORE';
356 local $SIG{TSTP} = 'IGNORE';
357 local $SIG{PIPE} = 'IGNORE';
359 my $oldAutoCommit = $FS::UID::AutoCommit;
360 local $FS::UID::AutoCommit = 0;
363 # We absolutely have to have an old vs. new record to make this work.
364 if ( !defined($old) ) {
365 warn "[$me] replace called with no arguments; autoloading old record\n"
367 my $primary_key = $new->dbdef_table->primary_key;
368 if ( $primary_key ) {
369 $old = qsearchs($new->table, { $primary_key => $new->$primary_key() } )
370 or croak "can't find ". $new->table. ".$primary_key ".
371 $new->$primary_key();
373 croak $new->table. " has no primary key; pass old record as argument";
377 my $error = $new->set_auto_inventory;
379 $dbh->rollback if $oldAutoCommit;
383 $error = $new->SUPER::replace($old);
385 $dbh->rollback if $oldAutoCommit;
390 unless ( $noexport_hack ) {
392 #not quite false laziness, but same pattern as FS::svc_acct::replace and
393 #FS::part_export::sqlradius::_export_replace. List::Compare or something
394 #would be useful but too much of a pain in the ass to deploy
396 my @old_part_export = $old->cust_svc->part_svc->part_export;
397 my %old_exportnum = map { $_->exportnum => 1 } @old_part_export;
398 my @new_part_export =
400 ? qsearchs('part_svc', { svcpart=>$new->svcpart } )->part_export
401 : $new->cust_svc->part_svc->part_export;
402 my %new_exportnum = map { $_->exportnum => 1 } @new_part_export;
404 foreach my $delete_part_export (
405 grep { ! $new_exportnum{$_->exportnum} } @old_part_export
407 my $error = $delete_part_export->export_delete($old);
409 $dbh->rollback if $oldAutoCommit;
410 return "error deleting, export to ". $delete_part_export->exporttype.
411 " (transaction rolled back): $error";
415 foreach my $replace_part_export (
416 grep { $old_exportnum{$_->exportnum} } @new_part_export
418 my $error = $replace_part_export->export_replace($new,$old);
420 $dbh->rollback if $oldAutoCommit;
421 return "error exporting to ". $replace_part_export->exporttype.
422 " (transaction rolled back): $error";
426 foreach my $insert_part_export (
427 grep { ! $old_exportnum{$_->exportnum} } @new_part_export
429 my $error = $insert_part_export->export_insert($new);
431 $dbh->rollback if $oldAutoCommit;
432 return "error inserting export to ". $insert_part_export->exporttype.
433 " (transaction rolled back): $error";
439 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
446 Sets any fixed fields for this service (see L<FS::part_svc>). If there is an
447 error, returns the error, otherwise returns the FS::part_svc object (use ref()
448 to test the return). Usually called by the check method.
454 $self->setx('F', @_);
459 Sets all fields to their defaults (see L<FS::part_svc>), overriding their
460 current values. If there is an error, returns the error, otherwise returns
461 the FS::part_svc object (use ref() to test the return).
467 $self->setx('D', @_ );
470 =item set_default_and_fixed
474 sub set_default_and_fixed {
476 $self->setx( [ 'D', 'F' ], @_ );
479 =item setx FLAG | FLAG_ARRAYREF , [ CALLBACK_HASHREF ]
481 Sets fields according to the passed in flag or arrayref of flags.
483 Optionally, a hashref of field names and callback coderefs can be passed.
484 If a coderef exists for a given field name, instead of setting the field,
485 the coderef is called with the column value (part_svc_column.columnvalue)
486 as the single parameter.
493 my @x = ref($x) ? @$x : ($x);
494 my $coderef = scalar(@_) ? shift : $self->_fieldhandlers;
497 $self->ut_numbern('svcnum')
499 return $error if $error;
501 my $part_svc = $self->part_svc;
502 return "Unkonwn svcpart" unless $part_svc;
504 #set default/fixed/whatever fields from part_svc
506 foreach my $part_svc_column (
507 grep { my $f = $_->columnflag; grep { $f eq $_ } @x } #columnflag in @x
508 $part_svc->all_part_svc_column
511 my $columnname = $part_svc_column->columnname;
512 my $columnvalue = $part_svc_column->columnvalue;
514 $columnvalue = &{ $coderef->{$columnname} }( $self, $columnvalue )
515 if exists( $coderef->{$columnname} );
516 $self->setfield( $columnname, $columnvalue );
529 if ( $self->get('svcpart') ) {
530 $svcpart = $self->get('svcpart');
531 } elsif ( $self->svcnum && qsearchs('cust_svc', {'svcnum'=>$self->svcnum}) ) {
532 my $cust_svc = $self->cust_svc;
533 return "Unknown svcnum" unless $cust_svc;
534 $svcpart = $cust_svc->svcpart;
537 qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
541 =item set_auto_inventory
543 Sets any fields which auto-populate from inventory (see L<FS::part_svc>).
544 If there is an error, returns the error, otherwise returns false.
548 sub set_auto_inventory {
552 $self->ut_numbern('svcnum')
554 return $error if $error;
556 my $part_svc = $self->part_svc;
557 return "Unkonwn svcpart" unless $part_svc;
559 local $SIG{HUP} = 'IGNORE';
560 local $SIG{INT} = 'IGNORE';
561 local $SIG{QUIT} = 'IGNORE';
562 local $SIG{TERM} = 'IGNORE';
563 local $SIG{TSTP} = 'IGNORE';
564 local $SIG{PIPE} = 'IGNORE';
566 my $oldAutoCommit = $FS::UID::AutoCommit;
567 local $FS::UID::AutoCommit = 0;
570 #set default/fixed/whatever fields from part_svc
571 my $table = $self->table;
572 foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
573 my $part_svc_column = $part_svc->part_svc_column($field);
574 if ( $part_svc_column->columnflag eq 'A' && $self->$field() eq '' ) {
576 my $classnum = $part_svc_column->columnvalue;
577 my $inventory_item = qsearchs({
578 'table' => 'inventory_item',
579 'hashref' => { 'classnum' => $classnum,
582 'extra_sql' => 'LIMIT 1 FOR UPDATE',
585 unless ( $inventory_item ) {
586 $dbh->rollback if $oldAutoCommit;
587 my $inventory_class =
588 qsearchs('inventory_class', { 'classnum' => $classnum } );
589 return "Can't find inventory_class.classnum $classnum"
590 unless $inventory_class;
591 return "Out of ". $inventory_class->classname. "s\n"; #Lingua:: BS
595 $inventory_item->svcnum( $self->svcnum );
596 my $ierror = $inventory_item->replace();
598 $dbh->rollback if $oldAutoCommit;
599 return "Error provisioning inventory: $ierror";
603 $self->setfield( $field, $inventory_item->item );
608 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
614 =item return_inventory
618 sub return_inventory {
621 local $SIG{HUP} = 'IGNORE';
622 local $SIG{INT} = 'IGNORE';
623 local $SIG{QUIT} = 'IGNORE';
624 local $SIG{TERM} = 'IGNORE';
625 local $SIG{TSTP} = 'IGNORE';
626 local $SIG{PIPE} = 'IGNORE';
628 my $oldAutoCommit = $FS::UID::AutoCommit;
629 local $FS::UID::AutoCommit = 0;
632 foreach my $inventory_item ( $self->inventory_item ) {
633 $inventory_item->svcnum('');
634 my $error = $inventory_item->replace();
636 $dbh->rollback if $oldAutoCommit;
637 return "Error returning inventory: $error";
641 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
648 Returns the inventory items associated with this svc_ record, as
649 FS::inventory_item objects (see L<FS::inventory_item>.
656 'table' => 'inventory_item',
657 'hashref' => { 'svcnum' => $self->svcnum, },
663 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
664 object (see L<FS::cust_svc>).
670 qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
675 Runs export_suspend callbacks.
682 local $SIG{HUP} = 'IGNORE';
683 local $SIG{INT} = 'IGNORE';
684 local $SIG{QUIT} = 'IGNORE';
685 local $SIG{TERM} = 'IGNORE';
686 local $SIG{TSTP} = 'IGNORE';
687 local $SIG{PIPE} = 'IGNORE';
689 my $oldAutoCommit = $FS::UID::AutoCommit;
690 local $FS::UID::AutoCommit = 0;
694 unless ( $noexport_hack ) {
695 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
696 my $error = $part_export->export_suspend($self);
698 $dbh->rollback if $oldAutoCommit;
699 return "error exporting to ". $part_export->exporttype.
700 " (transaction rolled back): $error";
705 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
712 Runs export_unsuspend callbacks.
719 local $SIG{HUP} = 'IGNORE';
720 local $SIG{INT} = 'IGNORE';
721 local $SIG{QUIT} = 'IGNORE';
722 local $SIG{TERM} = 'IGNORE';
723 local $SIG{TSTP} = 'IGNORE';
724 local $SIG{PIPE} = 'IGNORE';
726 my $oldAutoCommit = $FS::UID::AutoCommit;
727 local $FS::UID::AutoCommit = 0;
731 unless ( $noexport_hack ) {
732 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
733 my $error = $part_export->export_unsuspend($self);
735 $dbh->rollback if $oldAutoCommit;
736 return "error exporting to ". $part_export->exporttype.
737 " (transaction rolled back): $error";
742 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
749 Stub - returns false (no error) so derived classes don't need to define these
750 methods. Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
756 =item clone_suspended
758 Constructor used by FS::part_export::_export_suspend fallback. Stub returning
759 same object for svc_ classes which don't implement a suspension fallback
760 (everything except svc_acct at the moment). Document better.
764 sub clone_suspended {
768 =item clone_kludge_unsuspend
770 Constructor used by FS::part_export::_export_unsuspend fallback. Stub returning
771 same object for svc_ classes which don't implement a suspension fallback
772 (everything except svc_acct at the moment). Document better.
776 sub clone_kludge_unsuspend {
784 The setfixed method return value.
788 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
789 from the base documentation.