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.
44 It is now case-insensitive by default.
48 sub search_sql_field {
49 my( $class, $field, $string ) = @_;
50 my $table = $class->table;
51 my $q_string = dbh->quote($string);
52 "LOWER($table.$field) = LOWER($q_string)";
55 #fallback for services that don't provide a search...
57 #my( $class, $string ) = @_;
67 my $class = ref($proto) || $proto;
69 bless ($self, $class);
71 unless ( defined ( $self->table ) ) {
72 $self->{'Table'} = shift;
73 carp "warning: FS::Record::new called with table name ". $self->{'Table'};
76 #$self->{'Hash'} = shift;
78 $self->{'Hash'} = { map { $_ => $newhash->{$_} } qw(svcnum svcpart) };
80 $self->setdefault( $self->_fieldhandlers )
83 $self->{'Hash'}{$_} = $newhash->{$_}
84 foreach grep { defined($newhash->{$_}) && length($newhash->{$_}) }
87 foreach my $field ( grep !defined($self->{'Hash'}{$_}), $self->fields ) {
88 $self->{'Hash'}{$field}='';
91 $self->_rebless if $self->can('_rebless');
93 $self->{'modified'} = 0;
95 $self->_cache($self->{'Hash'}, shift) if $self->can('_cache') && @_;
101 sub _fieldhandlers { {}; }
105 # This restricts the fields based on part_svc_column and the svcpart of
106 # the service. There are four possible cases:
107 # 1. svcpart passed as part of the svc_x hash.
108 # 2. svcpart fetched via cust_svc based on svcnum.
109 # 3. No svcnum or svcpart. In this case, return ALL the fields with
110 # dbtable eq $self->table.
111 # 4. Called via "fields('svc_acct')" or something similar. In this case
112 # there is no $self object.
116 my @vfields = $self->SUPER::virtual_fields;
118 return @vfields unless (ref $self); # Case 4
120 if ($self->svcpart) { # Case 1
121 $svcpart = $self->svcpart;
122 } elsif ( $self->svcnum
123 && qsearchs('cust_svc',{'svcnum'=>$self->svcnum} )
125 $svcpart = $self->cust_svc->svcpart;
130 if ($svcpart) { #Cases 1 and 2
131 my %flags = map { $_->columnname, $_->columnflag } (
132 qsearch ('part_svc_column', { svcpart => $svcpart } )
134 return grep { not ( defined($flags{$_}) && $flags{$_} eq 'X') } @vfields;
143 svc_Common provides a fallback label subroutine that just returns the svcnum.
149 cluck "warning: ". ref($self). " not loaded or missing label method; ".
161 Checks the validity of fields in this record.
163 At present, this does nothing but call FS::Record::check (which, in turn,
164 does nothing but run virtual field checks).
173 =item insert [ , OPTION => VALUE ... ]
175 Adds this record to the database. If there is an error, returns the error,
176 otherwise returns false.
178 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
179 defined. An FS::cust_svc record will be created and inserted.
181 Currently available options are: I<jobnums>, I<child_objects> and
184 If I<jobnum> is set to an array reference, the jobnums of any export jobs will
185 be added to the referenced array.
187 If I<child_objects> is set to an array reference of FS::tablename objects (for
188 example, FS::acct_snarf objects), they will have their svcnum field set and
189 will be inserted after this record, but before any exports are run. Each
190 element of the array can also optionally be a two-element array reference
191 containing the child object and the name of an alternate field to be filled in
192 with the newly-inserted svcnum, for example C<[ $svc_forward, 'srcsvc' ]>
194 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
195 jobnums), all provisioning jobs will have a dependancy on the supplied
196 jobnum(s) (they will not run until the specific job(s) complete(s)).
198 If I<export_args> is set to an array reference, the referenced list will be
199 passed to export commands.
206 warn "[$me] insert called with options ".
207 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
211 local $FS::queue::jobnums = \@jobnums;
212 warn "[$me] insert: set \$FS::queue::jobnums to $FS::queue::jobnums\n"
214 my $objects = $options{'child_objects'} || [];
215 my $depend_jobnums = $options{'depend_jobnum'} || [];
216 $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
218 local $SIG{HUP} = 'IGNORE';
219 local $SIG{INT} = 'IGNORE';
220 local $SIG{QUIT} = 'IGNORE';
221 local $SIG{TERM} = 'IGNORE';
222 local $SIG{TSTP} = 'IGNORE';
223 local $SIG{PIPE} = 'IGNORE';
225 my $oldAutoCommit = $FS::UID::AutoCommit;
226 local $FS::UID::AutoCommit = 0;
229 my $svcnum = $self->svcnum;
230 my $cust_svc = $svcnum ? qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) : '';
231 #unless ( $svcnum ) {
232 if ( !$svcnum or !$cust_svc ) {
233 $cust_svc = new FS::cust_svc ( {
234 #hua?# 'svcnum' => $svcnum,
235 'svcnum' => $self->svcnum,
236 'pkgnum' => $self->pkgnum,
237 'svcpart' => $self->svcpart,
239 my $error = $cust_svc->insert;
241 $dbh->rollback if $oldAutoCommit;
244 $svcnum = $self->svcnum($cust_svc->svcnum);
246 #$cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
247 unless ( $cust_svc ) {
248 $dbh->rollback if $oldAutoCommit;
249 return "no cust_svc record found for svcnum ". $self->svcnum;
251 $self->pkgnum($cust_svc->pkgnum);
252 $self->svcpart($cust_svc->svcpart);
255 my $error = $self->set_auto_inventory
257 || $self->_check_duplicate
258 || $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;
324 sub _check_duplcate { ''; }
325 sub table_dupcheck_fields { (); }
327 =item delete [ , OPTION => VALUE ... ]
329 Deletes this account from the database. If there is an error, returns the
330 error, otherwise returns false.
332 The corresponding FS::cust_svc record will be deleted as well.
339 my $export_args = $options{'export_args'} || [];
341 local $SIG{HUP} = 'IGNORE';
342 local $SIG{INT} = 'IGNORE';
343 local $SIG{QUIT} = 'IGNORE';
344 local $SIG{TERM} = 'IGNORE';
345 local $SIG{TSTP} = 'IGNORE';
346 local $SIG{PIPE} = 'IGNORE';
348 my $oldAutoCommit = $FS::UID::AutoCommit;
349 local $FS::UID::AutoCommit = 0;
352 my $error = $self->SUPER::delete
353 || $self->export('delete', @$export_args)
354 || $self->return_inventory
355 || $self->cust_svc->delete
358 $dbh->rollback if $oldAutoCommit;
362 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
367 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ]
369 Replaces OLD_RECORD with this one. If there is an error, returns the error,
370 otherwise returns false.
377 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
382 ( ref($_[0]) eq 'HASH' )
386 local $SIG{HUP} = 'IGNORE';
387 local $SIG{INT} = 'IGNORE';
388 local $SIG{QUIT} = 'IGNORE';
389 local $SIG{TERM} = 'IGNORE';
390 local $SIG{TSTP} = 'IGNORE';
391 local $SIG{PIPE} = 'IGNORE';
393 my $oldAutoCommit = $FS::UID::AutoCommit;
394 local $FS::UID::AutoCommit = 0;
397 my $error = $new->set_auto_inventory;
399 $dbh->rollback if $oldAutoCommit;
403 #redundant, but so any duplicate fields are maniuplated as appropriate
404 # (svc_phone.phonenum)
405 $error = $new->check;
407 $dbh->rollback if $oldAutoCommit;
411 #if ( $old->username ne $new->username || $old->domsvc != $new->domsvc ) {
412 if ( grep { $old->$_ ne $new->$_ } $new->table_dupcheck_fields ) {
414 $new->svcpart( $new->cust_svc->svcpart ) unless $new->svcpart;
415 $error = $new->_check_duplicate;
417 $dbh->rollback if $oldAutoCommit;
422 $error = $new->SUPER::replace($old);
424 $dbh->rollback if $oldAutoCommit;
429 unless ( $noexport_hack ) {
431 my $export_args = $options->{'export_args'} || [];
433 #not quite false laziness, but same pattern as FS::svc_acct::replace and
434 #FS::part_export::sqlradius::_export_replace. List::Compare or something
435 #would be useful but too much of a pain in the ass to deploy
437 my @old_part_export = $old->cust_svc->part_svc->part_export;
438 my %old_exportnum = map { $_->exportnum => 1 } @old_part_export;
439 my @new_part_export =
441 ? qsearchs('part_svc', { svcpart=>$new->svcpart } )->part_export
442 : $new->cust_svc->part_svc->part_export;
443 my %new_exportnum = map { $_->exportnum => 1 } @new_part_export;
445 foreach my $delete_part_export (
446 grep { ! $new_exportnum{$_->exportnum} } @old_part_export
448 my $error = $delete_part_export->export_delete($old, @$export_args);
450 $dbh->rollback if $oldAutoCommit;
451 return "error deleting, export to ". $delete_part_export->exporttype.
452 " (transaction rolled back): $error";
456 foreach my $replace_part_export (
457 grep { $old_exportnum{$_->exportnum} } @new_part_export
460 $replace_part_export->export_replace( $new, $old, @$export_args);
462 $dbh->rollback if $oldAutoCommit;
463 return "error exporting to ". $replace_part_export->exporttype.
464 " (transaction rolled back): $error";
468 foreach my $insert_part_export (
469 grep { ! $old_exportnum{$_->exportnum} } @new_part_export
471 my $error = $insert_part_export->export_insert($new, @$export_args );
473 $dbh->rollback if $oldAutoCommit;
474 return "error inserting export to ". $insert_part_export->exporttype.
475 " (transaction rolled back): $error";
481 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
487 Sets any fixed fields for this service (see L<FS::part_svc>). If there is an
488 error, returns the error, otherwise returns the FS::part_svc object (use ref()
489 to test the return). Usually called by the check method.
495 $self->setx('F', @_);
500 Sets all fields to their defaults (see L<FS::part_svc>), overriding their
501 current values. If there is an error, returns the error, otherwise returns
502 the FS::part_svc object (use ref() to test the return).
508 $self->setx('D', @_ );
511 =item set_default_and_fixed
515 sub set_default_and_fixed {
517 $self->setx( [ 'D', 'F' ], @_ );
520 =item setx FLAG | FLAG_ARRAYREF , [ CALLBACK_HASHREF ]
522 Sets fields according to the passed in flag or arrayref of flags.
524 Optionally, a hashref of field names and callback coderefs can be passed.
525 If a coderef exists for a given field name, instead of setting the field,
526 the coderef is called with the column value (part_svc_column.columnvalue)
527 as the single parameter.
534 my @x = ref($x) ? @$x : ($x);
535 my $coderef = scalar(@_) ? shift : $self->_fieldhandlers;
538 $self->ut_numbern('svcnum')
540 return $error if $error;
542 my $part_svc = $self->part_svc;
543 return "Unknown svcpart" unless $part_svc;
545 #set default/fixed/whatever fields from part_svc
547 foreach my $part_svc_column (
548 grep { my $f = $_->columnflag; grep { $f eq $_ } @x } #columnflag in @x
549 $part_svc->all_part_svc_column
552 my $columnname = $part_svc_column->columnname;
553 my $columnvalue = $part_svc_column->columnvalue;
555 $columnvalue = &{ $coderef->{$columnname} }( $self, $columnvalue )
556 if exists( $coderef->{$columnname} );
557 $self->setfield( $columnname, $columnvalue );
570 if ( $self->get('svcpart') ) {
571 $svcpart = $self->get('svcpart');
572 } elsif ( $self->svcnum && qsearchs('cust_svc', {'svcnum'=>$self->svcnum}) ) {
573 my $cust_svc = $self->cust_svc;
574 return "Unknown svcnum" unless $cust_svc;
575 $svcpart = $cust_svc->svcpart;
578 qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
582 =item set_auto_inventory
584 Sets any fields which auto-populate from inventory (see L<FS::part_svc>).
585 If there is an error, returns the error, otherwise returns false.
589 sub set_auto_inventory {
593 $self->ut_numbern('svcnum')
595 return $error if $error;
597 my $part_svc = $self->part_svc;
598 return "Unkonwn svcpart" unless $part_svc;
600 local $SIG{HUP} = 'IGNORE';
601 local $SIG{INT} = 'IGNORE';
602 local $SIG{QUIT} = 'IGNORE';
603 local $SIG{TERM} = 'IGNORE';
604 local $SIG{TSTP} = 'IGNORE';
605 local $SIG{PIPE} = 'IGNORE';
607 my $oldAutoCommit = $FS::UID::AutoCommit;
608 local $FS::UID::AutoCommit = 0;
611 #set default/fixed/whatever fields from part_svc
612 my $table = $self->table;
613 foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
614 my $part_svc_column = $part_svc->part_svc_column($field);
615 if ( $part_svc_column->columnflag eq 'A' && $self->$field() eq '' ) {
617 my $classnum = $part_svc_column->columnvalue;
618 my $inventory_item = qsearchs({
619 'table' => 'inventory_item',
620 'hashref' => { 'classnum' => $classnum,
623 'extra_sql' => 'LIMIT 1 FOR UPDATE',
626 unless ( $inventory_item ) {
627 $dbh->rollback if $oldAutoCommit;
628 my $inventory_class =
629 qsearchs('inventory_class', { 'classnum' => $classnum } );
630 return "Can't find inventory_class.classnum $classnum"
631 unless $inventory_class;
632 return "Out of ". $inventory_class->classname. "s\n"; #Lingua:: BS
636 $inventory_item->svcnum( $self->svcnum );
637 my $ierror = $inventory_item->replace();
639 $dbh->rollback if $oldAutoCommit;
640 return "Error provisioning inventory: $ierror";
644 $self->setfield( $field, $inventory_item->item );
649 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
655 =item return_inventory
659 sub return_inventory {
662 local $SIG{HUP} = 'IGNORE';
663 local $SIG{INT} = 'IGNORE';
664 local $SIG{QUIT} = 'IGNORE';
665 local $SIG{TERM} = 'IGNORE';
666 local $SIG{TSTP} = 'IGNORE';
667 local $SIG{PIPE} = 'IGNORE';
669 my $oldAutoCommit = $FS::UID::AutoCommit;
670 local $FS::UID::AutoCommit = 0;
673 foreach my $inventory_item ( $self->inventory_item ) {
674 $inventory_item->svcnum('');
675 my $error = $inventory_item->replace();
677 $dbh->rollback if $oldAutoCommit;
678 return "Error returning inventory: $error";
682 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
689 Returns the inventory items associated with this svc_ record, as
690 FS::inventory_item objects (see L<FS::inventory_item>.
697 'table' => 'inventory_item',
698 'hashref' => { 'svcnum' => $self->svcnum, },
704 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
705 object (see L<FS::cust_svc>).
711 qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
716 Runs export_suspend callbacks.
723 my $export_args = $options{'export_args'} || [];
724 $self->export('suspend', @$export_args);
729 Runs export_unsuspend callbacks.
736 my $export_args = $options{'export_args'} || [];
737 $self->export('unsuspend', @$export_args);
742 Runs export_links callbacks and returns the links.
749 $self->export('links', $return);
753 =item export HOOK [ EXPORT_ARGS ]
755 Runs the provided export hook (i.e. "suspend", "unsuspend") for this service.
760 my( $self, $method ) = ( shift, shift );
762 $method = "export_$method" unless $method =~ /^export_/;
764 local $SIG{HUP} = 'IGNORE';
765 local $SIG{INT} = 'IGNORE';
766 local $SIG{QUIT} = 'IGNORE';
767 local $SIG{TERM} = 'IGNORE';
768 local $SIG{TSTP} = 'IGNORE';
769 local $SIG{PIPE} = 'IGNORE';
771 my $oldAutoCommit = $FS::UID::AutoCommit;
772 local $FS::UID::AutoCommit = 0;
776 unless ( $noexport_hack ) {
777 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
778 next unless $part_export->can($method);
779 my $error = $part_export->$method($self, @_);
781 $dbh->rollback if $oldAutoCommit;
782 return "error exporting $method event to ". $part_export->exporttype.
783 " (transaction rolled back): $error";
788 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
795 Sets or retrieves overlimit date.
801 $self->cust_svc->overlimit(@_);
806 Stub - returns false (no error) so derived classes don't need to define this
807 methods. Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
809 This method is called *before* the deletion step which actually deletes the
810 services. This method should therefore only be used for "pre-deletion"
811 cancellation steps, if necessary.
817 =item clone_suspended
819 Constructor used by FS::part_export::_export_suspend fallback. Stub returning
820 same object for svc_ classes which don't implement a suspension fallback
821 (everything except svc_acct at the moment). Document better.
825 sub clone_suspended {
829 =item clone_kludge_unsuspend
831 Constructor used by FS::part_export::_export_unsuspend fallback. Stub returning
832 same object for svc_ classes which don't implement a suspension fallback
833 (everything except svc_acct at the moment). Document better.
837 sub clone_kludge_unsuspend {
845 The setfixed method return value.
847 B<export> method isn't used by insert and replace methods yet.
851 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
852 from the base documentation.