X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=4f3579eba6901a46717124edb71f9f8348837dfe;hb=9a90f2af0663c9b4e9611e044fd25349425d1aec;hp=5d449acd744ba1b4f5a3bf26f9cc20f0e30aac39;hpb=0130070457b6f634422c52bc788fd62eb6e00549;p=freeside.git

diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index 5d449acd7..4f3579eba 100644
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -169,9 +169,19 @@ setting I<refnum> to an array reference of refnums or a hash reference with
 refnums as keys.  If no I<refnum> is defined, a default FS::pkg_referral
 record will be created corresponding to cust_main.refnum.
 
-The following options are available: I<change>
+The following options are available:
 
-I<change>, if set true, supresses any referral credit to a referring customer.
+=over 4
+
+=item change
+
+If set true, supresses any referral credit to a referring customer.
+
+=item options
+
+cust_pkg_option records will be created
+
+=back
 
 =cut
 
@@ -282,7 +292,7 @@ the customer ever purchased the item.  Instead, see the cancel method.
 #  return "Can't delete cust_pkg records!";
 #}
 
-=item replace OLD_RECORD
+=item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
 
 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 returns the error, otherwise returns false.
@@ -299,7 +309,23 @@ suspend is normally updated by the suspend and unsuspend methods.
 cancel is normally updated by the cancel method (and also the order subroutine
 in some cases).
 
-Calls 
+Available options are:
+
+=over 4
+
+=item reason
+
+can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason.  The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
+
+=item reason_otaker
+
+the access_user (see L<FS::access_user>) providing the reason
+
+=item options
+
+hashref of keys and values - cust_pkg_option records will be created, updated or removed as appopriate
+
+=back
 
 =cut
 
@@ -340,9 +366,12 @@ sub replace {
 
   foreach my $method ( qw(adjourn expire) ) {  # How many reasons?
     if ($options->{'reason'} && $new->$method && $old->$method ne $new->$method) {
-      my $error = $new->insert_reason( 'reason' => $options->{'reason'},
-                                       'date'   => $new->$method,
-                                     );
+      my $error = $new->insert_reason(
+        'reason'        => $options->{'reason'},
+        'date'          => $new->$method,
+        'action'        => $method,
+        'reason_otaker' => $options->{'reason_otaker'},
+      );
       if ( $error ) {
         dbh->rollback if $oldAutoCommit;
         return "Error inserting cust_pkg_reason: $error";
@@ -477,6 +506,8 @@ Available options are:
 
 =item reason - can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason.  The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
 
+=item date - can be set to a unix style timestamp to specify when to cancel (expire)
+
 =back
 
 If there is an error, returns the error, otherwise returns false.
@@ -485,6 +516,7 @@ If there is an error, returns the error, otherwise returns false.
 
 sub cancel {
   my( $self, %options ) = @_;
+  my $error;
 
   warn "cust_pkg::cancel called with options".
        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
@@ -501,12 +533,23 @@ sub cancel {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
   
-  my $cancel_time = $options{'time'} || time;
+  my $old = $self->select_for_update;
 
-  my $error;
+  if ( $old->get('cancel') || $self->get('cancel') ) {
+    dbh->rollback if $oldAutoCommit;
+    return "";  # no error
+  }
+
+  my $date = $options{date} if $options{date}; # expire/cancel later
+  $date = '' if ($date && $date <= time);      # complain instead?
+
+  my $cancel_time = $options{'time'} || time;
 
   if ( $options{'reason'} ) {
-    $error = $self->insert_reason( 'reason' => $options{'reason'} );
+    $error = $self->insert_reason( 'reason' => $options{'reason'},
+                                   'action' => $date ? 'expire' : 'cancel',
+                                   'reason_otaker' => $options{'reason_otaker'},
+                                 );
     if ( $error ) {
       dbh->rollback if $oldAutoCommit;
       return "Error inserting cust_pkg_reason: $error";
@@ -514,23 +557,23 @@ sub cancel {
   }
 
   my %svc;
-  foreach my $cust_svc (
-    #schwartz
-    map  { $_->[0] }
-    sort { $a->[1] <=> $b->[1] }
-    map  { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; }
-    qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
-  ) {
+  unless ( $date ) {
+    foreach my $cust_svc (
+      #schwartz
+      map  { $_->[0] }
+      sort { $a->[1] <=> $b->[1] }
+      map  { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; }
+      qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
+    ) {
 
-    my $error = $cust_svc->cancel;
+      my $error = $cust_svc->cancel;
 
-    if ( $error ) {
-      $dbh->rollback if $oldAutoCommit;
-      return "Error cancelling cust_svc: $error";
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "Error cancelling cust_svc: $error";
+      }
     }
-  }
 
-  unless ( $self->getfield('cancel') ) {
     # Add a credit for remaining service
     my $remaining_value = $self->calc_remain(time=>$cancel_time);
     if ( $remaining_value > 0 && !$options{'no_credit'} ) {
@@ -543,20 +586,22 @@ sub cancel {
       if ($error) {
         $dbh->rollback if $oldAutoCommit;
         return "Error crediting customer \$$remaining_value for unused time on".
-          $self->part_pkg->pkg. ": $error";
-      }                                                                          
-    }                                                                            
-    my %hash = $self->hash;
-    $hash{'cancel'} = $cancel_time;
-    my $new = new FS::cust_pkg ( \%hash );
-    $error = $new->replace( $self, options => { $self->options } );
-    if ( $error ) {
-      $dbh->rollback if $oldAutoCommit;
-      return $error;
+               $self->part_pkg->pkg. ": $error";
+      }
     }
   }
 
+  my %hash = $self->hash;
+  $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time);
+  my $new = new FS::cust_pkg ( \%hash );
+  $error = $new->replace( $self, options => { $self->options } );
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  return '' if $date; #no errors
 
   my $conf = new FS::Conf;
   my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
@@ -593,7 +638,59 @@ sub cancel_if_expired {
   '';
 }
 
-=item suspend  [ OPTION => VALUE ... ]
+=item unexpire
+
+Cancels any pending expiration (sets the expire field to null).
+
+If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub unexpire {
+  my( $self, %options ) = @_;
+  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 $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  my $old = $self->select_for_update;
+
+  my $pkgnum = $old->pkgnum;
+  if ( $old->get('cancel') || $self->get('cancel') ) {
+    dbh->rollback if $oldAutoCommit;
+    return "Can't unexpire cancelled package $pkgnum";
+    # or at least it's pointless
+  }
+
+  unless ( $old->get('expire') && $self->get('expire') ) {
+    dbh->rollback if $oldAutoCommit;
+    return "";  # no error
+  }
+
+  my %hash = $self->hash;
+  $hash{'expire'} = '';
+  my $new = new FS::cust_pkg ( \%hash );
+  $error = $new->replace( $self, options => { $self->options } );
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+  ''; #no errors
+
+}
+
+=item suspend [ OPTION => VALUE ... ]
 
 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
 package, then suspends the package itself (sets the susp field to now).
@@ -604,6 +701,8 @@ Available options are:
 
 =item reason - can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason.  The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
 
+=item date - can be set to a unix style timestamp to specify when to suspend (adjourn)
+
 =back
 
 If there is an error, returns the error, otherwise returns false.
@@ -612,6 +711,7 @@ If there is an error, returns the error, otherwise returns false.
 
 sub suspend {
   my( $self, %options ) = @_;
+  my $error;
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
@@ -624,48 +724,69 @@ sub suspend {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
-  my $error;
+  my $old = $self->select_for_update;
+
+  my $pkgnum = $old->pkgnum;
+  if ( $old->get('cancel') || $self->get('cancel') ) {
+    dbh->rollback if $oldAutoCommit;
+    return "Can't suspend cancelled package $pkgnum";
+  }
+
+  if ( $old->get('susp') || $self->get('susp') ) {
+    dbh->rollback if $oldAutoCommit;
+    return "";  # no error                     # complain on adjourn?
+  }
+
+  my $date = $options{date} if $options{date}; # adjourn/suspend later
+  $date = '' if ($date && $date <= time);      # complain instead?
+
+  if ( $date && $old->get('expire') && $old->get('expire') < $date ) {
+    dbh->rollback if $oldAutoCommit;
+    return "Package $pkgnum expires before it would be suspended.";
+  }
 
   if ( $options{'reason'} ) {
-    $error = $self->insert_reason( 'reason' => $options{'reason'} );
+    $error = $self->insert_reason( 'reason' => $options{'reason'},
+                                   'action' => $date ? 'adjourn' : 'suspend',
+                                   'reason_otaker' => $options{'reason_otaker'},
+                                 );
     if ( $error ) {
       dbh->rollback if $oldAutoCommit;
       return "Error inserting cust_pkg_reason: $error";
     }
   }
 
-  foreach my $cust_svc (
-    qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
-  ) {
-    my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
+  unless ( $date ) {
+    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 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;
-      if ( $error ) {
+      $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
         $dbh->rollback if $oldAutoCommit;
-        return $error;
+        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;
+        if ( $error ) {
+          $dbh->rollback if $oldAutoCommit;
+          return $error;
+        }
       }
     }
-
   }
 
-  unless ( $self->getfield('susp') ) {
-    my %hash = $self->hash;
-    $hash{'susp'} = time;
-    my $new = new FS::cust_pkg ( \%hash );
-    $error = $new->replace( $self, options => { $self->options } );
-    if ( $error ) {
-      $dbh->rollback if $oldAutoCommit;
-      return $error;
-    }
+  my %hash = $self->hash;
+  $date ? ($hash{'adjourn'} = $date) : ($hash{'susp'} = time);
+  my $new = new FS::cust_pkg ( \%hash );
+  $error = $new->replace( $self, options => { $self->options } );
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
   }
 
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
@@ -679,15 +800,21 @@ Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
 package, then unsuspends the package itself (clears the susp field and the
 adjourn field if it is in the past).
 
-Available options are: I<adjust_next_bill>.
+Available options are:
+
+=over 4
+
+=item adjust_next_bill
 
-I<adjust_next_bill> can be set true to adjust the next bill date forward by
+Can be set true to adjust the next bill date forward by
 the amount of time the account was inactive.  This was set true by default
 since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be
 explicitly requested.  Price plans for which this makes sense (anniversary-date
 based than prorate or subscription) could have an option to enable this
 behaviour?
 
+=back
+
 If there is an error, returns the error, otherwise returns false.
 
 =cut
@@ -707,6 +834,19 @@ sub unsuspend {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
+  my $old = $self->select_for_update;
+
+  my $pkgnum = $old->pkgnum;
+  if ( $old->get('cancel') || $self->get('cancel') ) {
+    dbh->rollback if $oldAutoCommit;
+    return "Can't unsuspend cancelled package $pkgnum";
+  }
+
+  unless ( $old->get('susp') && $self->get('susp') ) {
+    dbh->rollback if $oldAutoCommit;
+    return "";  # no error                     # complain instead?
+  }
+
   foreach my $cust_svc (
     qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
   ) {
@@ -730,25 +870,23 @@ sub unsuspend {
 
   }
 
-  unless ( ! $self->getfield('susp') ) {
-    my %hash = $self->hash;
-    my $inactive = time - $hash{'susp'};
+  my %hash = $self->hash;
+  my $inactive = time - $hash{'susp'};
 
-    my $conf = new FS::Conf;
+  my $conf = new FS::Conf;
 
-    $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
-      if ( $opt{'adjust_next_bill'}
-           || $conf->config('unsuspend-always_adjust_next_bill_date') )
-      && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} );
+  $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
+    if ( $opt{'adjust_next_bill'}
+         || $conf->config('unsuspend-always_adjust_next_bill_date') )
+    && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} );
 
-    $hash{'susp'} = '';
-    $hash{'adjourn'} = '' if $hash{'adjourn'} < time;
-    my $new = new FS::cust_pkg ( \%hash );
-    $error = $new->replace( $self, options => { $self->options } );
-    if ( $error ) {
-      $dbh->rollback if $oldAutoCommit;
-      return $error;
-    }
+  $hash{'susp'} = '';
+  $hash{'adjourn'} = '' if $hash{'adjourn'} < time;
+  my $new = new FS::cust_pkg ( \%hash );
+  $error = $new->replace( $self, options => { $self->options } );
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
   }
 
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
@@ -756,6 +894,64 @@ sub unsuspend {
   ''; #no errors
 }
 
+=item unadjourn
+
+Cancels any pending suspension (sets the adjourn field to null).
+
+If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub unadjourn {
+  my( $self, %options ) = @_;
+  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 $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  my $old = $self->select_for_update;
+
+  my $pkgnum = $old->pkgnum;
+  if ( $old->get('cancel') || $self->get('cancel') ) {
+    dbh->rollback if $oldAutoCommit;
+    return "Can't unadjourn cancelled package $pkgnum";
+    # or at least it's pointless
+  }
+
+  if ( $old->get('susp') || $self->get('susp') ) {
+    dbh->rollback if $oldAutoCommit;
+    return "Can't unadjourn suspended package $pkgnum";
+    # perhaps this is arbitrary
+  }
+
+  unless ( $old->get('adjourn') && $self->get('adjourn') ) {
+    dbh->rollback if $oldAutoCommit;
+    return "";  # no error
+  }
+
+  my %hash = $self->hash;
+  $hash{'adjourn'} = '';
+  my $new = new FS::cust_pkg ( \%hash );
+  $error = $new->replace( $self, options => { $self->options } );
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+  ''; #no errors
+
+}
+
 =item last_bill
 
 Returns the last bill date, or if there is no last bill date, the setup date.
@@ -772,30 +968,37 @@ sub last_bill {
   $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
 }
 
-=item last_cust_pkg_reason
+=item last_cust_pkg_reason ACTION
 
-Returns the most recent FS::reason associated with the package.
+Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
+Returns false if there is no reason or the package is not currenly ACTION'd
+ACTION is one of adjourn, susp, cancel, or expire.
 
 =cut
 
 sub last_cust_pkg_reason {
-  my $self = shift;
+  my ( $self, $action ) = ( shift, shift );
+  my $date = $self->get($action);
   qsearchs( {
               'table' => 'cust_pkg_reason',
-              'hashref' => { 'pkgnum' => $self->pkgnum, },
-              'extra_sql'=> "AND date <= ". time,
-              'order_by' => 'ORDER BY date DESC LIMIT 1',
+              'hashref' => { 'pkgnum' => $self->pkgnum,
+                             'action' => substr(uc($action), 0, 1),
+                             'date'   => $date,
+                           },
+              'order_by' => 'ORDER BY num DESC LIMIT 1',
            } );
 }
 
-=item last_reason
+=item last_reason ACTION
 
-Returns the most recent FS::reason associated with the package.
+Returns the most recent ACTION FS::reason associated with the package.
+Returns false if there is no reason or the package is not currenly ACTION'd
+ACTION is one of adjourn, susp, cancel, or expire.
 
 =cut
 
 sub last_reason {
-  my $cust_pkg_reason = shift->last_cust_pkg_reason;
+  my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
   $cust_pkg_reason->reason
     if $cust_pkg_reason;
 }
@@ -1974,26 +2177,6 @@ sub order {
   '';
 }
 
-=item insert_reason
-
-Associates this package with a (suspension or cancellation) reason (see
-L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
-L<FS::reason>).
-
-Available options are:
-
-=over 4
-
-=item reason - can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason.  The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
-
-=item date
-
-=back
-
-If there is an error, returns the error, otherwise returns false.
-
-=cut
-
 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
 
 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
@@ -2052,10 +2235,43 @@ sub bulk_change {
   '';
 }
 
+=item insert_reason
+
+Associates this package with a (suspension or cancellation) reason (see
+L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
+L<FS::reason>).
+
+Available options are:
+
+=over 4
+
+=item reason
+
+can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason.  The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
+
+=item reason_otaker
+
+the access_user (see L<FS::access_user>) providing the reason
+
+=item date
+
+a unix timestamp 
+
+=item action
+
+the action (cancel, susp, adjourn, expire) associated with the reason
+
+=back
+
+If there is an error, returns the error, otherwise returns false.
+
+=cut
+
 sub insert_reason {
   my ($self, %options) = @_;
 
-  my $otaker = $FS::CurrentUser::CurrentUser->username;
+  my $otaker = $options{reason_otaker} ||
+               $FS::CurrentUser::CurrentUser->username;
 
   my $reasonnum;
   if ( $options{'reason'} =~ /^(\d+)$/ ) {
@@ -2084,6 +2300,7 @@ sub insert_reason {
     new FS::cust_pkg_reason({ 'pkgnum'    => $self->pkgnum,
                               'reasonnum' => $reasonnum, 
 		              'otaker'    => $otaker,
+		              'action'    => substr(uc($options{'action'}),0,1),
 		              'date'      => $options{'date'}
 			                       ? $options{'date'}
 					       : time,