X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=19e1da356209cb2c944328588ef8db5208622d1a;hp=08be4e4e05fc5b48e34e6c1079b077a705834114;hb=fd72d2af8120195f96826eb044e217dbfcaee1c7;hpb=5bd5f206a77cf975515d955119d4dff7764a2d8c

diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index 08be4e4e0..19e1da356 100644
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -2,7 +2,7 @@ package FS::cust_pkg;
 
 use strict;
 use vars qw(@ISA);
-use FS::UID qw( getotaker );
+use FS::UID qw( getotaker dbh );
 use FS::Record qw( qsearch qsearchs );
 use FS::cust_svc;
 use FS::part_pkg;
@@ -20,6 +20,27 @@ use FS::svc_www;
 
 @ISA = qw( FS::Record );
 
+sub _cache {
+  my $self = shift;
+  my ( $hashref, $cache ) = @_;
+  #if ( $hashref->{'pkgpart'} ) {
+  if ( $hashref->{'pkg'} ) {
+    # #@{ $self->{'_pkgnum'} } = ();
+    # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
+    # $self->{'_pkgpart'} = $subcache;
+    # #push @{ $self->{'_pkgnum'} },
+    #   FS::part_pkg->new_or_cached($hashref, $subcache);
+    $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
+  }
+  if ( exists $hashref->{'svcnum'} ) {
+    #@{ $self->{'_pkgnum'} } = ();
+    my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
+    $self->{'_svcnum'} = $subcache;
+    #push @{ $self->{'_pkgnum'} },
+    FS::cust_svc->new_or_cached($hashref, $subcache) if $hashref->{svcnum};
+  }
+}
+
 =head1 NAME
 
 FS::cust_pkg - Object methods for cust_pkg objects
@@ -77,6 +98,9 @@ inherits from FS::Record.  The following fields are currently supported:
 
 =item otaker - order taker (assigned automatically if null, see L<FS::UID>)
 
+=item manual_flag - If this field is set to 1, disables the automatic
+unsuspensiond of this package when using the B<unsuspendauto> config file.
+
 =back
 
 Note: setup, bill, susp, expire and cancel are specified as UNIX timestamps;
@@ -100,17 +124,19 @@ sub table { 'cust_pkg'; }
 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 = shift;
 
   # custnum might not have have been defined in sub check (for one-shot new
   # customers), so check it here instead
+  # (is this still necessary with transactions?)
 
   my $error = $self->ut_number('custnum');
-  return $error if $error
+  return $error if $error;
 
-  return "Unknown customer"
-    unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
+  return "Unknown customer ". $self->custnum unless $self->cust_main;
 
   $self->SUPER::insert;
 
@@ -118,15 +144,16 @@ sub insert {
 
 =item delete
 
-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.
+This method now works but you probably shouldn't use it.
+
+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!";
-}
+#sub delete {
+#  return "Can't delete cust_pkg records!";
+#}
 
 =item replace OLD_RECORD
 
@@ -152,9 +179,12 @@ sub replace {
 
   #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');
+
+  #allow this *sigh*
+  #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->SUPER::replace($old);
@@ -183,8 +213,7 @@ sub check {
   return $error if $error;
 
   if ( $self->custnum ) { 
-    return "Unknown customer"
-      unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
+    return "Unknown customer ". $self->custnum unless $self->cust_main;
   }
 
   return "Unknown pkgpart"
@@ -194,6 +223,11 @@ sub check {
   $self->otaker =~ /^(\w{0,16})$/ or return "Illegal otaker";
   $self->otaker($1);
 
+  if ( $self->dbdef_table->column('manual_flag') ) {
+    $self->manual_flag =~ /^([01]?)$/ or return "Illegal manual_flag";
+    $self->manual_flag($1);
+  }
+
   ''; #no error
 }
 
@@ -218,26 +252,41 @@ sub cancel {
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{PIPE} = 'IGNORE';
 
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
   foreach my $cust_svc (
     qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
   ) {
     my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
 
-    $part_svc->svcdb =~ /^([\w\-]+)$/
-      or return "Illegal svcdb value in part_svc!";
+    $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
+      $dbh->rollback if $oldAutoCommit;
+      return "Illegal svcdb value in part_svc!";
+    };
     my $svcdb = $1;
     require "FS/$svcdb.pm";
 
     my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
     if ($svc) {
       $error = $svc->cancel;
-      return "Error cancelling service: $error" if $error;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "Error cancelling service: $error" 
+      }
       $error = $svc->delete;
-      return "Error deleting service: $error" if $error;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "Error deleting service: $error";
+      }
     }
 
     $error = $cust_svc->delete;
-    return "Error deleting cust_svc: $error" if $error;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "Error deleting cust_svc: $error";
+    }
 
   }
 
@@ -246,9 +295,14 @@ sub cancel {
     $hash{'cancel'} = time;
     my $new = new FS::cust_pkg ( \%hash );
     $error = $new->replace($self);
-    return $error if $error;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
   }
 
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
   ''; #no errors
 }
 
@@ -272,20 +326,29 @@ sub suspend {
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{PIPE} = 'IGNORE';
 
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
   foreach my $cust_svc (
     qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
   ) {
     my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
 
-    $part_svc->svcdb =~ /^([\w\-]+)$/
-      or return "Illegal svcdb value in part_svc!";
+    $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
+      $dbh->rollback if $oldAutoCommit;
+      return "Illegal svcdb value in part_svc!";
+    };
     my $svcdb = $1;
     require "FS/$svcdb.pm";
 
     my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
     if ($svc) {
       $error = $svc->suspend;
-      return $error if $error;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return $error;
+      }
     }
 
   }
@@ -295,9 +358,14 @@ sub suspend {
     $hash{'susp'} = time;
     my $new = new FS::cust_pkg ( \%hash );
     $error = $new->replace($self);
-    return $error if $error;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
   }
 
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
   ''; #no errors
 }
 
@@ -321,20 +389,29 @@ sub unsuspend {
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{PIPE} = 'IGNORE';
 
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
   foreach my $cust_svc (
     qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
   ) {
     my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
 
-    $part_svc->svcdb =~ /^([\w\-]+)$/
-      or return "Illegal svcdb value in part_svc!";
+    $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
+      $dbh->rollback if $oldAutoCommit;
+      return "Illegal svcdb value in part_svc!";
+    };
     my $svcdb = $1;
     require "FS/$svcdb.pm";
 
     my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
     if ($svc) {
       $error = $svc->unsuspend;
-      return $error if $error;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return $error;
+      }
     }
 
   }
@@ -344,9 +421,14 @@ sub unsuspend {
     $hash{'susp'} = '';
     my $new = new FS::cust_pkg ( \%hash );
     $error = $new->replace($self);
-    return $error if $error;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
   }
 
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
   ''; #no errors
 }
 
@@ -359,7 +441,26 @@ L<FS::part_pkg>).
 
 sub part_pkg {
   my $self = shift;
-  qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
+  #exists( $self->{'_pkgpart'} )
+  $self->{'_pkgpart'}
+    ? $self->{'_pkgpart'}
+    : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
+}
+
+=item cust_svc
+
+Returns the services for this package, as FS::cust_svc objects (see
+L<FS::cust_svc>)
+
+=cut
+
+sub cust_svc {
+  my $self = shift;
+  if ( $self->{'_svcnum'} ) {
+    values %{ $self->{'_svcnum'}->cache };
+  } else {
+    qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
+  }
 }
 
 =item labels
@@ -371,7 +472,18 @@ Returns a list of lists, calling the label method for all services
 
 sub labels {
   my $self = shift;
-  map { [ $_->label ] } qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
+  map { [ $_->label ] } $self->cust_svc;
+}
+
+=item cust_main
+
+Returns the parent customer object (see L<FS::cust_main>).
+
+=cut
+
+sub cust_main {
+  my $self = shift;
+  qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 }
 
 =back
@@ -380,7 +492,7 @@ sub labels {
 
 =over 4
 
-=item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF ]
+=item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ] ]
 
 CUSTNUM is a customer (see L<FS::cust_main>)
 
@@ -391,12 +503,21 @@ permitted.
 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
 remove for this customer.  The services (see L<FS::cust_svc>) are moved to the
 new billing items.  An error is returned if this is not possible (see
-L<FS::pkg_svc>).
+L<FS::pkg_svc>).  An empty arrayref is equivalent to not specifying this
+parameter.
+
+RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
+newly-created cust_pkg objects.
 
 =cut
 
 sub order {
-  my($custnum,$pkgparts,$remove_pkgnums)=@_;
+  my($custnum, $pkgparts, $remove_pkgnums, $return_cust_pkg) = @_;
+  $remove_pkgnums = [] unless defined($remove_pkgnums);
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
 
   # generate %part_pkg
   # $part_pkg{$pkgpart} is true iff $custnum may purchase $pkgpart
@@ -425,8 +546,10 @@ sub order {
   # @cust_svc is a corresponding list of lists of FS::Record objects
   my($pkgpart);
   foreach $pkgpart ( @{$pkgparts} ) {
-    return "Customer not permitted to purchase pkgpart $pkgpart!"
-      unless $part_pkg{$pkgpart};
+    unless ( $part_pkg{$pkgpart} ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "Customer not permitted to purchase pkgpart $pkgpart!";
+    }
     push @cust_svc, [
       map {
         ( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : ();
@@ -437,6 +560,7 @@ sub order {
   #check for leftover services
   foreach (keys %svcnum) {
     next unless @{ $svcnum{$_} };
+    $dbh->rollback if $oldAutoCommit;
     return "Leftover services, svcpart $_: svcnum ".
            join(', ', map { $_->svcnum } @{ $svcnum{$_} } );
   }
@@ -454,36 +578,50 @@ sub order {
 #  my($pkgnum);
   foreach $pkgnum ( @{$remove_pkgnums} ) {
     my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-    die "Package $pkgnum not found to remove!" unless $old;
+    unless ( $old ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "Package $pkgnum not found to remove!";
+    }
     my(%hash) = $old->hash;
     $hash{'cancel'}=time;   
     my($new) = new FS::cust_pkg ( \%hash );
     my($error)=$new->replace($old);
-    die "Couldn't update package $pkgnum: $error" if $error;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "Couldn't update package $pkgnum: $error";
+    }
   }
 
   #now add new packages, changing cust_svc records if necessary
 #  my($pkgpart);
   while ($pkgpart=shift @{$pkgparts} ) {
  
-    my($new) = new FS::cust_pkg ( {
-                                       'custnum' => $custnum,
-                                       'pkgpart' => $pkgpart,
-                                    } );
-    my($error) = $new->insert;
-    die "Couldn't insert new cust_pkg record: $error" if $error; 
-    my($pkgnum)=$new->getfield('pkgnum');
+    my $new = new FS::cust_pkg {
+                                 'custnum' => $custnum,
+                                 'pkgpart' => $pkgpart,
+                               };
+    my $error = $new->insert;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "Couldn't insert new cust_pkg record: $error";
+    }
+    push @{$return_cust_pkg}, $new if $return_cust_pkg;
+    my $pkgnum = $new->pkgnum;
  
-    my($cust_svc);
-    foreach $cust_svc ( @{ shift @cust_svc } ) {
+    foreach my $cust_svc ( @{ shift @cust_svc } ) {
       my(%hash) = $cust_svc->hash;
       $hash{'pkgnum'}=$pkgnum;
       my($new) = new FS::cust_svc ( \%hash );
       my($error)=$new->replace($cust_svc);
-      die "Couldn't link old service to new package: $error" if $error;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "Couldn't link old service to new package: $error";
+      }
     }
   }  
 
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
   ''; #no errors
 }
 
@@ -491,7 +629,7 @@ sub order {
 
 =head1 VERSION
 
-$Id: cust_pkg.pm,v 1.4 2000-02-03 05:16:52 ivan Exp $
+$Id: cust_pkg.pm,v 1.13 2001-11-03 17:49:52 ivan Exp $
 
 =head1 BUGS
 
@@ -508,10 +646,13 @@ 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.
 
+Now that things are transactional should the check in the insert method be
+moved to check ?
+
 =head1 SEE ALSO
 
-L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>
-, L<FS::pkg_svc>, schema.html from the base documentation
+L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
+L<FS::pkg_svc>, schema.html from the base documentation
 
 =cut