allow empty custnum in sub check (but call that an error in sub insert),

[freeside.git] / site_perl / cust_pkg.pm

diff --git a/site_perl/cust_pkg.pm b/site_perl/cust_pkg.pm
index 249e1b7..31b4524 100644 (file)
--- 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 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_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
 
 
 =head1 NAME
 


@@ -18,8 +25,8 @@ FS::cust_pkg - Object methods for cust_pkg objects
 
   use FS::cust_pkg;
 
 
   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;
 
 
   $error = $record->insert;
 


@@ -37,6 +44,8 @@ FS::cust_pkg - Object methods for cust_pkg objects
 
   $part_pkg = $record->part_pkg;
 
 
   $part_pkg = $record->part_pkg;
 

+  @labels = $record->labels;
+

   $error = FS::cust_pkg::order( $custnum, \@pkgparts );
   $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
 
   $error = FS::cust_pkg::order( $custnum, \@pkgparts );
   $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
 


@@ -75,36 +84,33 @@ conversion functions.
 
 =over 4
 
 
 =over 4
 

-=item create HASHREF
+=item new HASHREF

 
 Create a new billing item.  To add the item to the database, see L<"insert">.
 
 =cut
 
 
 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.
 
 
 =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 {
 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
 }
 
 =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.
 
 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!";
 }
 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.
 
 
 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>).
 
 setup and bill are normally updated by calling the bill method of a customer
 object (see L<FS::cust_main>).


@@ -137,21 +145,16 @@ in some cases).
 =cut
 
 sub replace {
 =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?
 
   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
 }
 
 =item check


@@ -163,38 +166,30 @@ replace methods.
 =cut
 
 sub 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"
   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
 }
 
   ''; #no error
 }


@@ -210,47 +205,44 @@ If there is an error, returns the error, otherwise returns false.
 =cut
 
 sub cancel {
 =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{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!";
       or return "Illegal svcdb value in part_svc!";

-    my($svcdb) = $1;
+    my $svcdb = $1;

     require "FS/$svcdb.pm";
 
     require "FS/$svcdb.pm";
 

-    my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->svcnum } );
+    my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );

     if ($svc) {
     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;
     }
 
       $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') ) {
     $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;
   }
 
     return $error if $error;
   }
 


@@ -267,30 +259,28 @@ If there is an error, returns the error, otherwise returns false.
 =cut
 
 sub suspend {
 =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{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!";
       or return "Illegal svcdb value in part_svc!";

-    my($svcdb) = $1;
+    my $svcdb = $1;

     require "FS/$svcdb.pm";
 
     require "FS/$svcdb.pm";
 

-    my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->getfield('svcnum') } );
-
+    my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );

     if ($svc) {
     if ($svc) {

-      bless($svc,"FS::$svcdb");

       $error = $svc->suspend;
       return $error if $error;
     }
       $error = $svc->suspend;
       return $error if $error;
     }


@@ -298,10 +288,10 @@ sub suspend {
   }
 
   unless ( $self->getfield('susp') ) {
   }
 
   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;
   }
 
     return $error if $error;
   }
 


@@ -318,7 +308,7 @@ If there is an error, returns the error, otherwise returns false.
 =cut
 
 sub unsuspend {
 =cut
 
 sub unsuspend {

-  my($self)=@_;
+  my $self = shift;

   my($error);
 
   local $SIG{HUP} = 'IGNORE';
   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{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!";
       or return "Illegal svcdb value in part_svc!";

-    my($svcdb) = $1;
+    my $svcdb = $1;

     require "FS/$svcdb.pm";
 
     require "FS/$svcdb.pm";
 

-    my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->getfield('svcnum') } );
+    my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );

     if ($svc) {
     if ($svc) {

-      bless($svc,"FS::$svcdb");

       $error = $svc->unsuspend;
       return $error if $error;
     }
       $error = $svc->unsuspend;
       return $error if $error;
     }


@@ -349,10 +337,10 @@ sub unsuspend {
   }
 
   unless ( ! $self->getfield('susp') ) {
   }
 
   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;
   }
 
     return $error if $error;
   }
 


@@ -367,8 +355,20 @@ L<FS::part_pkg).
 =cut
 
 sub part_pkg {
 =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
 }
 
 =back


@@ -452,38 +452,39 @@ sub order {
   local $SIG{QUIT} = 'IGNORE';
   local $SIG{TERM} = 'IGNORE';
   local $SIG{TSTP} = 'IGNORE'; 
   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});
 
   #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;
     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);
     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} ) {
  
   }
 
   #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;
                                        '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($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);
       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
 
 
 =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?
 
 
 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.
 
 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>
 =head1 SEE ALSO
 
 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>


@@ -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 $
 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
 
 
 added label method