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
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;
$part_pkg = $record->part_pkg;
+ @labels = $record->labels;
+
$error = FS::cust_pkg::order( $custnum, \@pkgparts );
$error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
=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
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!";
}
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<FS::cust_main>).
=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
=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
}
=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;
}
=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;
}
}
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;
}
=cut
sub unsuspend {
- my($self)=@_;
+ my $self = shift;
my($error);
local $SIG{HUP} = '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->unsuspend;
return $error if $error;
}
}
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;
}
=cut
sub part_pkg {
- my($self)=@_;
- qsearchs('part_pkg', { 'pkgpart' => $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<FS::cust_svc>) of this billing item.
+
+=cut
+
+sub labels {
+ my $self = shift;
+ map { [ $_->label ] } qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
}
=back
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;
}
}
=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?
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<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>
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
projects / freeside.git / blobdiff