X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=site_perl%2Fcust_pkg.pm;h=31b4524f201791200d200b7af0d77a8c9f58d370;hp=249e1b77cac1ac93fd32321b41fe65358f368f2b;hb=de46aa575f3e726a9b005172706cff5e542955fd;hpb=150fc6e8f81825c8db41267e1a990eb93ab33955 diff --git a/site_perl/cust_pkg.pm b/site_perl/cust_pkg.pm index 249e1b77c..31b4524f2 100644 --- a/site_perl/cust_pkg.pm +++ b/site_perl/cust_pkg.pm @@ -2,13 +2,20 @@ package FS::cust_pkg; use strict; use vars qw(@ISA); -use Exporter; -use FS::UID qw(getotaker); -use FS::Record qw(fields qsearch qsearchs); +use FS::UID qw( getotaker ); +use FS::Record qw( qsearch qsearchs ); use FS::cust_svc; use FS::part_pkg; +use FS::cust_main; -@ISA = qw(FS::Record Exporter); +# need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend, +# setup } +# because they load configuraion by setting FS::UID::callback (see TODO) +use FS::svc_acct; +use FS::svc_acct_sm; +use FS::svc_domain; + +@ISA = qw( FS::Record ); =head1 NAME @@ -18,8 +25,8 @@ FS::cust_pkg - Object methods for cust_pkg objects use FS::cust_pkg; - $record = create FS::cust_pkg \%hash; - $record = create FS::cust_pkg { 'column' => 'value' }; + $record = new FS::cust_pkg \%hash; + $record = new FS::cust_pkg { 'column' => 'value' }; $error = $record->insert; @@ -37,6 +44,8 @@ FS::cust_pkg - Object methods for cust_pkg objects $part_pkg = $record->part_pkg; + @labels = $record->labels; + $error = FS::cust_pkg::order( $custnum, \@pkgparts ); $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] ); @@ -75,36 +84,33 @@ conversion functions. =over 4 -=item create HASHREF +=item new HASHREF Create a new billing item. To add the item to the database, see L<"insert">. =cut -sub create { - my($proto,$hashref)=@_; - - #now in FS::Record::new - #my($field); - #foreach $field (fields('cust_pkg')) { - # $hashref->{$field}='' unless defined $hashref->{$field}; - #} - - $proto->new('cust_pkg',$hashref); -} +sub table { 'cust_pkg'; } =item insert Adds this billing item to the database ("Orders" the item). If there is an error, returns the error, otherwise returns false. -=cut - sub insert { - my($self)=@_; + my $self = shift; + + # custnum might not have have been defined in sub check (for one-shot new + # customers), so check it here instead + + my $error = $self->ut_number('custnum'); + return $error if $error + + return "Unknown customer" + unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); + + $self->SUPER::insert; - $self->check or - $self->add; } =item delete @@ -113,6 +119,8 @@ Currently unimplemented. You don't want to delete billing items, because there would then be no record the customer ever purchased the item. Instead, see the cancel method. +=cut + sub delete { return "Can't delete cust_pkg records!"; } @@ -124,7 +132,7 @@ returns the error, otherwise returns false. Currently, custnum, setup, bill, susp, expire, and cancel may be changed. -pkgpart may not be changed, but see the order subroutine. +Changing pkgpart may have disasterous effects. See the order subroutine. setup and bill are normally updated by calling the bill method of a customer object (see L). @@ -137,21 +145,16 @@ in some cases). =cut sub replace { - my($new,$old)=@_; - return "(Old) Not a cust_pkg record!" if $old->table ne "cust_pkg"; - return "Can't change pkgnum!" - if $old->getfield('pkgnum') ne $new->getfield('pkgnum'); - return "Can't (yet?) change pkgpart!" - if $old->getfield('pkgpart') ne $new->getfield('pkgpart'); - return "Can't change otaker!" - if $old->getfield('otaker') ne $new->getfield('otaker'); + my( $new, $old ) = ( shift, shift ); + + #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart; + return "Can't change otaker!" if $old->otaker ne $new->otaker; return "Can't change setup once it exists!" if $old->getfield('setup') && $old->getfield('setup') != $new->getfield('setup'); #some logic for bill, susp, cancel? - $new->check or - $new->rep($old); + $new->SUPER::replace($old); } =item check @@ -163,38 +166,30 @@ replace methods. =cut sub check { - my($self)=@_; - return "Not a cust_pkg record!" if $self->table ne "cust_pkg"; - my($recref) = $self->hashref; - - $recref->{pkgnum} =~ /^(\d*)$/ or return "Illegal pkgnum"; - $recref->{pkgnum}=$1; - - $recref->{custnum} =~ /^(\d+)$/ or return "Illegal custnum"; - $recref->{custnum}=$1; - return "Unknown customer" - unless qsearchs('cust_main',{'custnum'=>$recref->{custnum}}); + my $self = shift; + + my $error = + $self->ut_numbern('pkgnum') + || $self->ut_numbern('custnum') + || $self->ut_number('pkgpart') + || $self->ut_numbern('setup') + || $self->ut_numbern('bill') + || $self->ut_numbern('susp') + || $self->ut_numbern('cancel') + ; + return $error if $error; + + if ( $self->custnum ) { + return "Unknown customer" + unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); + } - $recref->{pkgpart} =~ /^(\d+)$/ or return "Illegal pkgpart"; - $recref->{pkgpart}=$1; return "Unknown pkgpart" - unless qsearchs('part_pkg',{'pkgpart'=>$recref->{pkgpart}}); - - $recref->{otaker} ||= &getotaker; - $recref->{otaker} =~ /^(\w{0,8})$/ or return "Illegal otaker"; - $recref->{otaker}=$1; - - $recref->{setup} =~ /^(\d*)$/ or return "Illegal setup date"; - $recref->{setup}=$1; + unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); - $recref->{bill} =~ /^(\d*)$/ or return "Illegal bill date"; - $recref->{bill}=$1; - - $recref->{susp} =~ /^(\d*)$/ or return "Illegal susp date"; - $recref->{susp}=$1; - - $recref->{cancel} =~ /^(\d*)$/ or return "Illegal cancel date"; - $recref->{cancel}=$1; + $self->otaker(getotaker) unless $self->otaker; + $self->otaker =~ /^(\w{0,16})$/ or return "Illegal otaker"; + $self->otaker($1); ''; #no error } @@ -210,47 +205,44 @@ If there is an error, returns the error, otherwise returns false. =cut sub cancel { - my($self)=@_; - my($error); + my $self = shift; + my $error; 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($cust_svc); - foreach $cust_svc ( - qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } ) + foreach my $cust_svc ( + qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ) { - my($part_svc)= - qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } ); + my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } ); - $part_svc->getfield('svcdb') =~ /^([\w\-]+)$/ + $part_svc->svcdb =~ /^([\w\-]+)$/ or return "Illegal svcdb value in part_svc!"; - my($svcdb) = $1; + my $svcdb = $1; require "FS/$svcdb.pm"; - my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->svcnum } ); + my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } ); if ($svc) { - bless($svc,"FS::$svcdb"); $error = $svc->cancel; return "Error cancelling service: $error" if $error; $error = $svc->delete; return "Error deleting service: $error" if $error; } - bless($cust_svc,"FS::cust_svc"); $error = $cust_svc->delete; return "Error deleting cust_svc: $error" if $error; } unless ( $self->getfield('cancel') ) { - my(%hash) = $self->hash; - $hash{'cancel'}=$^T; - my($new) = create FS::cust_pkg ( \%hash ); - $error=$new->replace($self); + my %hash = $self->hash; + $hash{'cancel'} = time; + my $new = new FS::cust_pkg ( \%hash ); + $error = $new->replace($self); return $error if $error; } @@ -267,30 +259,28 @@ If there is an error, returns the error, otherwise returns false. =cut sub suspend { - my($self)=@_; - my($error); + my $self = shift; + my $error ; + 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($cust_svc); - foreach $cust_svc ( - qsearch('cust_svc',{'pkgnum'=> $self->getfield('pkgnum') } ) + foreach my $cust_svc ( + qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ) { - my($part_svc)= - qsearchs('part_svc',{'svcpart'=> $cust_svc->getfield('svcpart') } ); + my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } ); - $part_svc->getfield('svcdb') =~ /^([\w\-]+)$/ + $part_svc->svcdb =~ /^([\w\-]+)$/ or return "Illegal svcdb value in part_svc!"; - my($svcdb) = $1; + my $svcdb = $1; require "FS/$svcdb.pm"; - my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->getfield('svcnum') } ); - + my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } ); if ($svc) { - bless($svc,"FS::$svcdb"); $error = $svc->suspend; return $error if $error; } @@ -298,10 +288,10 @@ sub suspend { } unless ( $self->getfield('susp') ) { - my(%hash) = $self->hash; - $hash{'susp'}=$^T; - my($new) = create FS::cust_pkg ( \%hash ); - $error=$new->replace($self); + my %hash = $self->hash; + $hash{'susp'} = time; + my $new = new FS::cust_pkg ( \%hash ); + $error = $new->replace($self); return $error if $error; } @@ -318,7 +308,7 @@ If there is an error, returns the error, otherwise returns false. =cut sub unsuspend { - my($self)=@_; + my $self = shift; my($error); local $SIG{HUP} = 'IGNORE'; @@ -326,22 +316,20 @@ sub unsuspend { local $SIG{QUIT} = 'IGNORE'; local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; - my($cust_svc); - foreach $cust_svc ( - qsearch('cust_svc',{'pkgnum'=> $self->getfield('pkgnum') } ) + foreach my $cust_svc ( + qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } ) ) { - my($part_svc)= - qsearchs('part_svc',{'svcpart'=> $cust_svc->getfield('svcpart') } ); + my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } ); - $part_svc->getfield('svcdb') =~ /^([\w\-]+)$/ + $part_svc->svcdb =~ /^([\w\-]+)$/ or return "Illegal svcdb value in part_svc!"; - my($svcdb) = $1; + my $svcdb = $1; require "FS/$svcdb.pm"; - my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->getfield('svcnum') } ); + my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } ); if ($svc) { - bless($svc,"FS::$svcdb"); $error = $svc->unsuspend; return $error if $error; } @@ -349,10 +337,10 @@ sub unsuspend { } unless ( ! $self->getfield('susp') ) { - my(%hash) = $self->hash; - $hash{'susp'}=''; - my($new) = create FS::cust_pkg ( \%hash ); - $error=$new->replace($self); + my %hash = $self->hash; + $hash{'susp'} = ''; + my $new = new FS::cust_pkg ( \%hash ); + $error = $new->replace($self); return $error if $error; } @@ -367,8 +355,20 @@ L $self->pkgpart }); + my $self = shift; + qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); +} + +=item labels + +Returns a list of lists, calling the label method for all services +(see L) of this billing item. + +=cut + +sub labels { + my $self = shift; + map { [ $_->label ] } qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } ); } =back @@ -452,38 +452,39 @@ sub order { local $SIG{QUIT} = 'IGNORE'; local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; #first cancel old packages # my($pkgnum); foreach $pkgnum ( @{$remove_pkgnums} ) { my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); - return "Package $pkgnum not found to remove!" unless $old; + die "Package $pkgnum not found to remove!" unless $old; my(%hash) = $old->hash; - $hash{'cancel'}=$^T; - my($new) = create FS::cust_pkg ( \%hash ); + $hash{'cancel'}=time; + my($new) = new FS::cust_pkg ( \%hash ); my($error)=$new->replace($old); - return $error if $error; + die "Couldn't update package $pkgnum: $error" if $error; } #now add new packages, changing cust_svc records if necessary # my($pkgpart); while ($pkgpart=shift @{$pkgparts} ) { - my($new) = create FS::cust_pkg ( { + my($new) = new FS::cust_pkg ( { 'custnum' => $custnum, 'pkgpart' => $pkgpart, } ); my($error) = $new->insert; - return $error if $error; + die "Couldn't insert new cust_pkg record: $error" if $error; my($pkgnum)=$new->getfield('pkgnum'); my($cust_svc); foreach $cust_svc ( @{ shift @cust_svc } ) { my(%hash) = $cust_svc->hash; $hash{'pkgnum'}=$pkgnum; - my($new) = create FS::cust_svc ( \%hash ); + my($new) = new FS::cust_svc ( \%hash ); my($error)=$new->replace($cust_svc); - return $error if $error; + die "Couldn't link old service to new package: $error" if $error; } } @@ -492,9 +493,11 @@ sub order { =back -=head1 BUGS +=head1 VERSION + +$Id: cust_pkg.pm,v 1.8 1999-03-25 13:48:14 ivan Exp $ -It doesn't properly override FS::Record yet. +=head1 BUGS sub order is not OO. Perhaps it should be moved to FS::cust_main and made so? @@ -503,6 +506,12 @@ In sub order, the @pkgparts array (passed by reference) is clobbered. Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard method to pass dates to the recur_prog expression, it should do so. +FS::svc_acct, FS::svc_acct_sm, and FS::svc_domain are loaded via 'use' at +compile time, rather than via 'require' in sub { setup, suspend, unsuspend, +cancel } because they use %FS::UID::callback to load configuration values. +Probably need a subroutine which decides what to do based on whether or not +we've fetched the user yet, rather than a hash. See FS::UID and the TODO. + =head1 SEE ALSO L, L, L, L @@ -517,7 +526,27 @@ fixed for new agent->agent_type->type_pkgs in &order ivan@sisd.com 98-mar-7 pod ivan@sisd.com 98-sep-21 $Log: cust_pkg.pm,v $ -Revision 1.2 1998-11-12 03:42:45 ivan +Revision 1.8 1999-03-25 13:48:14 ivan +allow empty custnum in sub check (but call that an error in sub insert), +for one-screen new customer entry + +Revision 1.7 1999/02/09 09:55:06 ivan +invoices show line items for each service in a package (see the label method +of FS::cust_svc) + +Revision 1.6 1999/01/25 12:26:12 ivan +yet more mod_perl stuff + +Revision 1.5 1999/01/18 21:58:07 ivan +esthetic: eq and ne were used in a few places instead of == and != + +Revision 1.4 1998/12/29 11:59:45 ivan +mostly properly OO, some work still to be done with svc_ stuff + +Revision 1.3 1998/11/15 13:01:35 ivan +allow pkgpart changing (for per-customer custom pricing). warn about it in doc + +Revision 1.2 1998/11/12 03:42:45 ivan added label method