projects / freeside.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
date editing
[freeside.git] / FS / FS / cust_pkg.pm
diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index 2de664b..069ac8c 100644 (file)
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -2,12 +2,13 @@ package FS::cust_pkg;
 
 use strict;
 use vars qw(@ISA);
 
 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;
 use FS::cust_main;
 use FS::type_pkgs;
 use FS::Record qw( qsearch qsearchs );
 use FS::cust_svc;
 use FS::part_pkg;
 use FS::cust_main;
 use FS::type_pkgs;
+use FS::pkg_svc;
 
 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
 # setup }
 
 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
 # setup }
@@ -15,6 +16,7 @@ use FS::type_pkgs;
 use FS::svc_acct;
 use FS::svc_acct_sm;
 use FS::svc_domain;
 use FS::svc_acct;
 use FS::svc_acct_sm;
 use FS::svc_domain;
+use FS::svc_www;
 
 @ISA = qw( FS::Record );
 
 
 @ISA = qw( FS::Record );
 
@@ -75,6 +77,9 @@ inherits from FS::Record.  The following fields are currently supported:
 
 =item otaker - order taker (assigned automatically if null, see L<FS::UID>)
 
 
 =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;
 =back
 
 Note: setup, bill, susp, expire and cancel are specified as UNIX timestamps;
@@ -98,17 +103,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.
 
 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
 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');
 
   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;
 
 
   $self->SUPER::insert;
 
@@ -150,9 +157,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 (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);
   #some logic for bill, susp, cancel?
 
   $new->SUPER::replace($old);
@@ -181,8 +191,7 @@ sub check {
   return $error if $error;
 
   if ( $self->custnum ) { 
   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"
   }
 
   return "Unknown pkgpart"
@@ -192,6 +201,11 @@ sub check {
   $self->otaker =~ /^(\w{0,16})$/ or return "Illegal otaker";
   $self->otaker($1);
 
   $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
 }
 
   ''; #no error
 }
 
@@ -216,26 +230,41 @@ sub cancel {
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{PIPE} = 'IGNORE';
 
   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 } );
 
   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;
     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;
       $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;
     }
 
     $error = $cust_svc->delete;
-    return "Error deleting cust_svc: $error" if $error;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "Error deleting cust_svc: $error";
+    }
 
   }
 
 
   }
 
@@ -244,9 +273,14 @@ sub cancel {
     $hash{'cancel'} = time;
     my $new = new FS::cust_pkg ( \%hash );
     $error = $new->replace($self);
     $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
 }
 
   ''; #no errors
 }
 
@@ -270,20 +304,29 @@ sub suspend {
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{PIPE} = 'IGNORE';
 
   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 } );
 
   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;
     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;
+      }
     }
 
   }
     }
 
   }
@@ -293,9 +336,14 @@ sub suspend {
     $hash{'susp'} = time;
     my $new = new FS::cust_pkg ( \%hash );
     $error = $new->replace($self);
     $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
 }
 
   ''; #no errors
 }
 
@@ -319,20 +367,29 @@ sub unsuspend {
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{PIPE} = 'IGNORE';
 
   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 } );
 
   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;
     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;
+      }
     }
 
   }
     }
 
   }
@@ -342,9 +399,14 @@ sub unsuspend {
     $hash{'susp'} = '';
     my $new = new FS::cust_pkg ( \%hash );
     $error = $new->replace($self);
     $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
 }
 
   ''; #no errors
 }
 
@@ -372,13 +434,24 @@ sub labels {
   map { [ $_->label ] } qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
 }
 
   map { [ $_->label ] } qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
 }
 
+=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
 
 =head1 SUBROUTINES
 
 =over 4
 
 =back
 
 =head1 SUBROUTINES
 
 =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>)
 
 
 CUSTNUM is a customer (see L<FS::cust_main>)
 
@@ -389,12 +462,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
 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 {
 
 =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
 
   # generate %part_pkg
   # $part_pkg{$pkgpart} is true iff $custnum may purchase $pkgpart
@@ -423,21 +505,23 @@ sub order {
   # @cust_svc is a corresponding list of lists of FS::Record objects
   my($pkgpart);
   foreach $pkgpart ( @{$pkgparts} ) {
   # @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{$_} } : ();
     push @cust_svc, [
       map {
         ( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : ();
-      } (split(/,/,
-       qsearchs('part_pkg',{'pkgpart'=>$pkgpart})->getfield('services')
-      ))
+      } map { $_->svcpart } qsearch('pkg_svc', { 'pkgpart' => $pkgpart })
     ];
   }
 
   #check for leftover services
   foreach (keys %svcnum) {
     next unless @{ $svcnum{$_} };
     ];
   }
 
   #check for leftover services
   foreach (keys %svcnum) {
     next unless @{ $svcnum{$_} };
-    return "Leftover services!";
+    $dbh->rollback if $oldAutoCommit;
+    return "Leftover services, svcpart $_: svcnum ".
+           join(', ', map { $_->svcnum } @{ $svcnum{$_} } );
   }
 
   #no leftover services, let's make changes.
   }
 
   #no leftover services, let's make changes.
@@ -453,36 +537,50 @@ sub order {
 #  my($pkgnum);
   foreach $pkgnum ( @{$remove_pkgnums} ) {
     my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
 #  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);
     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} ) {
  
   }
 
   #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);
       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
 }
 
   ''; #no errors
 }
 
@@ -490,7 +588,7 @@ sub order {
 
 =head1 VERSION
 
 
 =head1 VERSION
 
-$Id: cust_pkg.pm,v 1.2 1999-08-04 11:50:41 ivan Exp $
+$Id: cust_pkg.pm,v 1.11 2001-10-15 14:58:03 ivan Exp $
 
 =head1 BUGS
 
 
 =head1 BUGS
 
@@ -507,10 +605,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.
 
 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
 
 =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
 
 
 =cut
 
Freeside billing, trouble ticketing, network monitoring and provisioning