work around bug in pre-perl5.10 which is at best noisy and at worst missorting
[freeside.git] / FS / FS / cust_pkg.pm
index 055b87b..d32ad1b 100644 (file)
@@ -14,11 +14,13 @@ use FS::cust_main;
 use FS::type_pkgs;
 use FS::pkg_svc;
 use FS::cust_bill_pkg;
 use FS::type_pkgs;
 use FS::pkg_svc;
 use FS::cust_bill_pkg;
+use FS::cust_pkg_detail;
 use FS::h_cust_svc;
 use FS::reg_code;
 use FS::part_svc;
 use FS::cust_pkg_reason;
 use FS::reason;
 use FS::h_cust_svc;
 use FS::reg_code;
 use FS::part_svc;
 use FS::cust_pkg_reason;
 use FS::reason;
+use FS::UI::Web;
 
 # 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 }
@@ -111,6 +113,8 @@ inherits from FS::Record.  The following fields are currently supported:
 
 =item last_bill - last bill date
 
 
 =item last_bill - last bill date
 
+=item adjourn - date
+
 =item susp - date
 
 =item expire - date
 =item susp - date
 
 =item expire - date
@@ -122,9 +126,11 @@ inherits from FS::Record.  The following fields are currently supported:
 =item manual_flag - If this field is set to 1, disables the automatic
 unsuspension of this package when using the B<unsuspendauto> config file.
 
 =item manual_flag - If this field is set to 1, disables the automatic
 unsuspension of this package when using the B<unsuspendauto> config file.
 
+=item quantity - If not set, defaults to 1
+
 =back
 
 =back
 
-Note: setup, bill, susp, expire and cancel are specified as UNIX timestamps;
+Note: setup, bill, adjourn, susp, expire and cancel are specified as UNIX timestamps;
 see L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for
 conversion functions.
 
 see L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for
 conversion functions.
 
@@ -210,11 +216,13 @@ sub insert {
              ' packages with '. $part_pkg->freq_pretty. ' frequency';
       } else {
 
              ' packages with '. $part_pkg->freq_pretty. ' frequency';
       } else {
 
-        my $amount = sprintf( "%.2f", $part_pkg->base_recur / $part_pkg->freq );
+        my $amount = sprintf( "%.2f", $part_pkg->base_recur($self) / $part_pkg->freq );
         my $error =
         my $error =
-          $referring_cust_main->credit( $amount,
-                                        'Referral credit for '. $cust_main->name
-                                      );
+          $referring_cust_main->
+            credit( $amount,
+                    'Referral credit for '.$cust_main->name,
+                    'reason_type' => $conf->config('referral_credit_type')
+                  );
         if ( $error ) {
           $dbh->rollback if $oldAutoCommit;
           return "Error crediting customer ". $cust_main->referral_custnum.
         if ( $error ) {
           $dbh->rollback if $oldAutoCommit;
           return "Error crediting customer ". $cust_main->referral_custnum.
@@ -264,7 +272,7 @@ the customer ever purchased the item.  Instead, see the cancel method.
 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 returns the error, otherwise returns false.
 
 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 returns the error, otherwise returns false.
 
-Currently, custnum, setup, bill, susp, expire, and cancel may be changed.
+Currently, custnum, setup, bill, adjourn, susp, expire, and cancel may be changed.
 
 Changing pkgpart may have disasterous effects.  See the order subroutine.
 
 
 Changing pkgpart may have disasterous effects.  See the order subroutine.
 
@@ -276,8 +284,6 @@ 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).
 
 cancel is normally updated by the cancel method (and also the order subroutine
 in some cases).
 
-Calls 
-
 =cut
 
 sub replace {
 =cut
 
 sub replace {
@@ -310,13 +316,18 @@ sub replace {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
-  if ($options{'reason'} && $new->expire && $old->expire ne $new->expire) {
-    my $error = $new->insert_reason( 'reason' => $options{'reason'},
-                                     'date'      => $new->expire,
-                                   );
-    if ( $error ) {
-      dbh->rollback if $oldAutoCommit;
-      return "Error inserting cust_pkg_reason: $error";
+  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,
+        'action'        => $method,
+        'reason_otaker' => $options{'reason_otaker'},
+      );
+      if ( $error ) {
+        dbh->rollback if $oldAutoCommit;
+        return "Error inserting cust_pkg_reason: $error";
+      }
     }
   }
 
     }
   }
 
@@ -377,6 +388,8 @@ sub check {
     || $self->ut_numbern('bill')
     || $self->ut_numbern('susp')
     || $self->ut_numbern('cancel')
     || $self->ut_numbern('bill')
     || $self->ut_numbern('susp')
     || $self->ut_numbern('cancel')
+    || $self->ut_numbern('adjourn')
+    || $self->ut_numbern('expire')
   ;
   return $error if $error;
 
   ;
   return $error if $error;
 
@@ -416,7 +429,7 @@ sub check {
   }
 
   $self->otaker(getotaker) unless $self->otaker;
   }
 
   $self->otaker(getotaker) unless $self->otaker;
-  $self->otaker =~ /^([\w\.\-]{0,16})$/ or return "Illegal otaker";
+  $self->otaker =~ /^(\w{1,32})$/ or return "Illegal otaker";
   $self->otaker($1);
 
   if ( $self->dbdef_table->column('manual_flag') ) {
   $self->otaker($1);
 
   if ( $self->dbdef_table->column('manual_flag') ) {
@@ -435,9 +448,11 @@ Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
 in this package, then cancels the package itself (sets the cancel field to
 now).
 
 in this package, then cancels the package itself (sets the cancel field to
 now).
 
-Available options are: I<quiet>
+Available options are: I<quiet> I<reason> I<date>
 
 I<quiet> can be set true to supress email cancellation notices.
 
 I<quiet> can be set true to supress email cancellation notices.
+I<reason> can be set to a reasonnum (see L<FS::reason>) explaining the action
+I<date> can be set to a unix style timestamp to specify when to cancel (expire)
 
 If there is an error, returns the error, otherwise returns false.
 
 
 If there is an error, returns the error, otherwise returns false.
 
@@ -458,8 +473,24 @@ sub cancel {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
+  my $old = $self->select_for_update;
+
+  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'}) {
   if ($options{'reason'}) {
-    $error = $self->insert_reason( 'reason' => $options{'reason'} );
+    $error = $self->insert_reason( 'reason' => $options{'reason'},
+                                   'action' => $date ? 'expire' : 'cancel',
+                                   'date'   => $date ? $date : $cancel_time,
+                                   'reason_otaker' => $options{'reason_otaker'},
+                                 );
     if ( $error ) {
       dbh->rollback if $oldAutoCommit;
       return "Error inserting cust_pkg_reason: $error";
     if ( $error ) {
       dbh->rollback if $oldAutoCommit;
       return "Error inserting cust_pkg_reason: $error";
@@ -467,48 +498,51 @@ sub cancel {
   }
 
   my %svc;
   }
 
   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";
+      }
     }
     }
-  }
 
 
-  # Add a credit for remaining service
-  my $remaining_value = $self->calc_remain();
-  if ( $remaining_value > 0 ) {
-    my $error = $self->cust_main->credit(
-      $remaining_value,
-      'Credit for unused time on '. $self->part_pkg->pkg,
-    );
-    if ($error) {
-      $dbh->rollback if $oldAutoCommit;
-      return "Error crediting customer \$$remaining_value for unused time on".
-             $self->part_pkg->pkg. ": $error";
-    }                                                                          
-  }                                                                            
-
-  unless ( $self->getfield('cancel') ) {
-    my %hash = $self->hash;
-    $hash{'cancel'} = time;
-    my $new = new FS::cust_pkg ( \%hash );
-    $error = $new->replace( $self, options => { $self->options } );
-    if ( $error ) {
-      $dbh->rollback if $oldAutoCommit;
-      return $error;
+    # Add a credit for remaining service
+    my $remaining_value = $self->calc_remain();
+    if ( $remaining_value > 0 ) {
+      my $conf = new FS::Conf;
+      my $error = $self->cust_main->credit(
+        $remaining_value,
+        'Credit for unused time on '. $self->part_pkg->pkg,
+        'reason_type' => $conf->config('cancel_credit_type'),
+      );
+      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;
+  $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;
   $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;
 
   my $conf = new FS::Conf;
   my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
@@ -517,7 +551,7 @@ sub cancel {
     my $error = send_email(
       'from'    => $conf->config('invoice_from'),
       'to'      => \@invoicing_list,
     my $error = send_email(
       'from'    => $conf->config('invoice_from'),
       'to'      => \@invoicing_list,
-      'subject' => $conf->config('cancelsubject'),
+      'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
       'body'    => [ map "$_\n", $conf->config('cancelmessage') ],
     );
     #should this do something on errors?
       'body'    => [ map "$_\n", $conf->config('cancelmessage') ],
     );
     #should this do something on errors?
@@ -527,11 +561,68 @@ sub cancel {
 
 }
 
 
 }
 
-=item suspend
+=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).
 
 
 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).
 
+Available options are: I<reason> I<date>
+
+I<date> can be set to a unix style timestamp to specify when to suspend (adjourn)
+I<reason> can be set to a reasonnum (see L<FS::reason>) explaining the action
+
 If there is an error, returns the error, otherwise returns false.
 
 =cut
 If there is an error, returns the error, otherwise returns false.
 
 =cut
@@ -551,46 +642,106 @@ sub suspend {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
   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 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.";     
+  }
+
+  my $suspend_time = $options{'time'} || time;
+
   if ($options{'reason'}) {
   if ($options{'reason'}) {
-    $error = $self->insert_reason( 'reason' => $options{'reason'} );
+    $error = $self->insert_reason( 'reason' => $options{'reason'},
+                                   'action' => $date ? 'adjourn' : 'suspend',
+                                   'date'   => $date ? $date : $suspend_time,
+                                   'reason_otaker' => $options{'reason_otaker'},
+                                 );
     if ( $error ) {
       dbh->rollback if $oldAutoCommit;
       return "Error inserting cust_pkg_reason: $error";
     }
   }
 
     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 ) {
 
 
-    $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 @labels = ();
 
 
-    my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
-    if ($svc) {
-      $error = $svc->suspend;
-      if ( $error ) {
+    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;
         $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;
+        }
+        my( $label, $value ) = $cust_svc->label;
+        push @labels, "$label: $value";
       }
     }
 
       }
     }
 
-  }
+    my $conf = new FS::Conf;
+    if ( $conf->config('suspend_email_admin') ) {
+      my $error = send_email(
+        'from'    => $conf->config('invoice_from'), #??? well as good as any
+        'to'      => $conf->config('suspend_email_admin'),
+        'subject' => 'FREESIDE NOTIFICATION: Customer package suspended',
+        'body'    => [
+          "This is an automatic message from your Freeside installation\n",
+          "informing you that the following customer package has been suspended:\n",
+          "\n",
+          'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
+          'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
+          ( map { "Service : $_\n" } @labels ),
+        ],
+      );
+
+      if ( $error ) {
+        warn "WARNING: can't send suspension admin email (suspending anyway): ".
+             "$error\n";
+      }
 
 
-  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;
+  if ( $date ) {
+    $hash{'adjourn'} = $date;
+  } else {
+    $hash{'susp'} = $suspend_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;
   }
 
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
@@ -601,7 +752,8 @@ sub suspend {
 =item unsuspend [ OPTION => VALUE ... ]
 
 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
 =item unsuspend [ OPTION => VALUE ... ]
 
 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).
+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: I<adjust_next_bill>.
 
@@ -631,6 +783,19 @@ sub unsuspend {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
   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 } )
   ) {
   foreach my $cust_svc (
     qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
   ) {
@@ -654,24 +819,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->exists('unsuspend-always_adjust_next_bill_date') )
+    && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} );
 
 
-    $hash{'susp'} = '';
-    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;
   }
 
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
@@ -679,6 +843,64 @@ sub unsuspend {
   ''; #no errors
 }
 
   ''; #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.
 =item last_bill
 
 Returns the last bill date, or if there is no last bill date, the setup date.
@@ -697,20 +919,38 @@ sub last_bill {
   $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
 }
 
   $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
 }
 
-=item last_reason
+=item last_cust_pkg_reason ACTION
+
+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, $action ) = ( shift, shift );
+  my $date = $self->get($action);
+  qsearchs( {
+              'table' => 'cust_pkg_reason',
+              'hashref' => { 'pkgnum' => $self->pkgnum,
+                             'action' => substr(uc($action), 0, 1),
+                             'date'   => $date,
+                           },
+              'order_by' => 'ORDER BY num DESC LIMIT 1',
+           } );
+}
+
+=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 {
 
 =cut
 
 sub last_reason {
-  my $self = shift;
-  my $cust_pkg_reason = qsearchs( {
-                                    'table' => 'cust_pkg_reason',
-                                   'hashref' => { 'pkgnum' => $self->pkgnum, },
-                                   'extra_sql'=> 'ORDER BY date DESC LIMIT 1',
-                                 } );
-  qsearchs ( 'reason', { 'reasonnum' => $cust_pkg_reason->reasonnum } )
+  my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
+  $cust_pkg_reason->reason
     if $cust_pkg_reason;
 }
 
     if $cust_pkg_reason;
 }
 
@@ -729,6 +969,18 @@ sub part_pkg {
     : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
 }
 
     : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
 }
 
+=item old_cust_pkg
+
+Returns the cancelled package this package was changed from, if any.
+
+=cut
+
+sub old_cust_pkg {
+  my $self = shift;
+  return '' unless $self->change_pkgnum;
+  qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
+}
+
 =item calc_setup
 
 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
 =item calc_setup
 
 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
@@ -788,6 +1040,77 @@ sub cust_bill_pkg {
   qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
 }
 
   qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
 }
 
+=item cust_pkg_detail [ DETAILTYPE ]
+
+Returns any customer package details for this package (see
+L<FS::cust_pkg_detail>).
+
+DETAILTYPE can be set to "I" for invoice details or "C" for comments.
+
+=cut
+
+sub cust_pkg_detail {
+  my $self = shift;
+  my %hash = ( 'pkgnum' => $self->pkgnum );
+  $hash{detailtype} = shift if @_;
+  qsearch({
+    'table'    => 'cust_pkg_detail',
+    'hashref'  => \%hash,
+    'order_by' => 'ORDER BY weight, pkgdetailnum',
+  });
+}
+
+=item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
+
+Sets customer package details for this package (see L<FS::cust_pkg_detail>).
+
+DETAILTYPE can be set to "I" for invoice details or "C" for comments.
+
+If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub set_cust_pkg_detail {
+  my( $self, $detailtype, @details ) = @_;
+
+  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;
+
+  foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
+    my $error = $current->delete;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "error removing old detail: $error";
+    }
+  }
+
+  foreach my $detail ( @details ) {
+    my $cust_pkg_detail = new FS::cust_pkg_detail {
+      'pkgnum'     => $self->pkgnum,
+      'detailtype' => $detailtype,
+      'detail'     => $detail,
+    };
+    my $error = $cust_pkg_detail->insert;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "error adding new detail: $error";
+    }
+
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  '';
+
+}
+
 =item cust_svc [ SVCPART ]
 
 Returns the services for this package, as FS::cust_svc objects (see
 =item cust_svc [ SVCPART ]
 
 Returns the services for this package, as FS::cust_svc objects (see
@@ -850,8 +1173,12 @@ sub h_cust_svc {
 sub _sort_cust_svc {
   my( $self, $arrayref ) = @_;
 
 sub _sort_cust_svc {
   my( $self, $arrayref ) = @_;
 
+  my $sort =
+    sub ($$) { my ($a, $b) = @_; $b->[1] cmp $a->[1]  or  $a->[2] <=> $b->[2]
+};
+
   map  { $_->[0] }
   map  { $_->[0] }
-  sort { $b->[1] cmp $a->[1]  or  $a->[2] <=> $b->[2] } 
+  sort $sort
   map {
         my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
                                              'svcpart' => $_->svcpart     } );
   map {
         my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
                                              'svcpart' => $_->svcpart     } );
@@ -900,7 +1227,7 @@ sub available_part_svc {
       $self->part_pkg->pkg_svc;
 }
 
       $self->part_pkg->pkg_svc;
 }
 
-=item 
+=item part_svc
 
 Returns a list of FS::part_svc objects representing provisioned and available
 services included in this package.  Each FS::part_svc object also has the
 
 Returns a list of FS::part_svc objects representing provisioned and available
 services included in this package.  Each FS::part_svc object also has the
@@ -1078,24 +1405,29 @@ sub h_labels {
 
 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
 
 
 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
 
-Like h_labels, except returns a simple flat list, and shortens long 
-(currently >5) lists of identical services to one line that lists the service
-label and the number of individual services rather than individual items.
+Like h_labels, except returns a simple flat list, and shortens long
+(currently >5 or the cust_bill-max_same_services configuration value) lists of
+identical services to one line that lists the service label and the number of
+individual services rather than individual items.
 
 =cut
 
 sub h_labels_short {
   my $self = shift;
 
 
 =cut
 
 sub h_labels_short {
   my $self = shift;
 
+  my $conf = new FS::Conf;
+  my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
+
   my %labels;
   #tie %labels, 'Tie::IxHash';
   push @{ $labels{$_->[0]} }, $_->[1]
     foreach $self->h_labels(@_);
   my @labels;
   foreach my $label ( keys %labels ) {
   my %labels;
   #tie %labels, 'Tie::IxHash';
   push @{ $labels{$_->[0]} }, $_->[1]
     foreach $self->h_labels(@_);
   my @labels;
   foreach my $label ( keys %labels ) {
-    my @values = @{ $labels{$label} };
+    my %seen = ();
+    my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
     my $num = scalar(@values);
     my $num = scalar(@values);
-    if ( $num > 5 ) {
+    if ( $num > $max_same_services ) {
       push @labels, "$label ($num)";
     } else {
       push @labels, map { "$label: $_" } @values;
       push @labels, "$label ($num)";
     } else {
       push @labels, map { "$label: $_" } @values;
@@ -1205,6 +1537,18 @@ sub attribute_since_sqlradacct {
 
 }
 
 
 }
 
+=item quantity
+
+=cut
+
+sub quantity {
+  my( $self, $value ) = @_;
+  if ( defined($value) ) {
+    $self->setfield('quantity', $value);
+  }
+  $self->getfield('quantity') || 1;
+}
+
 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
 
 Transfers as many services as possible from this package to another package.
 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
 
 Transfers as many services as possible from this package to another package.
@@ -1437,6 +1781,287 @@ sub cancel_sql {
   "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
 }
 
   "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
 }
 
+=item search_sql HASHREF
+
+(Class method)
+
+Returns a qsearch hash expression to search for parameters specified in HASHREF.
+Valid parameters are
+
+=over 4
+
+=item agentnum
+
+=item magic
+
+active, inactive, suspended, cancel (or cancelled)
+
+=item status
+
+active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
+
+=item classnum
+
+=item pkgpart
+
+pkgpart or arrayref or hashref of pkgparts
+
+=item setup
+
+arrayref of beginning and ending epoch date
+
+=item last_bill
+
+arrayref of beginning and ending epoch date
+
+=item bill
+
+arrayref of beginning and ending epoch date
+
+=item adjourn
+
+arrayref of beginning and ending epoch date
+
+=item susp
+
+arrayref of beginning and ending epoch date
+
+=item expire
+
+arrayref of beginning and ending epoch date
+
+=item cancel
+
+arrayref of beginning and ending epoch date
+
+=item query
+
+pkgnum or APKG_pkgnum
+
+=item cust_fields
+
+a value suited to passing to FS::UI::Web::cust_header
+
+=item CurrentUser
+
+specifies the user for agent virtualization
+
+=back
+
+=cut
+
+sub search_sql { 
+  my ($class, $params) = @_;
+  my @where = ();
+
+  ##
+  # parse agent
+  ##
+
+  if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
+    push @where,
+      "agentnum = $1";
+  }
+
+  ##
+  # parse status
+  ##
+
+  if (    $params->{'magic'}  eq 'active'
+       || $params->{'status'} eq 'active' ) {
+
+    push @where, FS::cust_pkg->active_sql();
+
+  } elsif (    $params->{'magic'}  eq 'inactive'
+            || $params->{'status'} eq 'inactive' ) {
+
+    push @where, FS::cust_pkg->inactive_sql();
+
+  } elsif (    $params->{'magic'}  eq 'suspended'
+            || $params->{'status'} eq 'suspended'  ) {
+
+    push @where, FS::cust_pkg->suspended_sql();
+
+  } elsif (    $params->{'magic'}  =~ /^cancell?ed$/
+            || $params->{'status'} =~ /^cancell?ed$/ ) {
+
+    push @where, FS::cust_pkg->cancelled_sql();
+
+  } elsif ( $params->{'status'} =~ /^(one-time charge|inactive)$/ ) {
+
+    push @where, FS::cust_pkg->inactive_sql();
+
+  }
+
+  ###
+  # parse package class
+  ###
+
+  #false lazinessish w/graph/cust_bill_pkg.cgi
+  my $classnum = 0;
+  my @pkg_class = ();
+  if ( exists($params->{'classnum'})
+       && $params->{'classnum'} =~ /^(\d*)$/
+     )
+  {
+    $classnum = $1;
+    if ( $classnum ) { #a specific class
+      push @where, "classnum = $classnum";
+
+      #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
+      #die "classnum $classnum not found!" unless $pkg_class[0];
+      #$title .= $pkg_class[0]->classname.' ';
+
+    } elsif ( $classnum eq '' ) { #the empty class
+
+      push @where, "classnum IS NULL";
+      #$title .= 'Empty class ';
+      #@pkg_class = ( '(empty class)' );
+    } elsif ( $classnum eq '0' ) {
+      #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } );
+      #push @pkg_class, '(empty class)';
+    } else {
+      die "illegal classnum";
+    }
+  }
+  #eslaf
+
+  ###
+  # parse part_pkg
+  ###
+
+  if ( ref($params->{'pkgpart'}) ) {
+
+    my @pkgpart = ();
+    if ( ref($params->{'pkgpart'}) eq 'HASH' ) {
+      @pkgpart = grep $params->{'pkgpart'}{$_}, keys %{ $params->{'pkgpart'} };
+    } elsif ( ref($params->{'pkgpart'}) eq 'ARRAY' ) {
+      @pkgpart = @{ $params->{'pkgpart'} };
+    } else {
+      die 'unhandled pkgpart ref '. $params->{'pkgpart'};
+    }
+
+    @pkgpart = grep /^(\d+)$/, @pkgpart;
+
+    push @where, 'pkgpart IN ('. join(',', @pkgpart). ')' if scalar(@pkgpart);
+
+  } elsif ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
+    push @where, "pkgpart = $1";
+  } 
+
+  ###
+  # parse dates
+  ###
+
+  my $orderby = '';
+
+  #false laziness w/report_cust_pkg.html
+  my %disable = (
+    'all'             => {},
+    'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
+    'active'          => { 'susp'=>1, 'cancel'=>1 },
+    'suspended'       => { 'cancel' => 1 },
+    'cancelled'       => {},
+    ''                => {},
+  );
+
+  foreach my $field (qw( setup last_bill bill adjourn susp expire cancel )) {
+
+    next unless exists($params->{$field});
+
+    my($beginning, $ending) = @{$params->{$field}};
+
+    next if $beginning == 0 && $ending == 4294967295;
+
+    push @where,
+      "cust_pkg.$field IS NOT NULL",
+      "cust_pkg.$field >= $beginning",
+      "cust_pkg.$field <= $ending";
+
+    $orderby ||= "ORDER BY cust_pkg.$field";
+
+  }
+
+  $orderby ||= 'ORDER BY bill';
+
+  ###
+  # parse magic, legacy, etc.
+  ###
+
+  if ( $params->{'magic'} &&
+       $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
+  ) {
+
+    $orderby = 'ORDER BY pkgnum';
+
+    if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
+      push @where, "pkgpart = $1";
+    }
+
+  } elsif ( $params->{'query'} eq 'pkgnum' ) {
+
+    $orderby = 'ORDER BY pkgnum';
+
+  } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
+
+    $orderby = 'ORDER BY pkgnum';
+
+    push @where, '0 < (
+      SELECT count(*) FROM pkg_svc
+       WHERE pkg_svc.pkgpart =  cust_pkg.pkgpart
+         AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
+                                   WHERE cust_svc.pkgnum  = cust_pkg.pkgnum
+                                     AND cust_svc.svcpart = pkg_svc.svcpart
+                                )
+    )';
+  
+  }
+
+  ##
+  # setup queries, links, subs, etc. for the search
+  ##
+
+  # here is the agent virtualization
+  if ($params->{CurrentUser}) {
+    my $access_user =
+      qsearchs('access_user', { username => $params->{CurrentUser} });
+
+    if ($access_user) {
+      push @where, $access_user->agentnums_sql('table' => 'cust_main');
+    }else{
+      push @where, "1=0";
+    }
+  }else{
+    push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table' => 'cust_main');
+  }
+
+  my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
+
+  my $addl_from = 'LEFT JOIN cust_main USING ( custnum  ) '.
+                  'LEFT JOIN part_pkg  USING ( pkgpart  ) '.
+                  'LEFT JOIN pkg_class USING ( classnum ) ';
+
+  my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
+
+  my $sql_query = {
+    'table'       => 'cust_pkg',
+    'hashref'     => {},
+    'select'      => join(', ',
+                                'cust_pkg.*',
+                                ( map "part_pkg.$_", qw( pkg freq ) ),
+                                'pkg_class.classname',
+                                'cust_main.custnum as cust_main_custnum',
+                                FS::UI::Web::cust_sql_fields(
+                                  $params->{'cust_fields'}
+                                ),
+                     ),
+    'extra_sql'   => "$extra_sql $orderby",
+    'addl_from'   => $addl_from,
+    'count_query' => $count_query,
+  };
+
+}
+
 =head1 SUBROUTINES
 
 =over 4
 =head1 SUBROUTINES
 
 =over 4
@@ -1487,9 +2112,17 @@ sub order {
   my $change = scalar(@old_cust_pkg) != 0;
 
   my %hash = (); 
   my $change = scalar(@old_cust_pkg) != 0;
 
   my %hash = (); 
-  if ( scalar(@old_cust_pkg) == 1 ) {
+  if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
+
+    my $time = time;
+
     #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( last_bill bill );
     #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( last_bill bill );
-    $hash{'setup'} = time;
+    
+    #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( setup );
+    $hash{'setup'} = $time if $old_cust_pkg[0]->setup;
+
+    $hash{'change_date'} = $time;
+    $hash{"change_$_"}  = $old_cust_pkg[0]->$_() foreach qw( pkgnum pkgpart );
   }
 
   # Create the new packages.
   }
 
   # Create the new packages.
@@ -1539,6 +2172,24 @@ sub order {
       $dbh->rollback if $oldAutoCommit;
       return "Unable to transfer all services from package ".$old_pkg->pkgnum;
     }
       $dbh->rollback if $oldAutoCommit;
       return "Unable to transfer all services from package ".$old_pkg->pkgnum;
     }
+
+    #reset usage if changing pkgpart
+    foreach my $new_pkg (@$return_cust_pkg) {
+      if ($old_pkg->pkgpart != $new_pkg->pkgpart) {
+        my $part_pkg = $new_pkg->part_pkg;
+        $error = $part_pkg->reset_usage($new_pkg, $part_pkg->is_prepaid
+                                                    ? ()
+                                                    : ( 'null' => 1 )
+                                       )
+          if $part_pkg->can('reset_usage');
+
+        if ($error) {
+          $dbh->rollback if $oldAutoCommit;
+          return "Error setting usage values: $error";
+        }
+      }
+    }
+
     $error = $old_pkg->cancel( quiet=>1 );
     if ($error) {
       $dbh->rollback;
     $error = $old_pkg->cancel( quiet=>1 );
     if ($error) {
       $dbh->rollback;
@@ -1549,20 +2200,128 @@ sub order {
   '';
 }
 
   '';
 }
 
+=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
+L<FS::part_pkg>) to order for this customer.  Duplicates are of course
+permitted.
+
+REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
+replace.  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>).
+
+RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
+newly-created cust_pkg objects.
+
+=cut
+
+sub bulk_change {
+  my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
+
+  # Transactionize this whole mess
+  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 @errors;
+  my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
+                         @$remove_pkgnum;
+
+  while(scalar(@old_cust_pkg)) {
+    my @return = ();
+    my $custnum = $old_cust_pkg[0]->custnum;
+    my (@remove) = map { $_->pkgnum }
+                   grep { $_->custnum == $custnum } @old_cust_pkg;
+    @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
+
+    my $error = order $custnum, $pkgparts, \@remove, \@return;
+
+    push @errors, $error
+      if $error;
+    push @$return_cust_pkg, @return;
+  }
+
+  if (scalar(@errors)) {
+    $dbh->rollback if $oldAutoCommit;
+    return join(' / ', @errors);
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  '';
+}
+
+=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 otaker_reason - 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) = @_;
 
 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+)$/ ) {
+
+    $reasonnum = $1;
+
+  } elsif ( ref($options{'reason'}) ) {
+
+    return 'Enter a new reason (or select an existing one)'
+      unless $options{'reason'}->{'reason'} !~ /^\s*$/;
+
+    my $reason = new FS::reason({
+      'reason_type' => $options{'reason'}->{'typenum'},
+      'reason'      => $options{'reason'}->{'reason'},
+    });
+    my $error = $reason->insert;
+    return $error if $error;
+
+    $reasonnum = $reason->reasonnum;
+
+  } else {
+    return "Unparsable reason: ". $options{'reason'};
+  }
 
   my $cust_pkg_reason =
     new FS::cust_pkg_reason({ 'pkgnum'    => $self->pkgnum,
 
   my $cust_pkg_reason =
     new FS::cust_pkg_reason({ 'pkgnum'    => $self->pkgnum,
-                              'reasonnum' => $options{'reason'}
+                              'reasonnum' => $reasonnum
                              'otaker'    => $otaker,
                              'otaker'    => $otaker,
+                             'action'    => substr(uc($options{'action'}),0,1),
                              'date'      => $options{'date'}
                                               ? $options{'date'}
                                               : time,
                            });
                              'date'      => $options{'date'}
                                               ? $options{'date'}
                                               : time,
                            });
-  return $cust_pkg_reason->insert;
+
+  $cust_pkg_reason->insert;
 }
 
 =item set_usage USAGE_VALUE_HASHREF 
 }
 
 =item set_usage USAGE_VALUE_HASHREF 
@@ -1576,11 +2335,11 @@ All svc_accts which are part of this package have their values reset.
 =cut
 
 sub set_usage {
 =cut
 
 sub set_usage {
-  my ($self, $valueref) = @_;
+  my ($self, $valueref, %opt) = @_;
 
   foreach my $cust_svc ($self->cust_svc){
     my $svc_x = $cust_svc->svc_x;
 
   foreach my $cust_svc ($self->cust_svc){
     my $svc_x = $cust_svc->svc_x;
-    $svc_x->set_usage($valueref)
+    $svc_x->set_usage($valueref, %opt)
       if $svc_x->can("set_usage");
   }
 }
       if $svc_x->can("set_usage");
   }
 }