X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fsvc_Common.pm;h=9cab5b47b2343a3c5e4c77a6fe20ecdf7c866722;hb=dbb388836b7951a3db49deda05a1ff9ba5125c17;hp=6e8a5c38eb6fba2e1ff970c3f1d63be95b79efe6;hpb=8d9080142d35a17e3450e9c607f390d39da69188;p=freeside.git diff --git a/FS/FS/svc_Common.pm b/FS/FS/svc_Common.pm index 6e8a5c38e..9cab5b47b 100644 --- a/FS/FS/svc_Common.pm +++ b/FS/FS/svc_Common.pm @@ -1,16 +1,20 @@ package FS::svc_Common; use strict; -use vars qw( @ISA $noexport_hack $DEBUG ); +use vars qw( @ISA $noexport_hack $DEBUG $me ); +use Carp; use FS::Record qw( qsearch qsearchs fields dbh ); use FS::cust_main_Mixin; use FS::cust_svc; use FS::part_svc; use FS::queue; use FS::cust_main; +use FS::inventory_item; +use FS::inventory_class; @ISA = qw( FS::cust_main_Mixin FS::Record ); +$me = '[FS::svc_Common]'; $DEBUG = 0; =head1 NAME @@ -48,10 +52,13 @@ sub new { #$self->{'Hash'} = shift; my $newhash = shift; $self->{'Hash'} = { map { $_ => $newhash->{$_} } qw(svcnum svcpart) }; - $self->setdefault; + + $self->setdefault( $self->_fieldhandlers ) + unless $self->svcnum; + $self->{'Hash'}{$_} = $newhash->{$_} - foreach #grep length($newhash->{$_}), - keys %$newhash; + foreach grep { defined($newhash->{$_}) && length($newhash->{$_}) } + keys %$newhash; foreach my $field ( grep !defined($self->{'Hash'}{$_}), $self->fields ) { $self->{'Hash'}{$field}=''; @@ -66,6 +73,9 @@ sub new { $self; } +#empty default +sub _fieldhandlers { {}; } + sub virtual_fields { # This restricts the fields based on part_svc_column and the svcpart of @@ -148,13 +158,13 @@ jobnum(s) (they will not run until the specific job(s) complete(s)). sub insert { my $self = shift; my %options = @_; - warn "FS::svc_Common::insert called with options ". - join(', ', map { "$_: $options{$_}" } keys %options ). "\n" - if $DEBUG; + warn "[$me] insert called with options ". + join(', ', map { "$_: $options{$_}" } keys %options ). "\n" + if $DEBUG; my @jobnums = (); local $FS::queue::jobnums = \@jobnums; - warn "FS::svc_Common::insert: set \$FS::queue::jobnums to $FS::queue::jobnums" + warn "[$me] insert: set \$FS::queue::jobnums to $FS::queue::jobnums\n" if $DEBUG; my $objects = $options{'child_objects'} || []; my $depend_jobnums = $options{'depend_jobnum'} || []; @@ -201,6 +211,12 @@ sub insert { $self->svcpart($cust_svc->svcpart); } + $error = $self->set_auto_inventory; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + $error = $self->SUPER::insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -226,7 +242,7 @@ sub insert { #new-style exports! unless ( $noexport_hack ) { - warn "FS::svc_Common::insert: \$FS::queue::jobnums is $FS::queue::jobnums" + warn "[$me] insert: \$FS::queue::jobnums is $FS::queue::jobnums\n" if $DEBUG; foreach my $part_export ( $self->cust_svc->part_svc->part_export ) { @@ -239,11 +255,11 @@ sub insert { } foreach my $depend_jobnum ( @$depend_jobnums ) { - warn "inserting dependancies on supplied job $depend_jobnum\n" + warn "[$me] inserting dependancies on supplied job $depend_jobnum\n" if $DEBUG; foreach my $jobnum ( @jobnums ) { my $queue = qsearchs('queue', { 'jobnum' => $jobnum } ); - warn "inserting dependancy for job $jobnum on $depend_jobnum\n" + warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n" if $DEBUG; my $error = $queue->depend_insert($depend_jobnum); if ( $error ) { @@ -296,7 +312,7 @@ sub delete { #new-style exports! unless ( $noexport_hack ) { foreach my $part_export ( $self->cust_svc->part_svc->part_export ) { - my $error = $part_export->export_delete($self); + $error = $part_export->export_delete($self); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "exporting to ". $part_export->exporttype. @@ -305,11 +321,18 @@ sub delete { } } - return $error if $error; + $error = $self->return_inventory; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error returning inventory: $error"; + } my $cust_svc = $self->cust_svc; $error = $cust_svc->delete; - return $error if $error; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -337,7 +360,27 @@ sub replace { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $error = $new->SUPER::replace($old); + # We absolutely have to have an old vs. new record to make this work. + if ( !defined($old) ) { + warn "[$me] replace called with no arguments; autoloading old record\n" + if $DEBUG; + my $primary_key = $new->dbdef_table->primary_key; + if ( $primary_key ) { + $old = qsearchs($new->table, { $primary_key => $new->$primary_key() } ) + or croak "can't find ". $new->table. ".$primary_key ". + $new->$primary_key(); + } else { + croak $new->table. " has no primary key; pass old record as argument"; + } + } + + my $error = $new->set_auto_inventory; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $error = $new->SUPER::replace($old); if ($error) { $dbh->rollback if $oldAutoCommit; return $error; @@ -408,7 +451,7 @@ to test the return). Usually called by the check method. sub setfixed { my $self = shift; - $self->setx('F'); + $self->setx('F', @_); } =item setdefault @@ -421,20 +464,66 @@ the FS::part_svc object (use ref() to test the return). sub setdefault { my $self = shift; - $self->setx('D'); + $self->setx('D', @_ ); +} + +=item set_default_and_fixed + +=cut + +sub set_default_and_fixed { + my $self = shift; + $self->setx( [ 'D', 'F' ], @_ ); } +=item setx FLAG | FLAG_ARRAYREF , [ CALLBACK_HASHREF ] + +Sets fields according to the passed in flag or arrayref of flags. + +Optionally, a hashref of field names and callback coderefs can be passed. +If a coderef exists for a given field name, instead of setting the field, +the coderef is called with the column value (part_svc_column.columnvalue) +as the single parameter. + +=cut + sub setx { my $self = shift; my $x = shift; + my @x = ref($x) ? @$x : ($x); + my $coderef = scalar(@_) ? shift : $self->_fieldhandlers; - my $error; - - $error = + my $error = $self->ut_numbern('svcnum') ; return $error if $error; + my $part_svc = $self->part_svc; + return "Unkonwn svcpart" unless $part_svc; + + #set default/fixed/whatever fields from part_svc + + foreach my $part_svc_column ( + grep { my $f = $_->columnflag; grep { $f eq $_ } @x } #columnflag in @x + $part_svc->all_part_svc_column + ) { + + my $columnname = $part_svc_column->columnname; + my $columnvalue = $part_svc_column->columnvalue; + + $columnvalue = &{ $coderef->{$columnname} }( $self, $columnvalue ) + if exists( $coderef->{$columnname} ); + $self->setfield( $columnname, $columnvalue ); + + } + + $part_svc; + +} + +sub part_svc { + my $self = shift; + #get part_svc my $svcpart; if ( $self->get('svcpart') ) { @@ -444,20 +533,129 @@ sub setx { return "Unknown svcnum" unless $cust_svc; $svcpart = $cust_svc->svcpart; } - my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $svcpart } ); + + qsearchs( 'part_svc', { 'svcpart' => $svcpart } ); + +} + +=item set_auto_inventory + +Sets any fields which auto-populate from inventory (see L). +If there is an error, returns the error, otherwise returns false. + +=cut + +sub set_auto_inventory { + my $self = shift; + + my $error = + $self->ut_numbern('svcnum') + ; + return $error if $error; + + my $part_svc = $self->part_svc; return "Unkonwn svcpart" unless $part_svc; + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + #set default/fixed/whatever fields from part_svc my $table = $self->table; foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) { my $part_svc_column = $part_svc->part_svc_column($field); - if ( $part_svc_column->columnflag eq $x ) { - $self->setfield( $field, $part_svc_column->columnvalue ); + if ( $part_svc_column->columnflag eq 'A' && $self->$field() eq '' ) { + + my $classnum = $part_svc_column->columnvalue; + my $inventory_item = qsearchs({ + 'table' => 'inventory_item', + 'hashref' => { 'classnum' => $classnum, + 'svcnum' => '', + }, + 'extra_sql' => 'LIMIT 1 FOR UPDATE', + }); + + unless ( $inventory_item ) { + $dbh->rollback if $oldAutoCommit; + my $inventory_class = + qsearchs('inventory_class', { 'classnum' => $classnum } ); + return "Can't find inventory_class.classnum $classnum" + unless $inventory_class; + return "Out of ". $inventory_class->classname. "s\n"; #Lingua:: BS + #for pluralizing + } + + $inventory_item->svcnum( $self->svcnum ); + my $ierror = $inventory_item->replace(); + if ( $ierror ) { + $dbh->rollback if $oldAutoCommit; + return "Error provisioning inventory: $ierror"; + + } + + $self->setfield( $field, $inventory_item->item ); + } } - $part_svc; + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; + +} + +=item return_inventory +=cut + +sub return_inventory { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + foreach my $inventory_item ( $self->inventory_item ) { + $inventory_item->svcnum(''); + my $error = $inventory_item->replace(); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error returning inventory: $error"; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; +} + +=item inventory_item + +Returns the inventory items associated with this svc_ record, as +FS::inventory_item objects (see L. + +=cut + +sub inventory_item { + my $self = shift; + qsearch({ + 'table' => 'inventory_item', + 'hashref' => { 'svcnum' => $self->svcnum, }, + }); } =item cust_svc