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; ".
156 Checks the validity of fields in this record.
158 At present, this does nothing but call FS::Record::check (which, in turn,
159 does nothing but run virtual field checks).
168 =item insert [ , OPTION => VALUE ... ]
170 Adds this record to the database. If there is an error, returns the error,
171 otherwise returns false.
173 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
174 defined. An FS::cust_svc record will be created and inserted.
176 Currently available options are: I<jobnums>, I<child_objects> and
179 If I<jobnum> is set to an array reference, the jobnums of any export jobs will
180 be added to the referenced array.
182 If I<child_objects> is set to an array reference of FS::tablename objects (for
183 example, FS::acct_snarf objects), they will have their svcnum field set and
184 will be inserted after this record, but before any exports are run. Each
185 element of the array can also optionally be a two-element array reference
186 containing the child object and the name of an alternate field to be filled in
187 with the newly-inserted svcnum, for example C<[ $svc_forward, 'srcsvc' ]>
189 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
190 jobnums), all provisioning jobs will have a dependancy on the supplied
191 jobnum(s) (they will not run until the specific job(s) complete(s)).
193 If I<export_args> is set to an array reference, the referenced list will be
194 passed to export commands.
201 warn "[$me] insert called with options ".
202 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
206 local $FS::queue::jobnums = \@jobnums;
207 warn "[$me] insert: set \$FS::queue::jobnums to $FS::queue::jobnums\n"
209 my $objects = $options{'child_objects'} || [];
210 my $depend_jobnums = $options{'depend_jobnum'} || [];
211 $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
213 local $SIG{HUP} = 'IGNORE';
214 local $SIG{INT} = 'IGNORE';
215 local $SIG{QUIT} = 'IGNORE';
216 local $SIG{TERM} = 'IGNORE';
217 local $SIG{TSTP} = 'IGNORE';
218 local $SIG{PIPE} = 'IGNORE';
220 my $oldAutoCommit = $FS::UID::AutoCommit;
221 local $FS::UID::AutoCommit = 0;
224 my $svcnum = $self->svcnum;
225 my $cust_svc = $svcnum ? qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) : '';
226 #unless ( $svcnum ) {
227 if ( !$svcnum or !$cust_svc ) {
228 $cust_svc = new FS::cust_svc ( {
229 #hua?# 'svcnum' => $svcnum,
230 'svcnum' => $self->svcnum,
231 'pkgnum' => $self->pkgnum,
232 'svcpart' => $self->svcpart,
234 my $error = $cust_svc->insert;
236 $dbh->rollback if $oldAutoCommit;
239 $svcnum = $self->svcnum($cust_svc->svcnum);
241 #$cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
242 unless ( $cust_svc ) {
243 $dbh->rollback if $oldAutoCommit;
244 return "no cust_svc record found for svcnum ". $self->svcnum;
246 $self->pkgnum($cust_svc->pkgnum);
247 $self->svcpart($cust_svc->svcpart);
250 my $error = $self->set_auto_inventory
252 || $self->_check_duplicate
253 || $self->SUPER::insert;
255 $dbh->rollback if $oldAutoCommit;
259 foreach my $object ( @$objects ) {
261 if ( ref($object) eq 'ARRAY' ) {
262 ($obj, $field) = @$object;
267 $obj->$field($self->svcnum);
268 $error = $obj->insert;
270 $dbh->rollback if $oldAutoCommit;
276 unless ( $noexport_hack ) {
278 warn "[$me] insert: \$FS::queue::jobnums is $FS::queue::jobnums\n"
281 my $export_args = $options{'export_args'} || [];
283 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
284 my $error = $part_export->export_insert($self, @$export_args);
286 $dbh->rollback if $oldAutoCommit;
287 return "exporting to ". $part_export->exporttype.
288 " (transaction rolled back): $error";
292 foreach my $depend_jobnum ( @$depend_jobnums ) {
293 warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
295 foreach my $jobnum ( @jobnums ) {
296 my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
297 warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
299 my $error = $queue->depend_insert($depend_jobnum);
301 $dbh->rollback if $oldAutoCommit;
302 return "error queuing job dependancy: $error";
309 if ( exists $options{'jobnums'} ) {
310 push @{ $options{'jobnums'} }, @jobnums;
313 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
319 sub _check_duplcate { ''; }
320 sub table_dupcheck_fields { (); }
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 ] [ HASHREF | OPTION => VALUE ]
364 Replaces OLD_RECORD with this one. If there is an error, returns the error,
365 otherwise returns false.
372 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
377 ( ref($_[0]) eq 'HASH' )
381 local $SIG{HUP} = 'IGNORE';
382 local $SIG{INT} = 'IGNORE';
383 local $SIG{QUIT} = 'IGNORE';
384 local $SIG{TERM} = 'IGNORE';
385 local $SIG{TSTP} = 'IGNORE';
386 local $SIG{PIPE} = 'IGNORE';
388 my $oldAutoCommit = $FS::UID::AutoCommit;
389 local $FS::UID::AutoCommit = 0;
392 my $error = $new->set_auto_inventory;
394 $dbh->rollback if $oldAutoCommit;
398 #redundant, but so any duplicate fields are maniuplated as appropriate
399 # (svc_phone.phonenum)
400 $error = $new->check;
402 $dbh->rollback if $oldAutoCommit;
406 #if ( $old->username ne $new->username || $old->domsvc != $new->domsvc ) {
407 if ( grep { $old->$_ ne $new->$_ } $new->table_dupcheck_fields ) {
409 $new->svcpart( $new->cust_svc->svcpart ) unless $new->svcpart;
410 $error = $new->_check_duplicate;
412 $dbh->rollback if $oldAutoCommit;
417 $error = $new->SUPER::replace($old);
419 $dbh->rollback if $oldAutoCommit;
424 unless ( $noexport_hack ) {
426 my $export_args = $options->{'export_args'} || [];
428 #not quite false laziness, but same pattern as FS::svc_acct::replace and
429 #FS::part_export::sqlradius::_export_replace. List::Compare or something
430 #would be useful but too much of a pain in the ass to deploy
432 my @old_part_export = $old->cust_svc->part_svc->part_export;
433 my %old_exportnum = map { $_->exportnum => 1 } @old_part_export;
434 my @new_part_export =
436 ? qsearchs('part_svc', { svcpart=>$new->svcpart } )->part_export
437 : $new->cust_svc->part_svc->part_export;
438 my %new_exportnum = map { $_->exportnum => 1 } @new_part_export;
440 foreach my $delete_part_export (
441 grep { ! $new_exportnum{$_->exportnum} } @old_part_export
443 my $error = $delete_part_export->export_delete($old, @$export_args);
445 $dbh->rollback if $oldAutoCommit;
446 return "error deleting, export to ". $delete_part_export->exporttype.
447 " (transaction rolled back): $error";
451 foreach my $replace_part_export (
452 grep { $old_exportnum{$_->exportnum} } @new_part_export
455 $replace_part_export->export_replace( $new, $old, @$export_args);
457 $dbh->rollback if $oldAutoCommit;
458 return "error exporting to ". $replace_part_export->exporttype.
459 " (transaction rolled back): $error";
463 foreach my $insert_part_export (
464 grep { ! $old_exportnum{$_->exportnum} } @new_part_export
466 my $error = $insert_part_export->export_insert($new, @$export_args );
468 $dbh->rollback if $oldAutoCommit;
469 return "error inserting export to ". $insert_part_export->exporttype.
470 " (transaction rolled back): $error";
476 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
482 Sets any fixed fields for this service (see L<FS::part_svc>). If there is an
483 error, returns the error, otherwise returns the FS::part_svc object (use ref()
484 to test the return). Usually called by the check method.
490 $self->setx('F', @_);
495 Sets all fields to their defaults (see L<FS::part_svc>), overriding their
496 current values. If there is an error, returns the error, otherwise returns
497 the FS::part_svc object (use ref() to test the return).
503 $self->setx('D', @_ );
506 =item set_default_and_fixed
510 sub set_default_and_fixed {
512 $self->setx( [ 'D', 'F' ], @_ );
515 =item setx FLAG | FLAG_ARRAYREF , [ CALLBACK_HASHREF ]
517 Sets fields according to the passed in flag or arrayref of flags.
519 Optionally, a hashref of field names and callback coderefs can be passed.
520 If a coderef exists for a given field name, instead of setting the field,
521 the coderef is called with the column value (part_svc_column.columnvalue)
522 as the single parameter.
529 my @x = ref($x) ? @$x : ($x);
530 my $coderef = scalar(@_) ? shift : $self->_fieldhandlers;
533 $self->ut_numbern('svcnum')
535 return $error if $error;
537 my $part_svc = $self->part_svc;
538 return "Unknown svcpart" unless $part_svc;
540 #set default/fixed/whatever fields from part_svc
542 foreach my $part_svc_column (
543 grep { my $f = $_->columnflag; grep { $f eq $_ } @x } #columnflag in @x
544 $part_svc->all_part_svc_column
547 my $columnname = $part_svc_column->columnname;
548 my $columnvalue = $part_svc_column->columnvalue;
550 $columnvalue = &{ $coderef->{$columnname} }( $self, $columnvalue )
551 if exists( $coderef->{$columnname} );
552 $self->setfield( $columnname, $columnvalue );
565 if ( $self->get('svcpart') ) {
566 $svcpart = $self->get('svcpart');
567 } elsif ( $self->svcnum && qsearchs('cust_svc', {'svcnum'=>$self->svcnum}) ) {
568 my $cust_svc = $self->cust_svc;
569 return "Unknown svcnum" unless $cust_svc;
570 $svcpart = $cust_svc->svcpart;
573 qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
577 =item set_auto_inventory
579 Sets any fields which auto-populate from inventory (see L<FS::part_svc>).
580 If there is an error, returns the error, otherwise returns false.
584 sub set_auto_inventory {
588 $self->ut_numbern('svcnum')
590 return $error if $error;
592 my $part_svc = $self->part_svc;
593 return "Unkonwn svcpart" unless $part_svc;
595 local $SIG{HUP} = 'IGNORE';
596 local $SIG{INT} = 'IGNORE';
597 local $SIG{QUIT} = 'IGNORE';
598 local $SIG{TERM} = 'IGNORE';
599 local $SIG{TSTP} = 'IGNORE';
600 local $SIG{PIPE} = 'IGNORE';
602 my $oldAutoCommit = $FS::UID::AutoCommit;
603 local $FS::UID::AutoCommit = 0;
606 #set default/fixed/whatever fields from part_svc
607 my $table = $self->table;
608 foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
609 my $part_svc_column = $part_svc->part_svc_column($field);
610 if ( $part_svc_column->columnflag eq 'A' && $self->$field() eq '' ) {
612 my $classnum = $part_svc_column->columnvalue;
613 my $inventory_item = qsearchs({
614 'table' => 'inventory_item',
615 'hashref' => { 'classnum' => $classnum,
618 'extra_sql' => 'LIMIT 1 FOR UPDATE',
621 unless ( $inventory_item ) {
622 $dbh->rollback if $oldAutoCommit;
623 my $inventory_class =
624 qsearchs('inventory_class', { 'classnum' => $classnum } );
625 return "Can't find inventory_class.classnum $classnum"
626 unless $inventory_class;
627 return "Out of ". $inventory_class->classname. "s\n"; #Lingua:: BS
631 $inventory_item->svcnum( $self->svcnum );
632 my $ierror = $inventory_item->replace();
634 $dbh->rollback if $oldAutoCommit;
635 return "Error provisioning inventory: $ierror";
639 $self->setfield( $field, $inventory_item->item );
644 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
650 =item return_inventory
654 sub return_inventory {
657 local $SIG{HUP} = 'IGNORE';
658 local $SIG{INT} = 'IGNORE';
659 local $SIG{QUIT} = 'IGNORE';
660 local $SIG{TERM} = 'IGNORE';
661 local $SIG{TSTP} = 'IGNORE';
662 local $SIG{PIPE} = 'IGNORE';
664 my $oldAutoCommit = $FS::UID::AutoCommit;
665 local $FS::UID::AutoCommit = 0;
668 foreach my $inventory_item ( $self->inventory_item ) {
669 $inventory_item->svcnum('');
670 my $error = $inventory_item->replace();
672 $dbh->rollback if $oldAutoCommit;
673 return "Error returning inventory: $error";
677 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
684 Returns the inventory items associated with this svc_ record, as
685 FS::inventory_item objects (see L<FS::inventory_item>.
692 'table' => 'inventory_item',
693 'hashref' => { 'svcnum' => $self->svcnum, },
699 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
700 object (see L<FS::cust_svc>).
706 qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
711 Runs export_suspend callbacks.
718 my $export_args = $options{'export_args'} || [];
719 $self->export('suspend', @$export_args);
724 Runs export_unsuspend callbacks.
731 my $export_args = $options{'export_args'} || [];
732 $self->export('unsuspend', @$export_args);
737 Runs export_links callbacks and returns the links.
744 $self->export('links', $return);
748 =item export HOOK [ EXPORT_ARGS ]
750 Runs the provided export hook (i.e. "suspend", "unsuspend") for this service.
755 my( $self, $method ) = ( shift, shift );
757 $method = "export_$method" unless $method =~ /^export_/;
759 local $SIG{HUP} = 'IGNORE';
760 local $SIG{INT} = 'IGNORE';
761 local $SIG{QUIT} = 'IGNORE';
762 local $SIG{TERM} = 'IGNORE';
763 local $SIG{TSTP} = 'IGNORE';
764 local $SIG{PIPE} = 'IGNORE';
766 my $oldAutoCommit = $FS::UID::AutoCommit;
767 local $FS::UID::AutoCommit = 0;
771 unless ( $noexport_hack ) {
772 foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
773 next unless $part_export->can($method);
774 my $error = $part_export->$method($self, @_);
776 $dbh->rollback if $oldAutoCommit;
777 return "error exporting $method event to ". $part_export->exporttype.
778 " (transaction rolled back): $error";
783 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
790 Sets or retrieves overlimit date.
796 $self->cust_svc->overlimit(@_);
801 Stub - returns false (no error) so derived classes don't need to define this
802 methods. Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
804 This method is called *before* the deletion step which actually deletes the
805 services. This method should therefore only be used for "pre-deletion"
806 cancellation steps, if necessary.
812 =item clone_suspended
814 Constructor used by FS::part_export::_export_suspend fallback. Stub returning
815 same object for svc_ classes which don't implement a suspension fallback
816 (everything except svc_acct at the moment). Document better.
820 sub clone_suspended {
824 =item clone_kludge_unsuspend
826 Constructor used by FS::part_export::_export_unsuspend fallback. Stub returning
827 same object for svc_ classes which don't implement a suspension fallback
828 (everything except svc_acct at the moment). Document better.
832 sub clone_kludge_unsuspend {
840 The setfixed method return value.
842 B<export> method isn't used by insert and replace methods yet.
846 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
847 from the base documentation.