fix multiple pkgpart search, RT#5924
[freeside.git] / FS / FS / cust_pkg.pm
index b84eda1..4e57fbf 100644 (file)
@@ -2,9 +2,11 @@ package FS::cust_pkg;
 
 use strict;
 use vars qw(@ISA $disable_agentcheck $DEBUG);
 
 use strict;
 use vars qw(@ISA $disable_agentcheck $DEBUG);
+use Carp qw(cluck);
 use Scalar::Util qw( blessed );
 use List::Util qw(max);
 use Tie::IxHash;
 use Scalar::Util qw( blessed );
 use List::Util qw(max);
 use Tie::IxHash;
+use MIME::Entity;
 use FS::UID qw( getotaker dbh );
 use FS::Misc qw( send_email );
 use FS::Record qw( qsearch qsearchs );
 use FS::UID qw( getotaker dbh );
 use FS::Misc qw( send_email );
 use FS::Record qw( qsearch qsearchs );
@@ -13,9 +15,10 @@ use FS::cust_main_Mixin;
 use FS::cust_svc;
 use FS::part_pkg;
 use FS::cust_main;
 use FS::cust_svc;
 use FS::part_pkg;
 use FS::cust_main;
-use FS::type_pkgs;
+use FS::cust_location;
 use FS::pkg_svc;
 use FS::cust_bill_pkg;
 use FS::pkg_svc;
 use FS::cust_bill_pkg;
+use FS::cust_pkg_detail;
 use FS::cust_event;
 use FS::h_cust_svc;
 use FS::reg_code;
 use FS::cust_event;
 use FS::h_cust_svc;
 use FS::reg_code;
@@ -103,38 +106,88 @@ inherits from FS::Record.  The following fields are currently supported:
 
 =over 4
 
 
 =over 4
 
-=item pkgnum - primary key (assigned automatically for new billing items)
+=item pkgnum
 
 
-=item custnum - Customer (see L<FS::cust_main>)
+Primary key (assigned automatically for new billing items)
 
 
-=item pkgpart - Billing item definition (see L<FS::part_pkg>)
+=item custnum
 
 
-=item setup - date
+Customer (see L<FS::cust_main>)
 
 
-=item bill - date (next bill date)
+=item pkgpart
+
+Billing item definition (see L<FS::part_pkg>)
+
+=item locationnum
+
+Optional link to package location (see L<FS::location>)
+
+=item start_date
+
+date
+
+=item setup
+
+date
+
+=item bill
+
+date (next bill date)
+
+=item last_bill
+
+last bill date
 
 
-=item last_bill - last bill date
+=item adjourn
 
 
-=item adjourn - date
+date
 
 
-=item susp - date
+=item susp
 
 
-=item expire - date
+date
 
 
-=item cancel - date
+=item expire
 
 
-=item otaker - order taker (assigned automatically if null, see L<FS::UID>)
+date
+
+=item cancel
 
 
-=item manual_flag - If this field is set to 1, disables the automatic
-unsuspension of this package when using the B<unsuspendauto> config file.
+date
 
 
-=item quantity - If not set, defaults to 1
+=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
+unsuspension of this package when using the B<unsuspendauto> config option.
+
+=item quantity
+
+If not set, defaults to 1
+
+=item change_date
+
+Date of change from previous package
+
+=item change_pkgnum
+
+Previous pkgnum
+
+=item change_pkgpart
+
+Previous pkgpart
+
+=item change_locationnum
+
+Previous locationnum
 
 =back
 
 
 =back
 
-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.
+Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date
+are specified as UNIX timestamps; see L<perlfunc/"time">.  Also see
+L<Time::Local> and L<Date::Parse> for conversion functions.
 
 =head1 METHODS
 
 
 =head1 METHODS
 
@@ -169,9 +222,27 @@ 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.
 
 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:
+
+=over 4
+
+=item change
+
+If set true, supresses any referral credit to a referring customer.
 
 
-I<change>, if set true, supresses any referral credit to a referring customer.
+=item options
+
+cust_pkg_option records will be created
+
+=item ticket_subject
+
+a ticket will be added to this customer with this subject
+
+=item ticket_queue
+
+an optional queue name for ticket additions
+
+=back
 
 =cut
 
 
 =cut
 
@@ -212,41 +283,28 @@ sub insert {
   #}
 
   my $conf = new FS::Conf;
   #}
 
   my $conf = new FS::Conf;
-  my $cust_main = $self->cust_main;
-  my $part_pkg = $self->part_pkg;
-  if ( $conf->exists('referral_credit')
-       && $cust_main->referral_custnum
-       && ! $options{'change'}
-       && $part_pkg->freq !~ /^0\D?$/
-     )
-  {
-    my $referring_cust_main = $cust_main->referring_cust_main;
-    if ( $referring_cust_main->status ne 'cancelled' ) {
-      my $error;
-      if ( $part_pkg->freq !~ /^\d+$/ ) {
-        warn 'WARNING: Not crediting customer '. $cust_main->referral_custnum.
-             ' for package '. $self->pkgnum.
-             ' ( customer '. $self->custnum. ')'.
-             ' - One-time referral credits not (yet) available for '.
-             ' packages with '. $part_pkg->freq_pretty. ' frequency';
-      } else {
 
 
-        my $amount = sprintf( "%.2f", $part_pkg->base_recur / $part_pkg->freq );
-        my $error =
-          $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.
-               " for referral: $error";
-        }
-
-      }
-
-    }
+  if ( $conf->config('ticket_system') && $options{ticket_subject} ) {
+    eval '
+      use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" );
+      use RT;
+    ';
+    die $@ if $@;
+
+    RT::LoadConfig();
+    RT::Init();
+    my $q = new RT::Queue($RT::SystemUser);
+    $q->Load($options{ticket_queue}) if $options{ticket_queue};
+    my $t = new RT::Ticket($RT::SystemUser);
+    my $mime = new MIME::Entity;
+    $mime->build( Type => 'text/plain', Data => $options{ticket_subject} );
+    $t->Create( $options{ticket_queue} ? (Queue => $q) : (),
+                Subject => $options{ticket_subject},
+                MIMEObj => $mime,
+              );
+    $t->AddLink( Type   => 'MemberOf',
+                 Target => 'freeside://freeside/cust_main/'. $self->custnum,
+               );
   }
 
   if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
   }
 
   if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
@@ -282,7 +340,7 @@ the customer ever purchased the item.  Instead, see the cancel method.
 #  return "Can't delete cust_pkg records!";
 #}
 
 #  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.
 
 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 returns the error, otherwise returns false.
@@ -299,7 +357,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).
 
 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
 
 
 =cut
 
@@ -340,9 +414,12 @@ sub replace {
 
   foreach my $method ( qw(adjourn expire) ) {  # How many reasons?
     if ($options->{'reason'} && $new->$method && $old->$method ne $new->$method) {
 
   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";
       if ( $error ) {
         dbh->rollback if $oldAutoCommit;
         return "Error inserting cust_pkg_reason: $error";
@@ -399,10 +476,14 @@ replace methods.
 sub check {
   my $self = shift;
 
 sub check {
   my $self = shift;
 
+  $self->locationnum('') if !$self->locationnum || $self->locationnum == -1;
+
   my $error = 
     $self->ut_numbern('pkgnum')
     || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
     || $self->ut_numbern('pkgpart')
   my $error = 
     $self->ut_numbern('pkgnum')
     || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
     || $self->ut_numbern('pkgpart')
+    || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
+    || $self->ut_numbern('start_date')
     || $self->ut_numbern('setup')
     || $self->ut_numbern('bill')
     || $self->ut_numbern('susp')
     || $self->ut_numbern('setup')
     || $self->ut_numbern('bill')
     || $self->ut_numbern('susp')
@@ -436,10 +517,10 @@ sub check {
     unless ( $disable_agentcheck ) {
       my $agent =
         qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } );
     unless ( $disable_agentcheck ) {
       my $agent =
         qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } );
-      my $pkgpart_href = $agent->pkgpart_hashref;
-      return "agent ". $agent->agentnum.
+      return "agent ". $agent->agentnum. ':'. $agent->agent.
              " can't purchase pkgpart ". $self->pkgpart
              " can't purchase pkgpart ". $self->pkgpart
-        unless $pkgpart_href->{ $self->pkgpart };
+        unless $agent->pkgpart_hashref->{ $self->pkgpart }
+            || $agent->agentnum == $self->part_pkg->agentnum;
     }
 
     $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' );
     }
 
     $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' );
@@ -477,6 +558,10 @@ 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 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)
+
+=item nobill - can be set true to skip billing if it might otherwise be done.
+
 =back
 
 If there is an error, returns the error, otherwise returns false.
 =back
 
 If there is an error, returns the error, otherwise returns false.
@@ -485,6 +570,9 @@ If there is an error, returns the error, otherwise returns false.
 
 sub cancel {
   my( $self, %options ) = @_;
 
 sub cancel {
   my( $self, %options ) = @_;
+  my $error;
+
+  my $conf = new FS::Conf;
 
   warn "cust_pkg::cancel called with options".
        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 
   warn "cust_pkg::cancel called with options".
        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
@@ -501,12 +589,37 @@ sub cancel {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
   
   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?
+
+  #race condition: usage could be ongoing until unprovisioned
+  #resolved by performing a change package instead (which unprovisions) and
+  #later cancelling
+  if ( !$options{nobill} && !$date && $conf->exists('bill_usage_on_cancel') ) {
+      my $error =
+        $self->cust_main->bill( pkg_list => [ $self ], cancel => 1 );
+      warn "Error billing during cancel, custnum ".
+        #$self->cust_main->custnum. ": $error"
+        ": $error"
+        if $error;
+  }
+
+
+  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";
@@ -514,27 +627,26 @@ 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";
+      }
     }
     }
-  }
 
 
-  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'} ) {
     # Add a credit for remaining service
     my $remaining_value = $self->calc_remain(time=>$cancel_time);
     if ( $remaining_value > 0 && !$options{'no_credit'} ) {
-      my $conf = new FS::Conf;
       my $error = $self->cust_main->credit(
         $remaining_value,
         'Credit for unused time on '. $self->part_pkg->pkg,
       my $error = $self->cust_main->credit(
         $remaining_value,
         'Credit for unused time on '. $self->part_pkg->pkg,
@@ -543,27 +655,27 @@ sub cancel {
       if ($error) {
         $dbh->rollback if $oldAutoCommit;
         return "Error crediting customer \$$remaining_value for unused time on".
       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;
   $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;
   if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) {
   my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
   if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) {
-    my $conf = new FS::Conf;
     my $error = send_email(
     my $error = send_email(
-      'from'    => $conf->config('invoice_from'),
+      'from'    => $conf->config('invoice_from', $self->cust_main->agentnum),
       'to'      => \@invoicing_list,
       'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
       'body'    => [ map "$_\n", $conf->config('cancelmessage') ],
       'to'      => \@invoicing_list,
       'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
       'body'    => [ map "$_\n", $conf->config('cancelmessage') ],
@@ -593,7 +705,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).
 
 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 +768,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 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.
 =back
 
 If there is an error, returns the error, otherwise returns false.
@@ -612,6 +778,7 @@ If there is an error, returns the error, otherwise returns false.
 
 sub suspend {
   my( $self, %options ) = @_;
 
 sub suspend {
   my( $self, %options ) = @_;
+  my $error;
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
@@ -624,48 +791,107 @@ sub suspend {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
   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.";
+  }
+
+  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', $self->cust_main->agentnum),
+                                   #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;
@@ -679,15 +905,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).
 
 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
 
 
-I<adjust_next_bill> can be set true to adjust the next bill date forward by
+=item adjust_next_bill
+
+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?
 
 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
 If there is an error, returns the error, otherwise returns false.
 
 =cut
@@ -707,6 +939,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 } )
   ) {
@@ -730,30 +975,244 @@ 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;
+
+  $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'} = '';
+  $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;
+
+  ''; #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 change HASHREF | OPTION => VALUE ... 
+
+Changes this package: cancels it and creates a new one, with a different
+pkgpart or locationnum or both.  All services are transferred to the new
+package (no change will be made if this is not possible).
+
+Options may be passed as a list of key/value pairs or as a hash reference.
+Options are:
+
+=over 4
+
+=item locaitonnum
+
+New locationnum, to change the location for this package.
+
+=item cust_location
+
+New FS::cust_location object, to create a new location and assign it
+to this package.
+
+=item pkgpart
+
+New pkgpart (see L<FS::part_pkg>).
+
+=item refnum
+
+New refnum (see L<FS::part_referral>).
+
+=back
+
+At least one option must be specified (otherwise, what's the point?)
+
+Returns either the new FS::cust_pkg object or a scalar error.
+
+For example:
+
+  my $err_or_new_cust_pkg = $old_cust_pkg->change
+
+=cut
+
+#some false laziness w/order
+sub change {
+  my $self = shift;
+  my $opt = ref($_[0]) ? shift : { @_ };
+
+#  my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
+#    
+
+  my $conf = new FS::Conf;
+
+  # 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 $error;
+
+  my %hash = (); 
+
+  my $time = time;
+
+  #$hash{$_} = $self->$_() foreach qw( last_bill bill );
+    
+  #$hash{$_} = $self->$_() foreach qw( setup );
+
+  $hash{'setup'} = $time if $self->setup;
+
+  $hash{'change_date'} = $time;
+  $hash{"change_$_"}  = $self->$_()
+    foreach qw( pkgnum pkgpart locationnum );
+
+  if ( $opt->{'cust_location'} &&
+       ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) {
+    $error = $opt->{'cust_location'}->insert;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "inserting cust_location (transaction rolled back): $error";
+    }
+    $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
+  }
+
+  # Create the new package.
+  my $cust_pkg = new FS::cust_pkg {
+    custnum      => $self->custnum,
+    pkgpart      => ( $opt->{'pkgpart'}     || $self->pkgpart      ),
+    refnum       => ( $opt->{'refnum'}      || $self->refnum       ),
+    locationnum  => ( $opt->{'locationnum'} || $self->locationnum  ),
+    %hash,
+  };
+
+  $error = $cust_pkg->insert( 'change' => 1 );
+  if ($error) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
+  # Transfer services and cancel old package.
+
+  $error = $self->transfer($cust_pkg);
+  if ($error and $error == 0) {
+    # $old_pkg->transfer failed.
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
+  if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
+    warn "trying transfer again with change_svcpart option\n" if $DEBUG;
+    $error = $self->transfer($cust_pkg, 'change_svcpart'=>1 );
+    if ($error and $error == 0) {
+      # $old_pkg->transfer failed.
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
 
 
-    my $conf = new FS::Conf;
+  if ($error > 0) {
+    # Transfers were successful, but we still had services left on the old
+    # package.  We can't change the package under this circumstances, so abort.
+    $dbh->rollback if $oldAutoCommit;
+    return "Unable to transfer all services from package ". $self->pkgnum;
+  }
 
 
-    $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'} );
+  #reset usage if changing pkgpart
+  # AND usage rollover is off (otherwise adds twice, now and at package bill)
+  if ($self->pkgpart != $cust_pkg->pkgpart) {
+    my $part_pkg = $cust_pkg->part_pkg;
+    $error = $part_pkg->reset_usage($cust_pkg, $part_pkg->is_prepaid
+                                                 ? ()
+                                                 : ( 'null' => 1 )
+                                   )
+      if $part_pkg->can('reset_usage') && ! $part_pkg->option('usage_rollover');
 
 
-    $hash{'susp'} = '';
-    $hash{'adjourn'} = '' if $hash{'adjourn'} < time;
-    my $new = new FS::cust_pkg ( \%hash );
-    $error = $new->replace( $self, options => { $self->options } );
-    if ( $error ) {
+    if ($error) {
       $dbh->rollback if $oldAutoCommit;
       $dbh->rollback if $oldAutoCommit;
-      return $error;
+      return "Error setting usage values: $error";
     }
   }
 
     }
   }
 
+  #Good to go, cancel old package.
+  $error = $self->cancel( quiet=>1 );
+  if ($error) {
+    $dbh->rollback;
+    return $error;
+  }
+
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  $cust_pkg;
 
 
-  ''; #no errors
 }
 
 =item last_bill
 }
 
 =item last_bill
@@ -772,30 +1231,37 @@ 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_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 {
 
 =cut
 
 sub last_cust_pkg_reason {
-  my $self = shift;
+  my ( $self, $action ) = ( shift, shift );
+  my $date = $self->get($action);
   qsearchs( {
               'table' => 'cust_pkg_reason',
   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 {
 
 =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;
 }
   $cust_pkg_reason->reason
     if $cust_pkg_reason;
 }
@@ -809,10 +1275,9 @@ L<FS::part_pkg>).
 
 sub part_pkg {
   my $self = shift;
 
 sub part_pkg {
   my $self = shift;
-  #exists( $self->{'_pkgpart'} )
-  $self->{'_pkgpart'}
-    ? $self->{'_pkgpart'}
-    : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
+  return $self->{'_pkgpart'} if $self->{'_pkgpart'};
+  cluck "cust_pkg->part_pkg called" if $DEBUG > 1;
+  qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
 }
 
 =item old_cust_pkg
 }
 
 =item old_cust_pkg
@@ -886,6 +1351,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_event
 
 Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
 =item cust_event
 
 Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
@@ -931,11 +1467,15 @@ services.
 sub cust_svc {
   my $self = shift;
 
 sub cust_svc {
   my $self = shift;
 
+  return () unless $self->num_cust_svc(@_);
+
   if ( @_ ) {
     return qsearch( 'cust_svc', { 'pkgnum'  => $self->pkgnum,
                                   'svcpart' => shift,          } );
   }
 
   if ( @_ ) {
     return qsearch( 'cust_svc', { 'pkgnum'  => $self->pkgnum,
                                   'svcpart' => shift,          } );
   }
 
+  cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
+
   #if ( $self->{'_svcnum'} ) {
   #  values %{ $self->{'_svcnum'}->cache };
   #} else {
   #if ( $self->{'_svcnum'} ) {
   #  values %{ $self->{'_svcnum'}->cache };
   #} else {
@@ -956,7 +1496,8 @@ is specified, return only the matching services.
 
 sub overlimit {
   my $self = shift;
 
 sub overlimit {
   my $self = shift;
-  grep { $_->overlimit } $self->cust_svc;
+  return () unless $self->num_cust_svc(@_);
+  grep { $_->overlimit } $self->cust_svc(@_);
 }
 
 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ] 
 }
 
 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ] 
@@ -1005,9 +1546,19 @@ specified, counts only the matching services.
 
 sub num_cust_svc {
   my $self = shift;
 
 sub num_cust_svc {
   my $self = shift;
+
+  return $self->{'_num_cust_svc'}
+    if !scalar(@_)
+       && exists($self->{'_num_cust_svc'})
+       && $self->{'_num_cust_svc'} =~ /\d/;
+
+  cluck "cust_pkg->num_cust_svc called, _num_cust_svc:".$self->{'_num_cust_svc'}
+    if $DEBUG > 2;
+
   my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?';
   $sql .= ' AND svcpart = ?' if @_;
   my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?';
   $sql .= ' AND svcpart = ?' if @_;
-  my $sth = dbh->prepare($sql) or die dbh->errstr;
+
+  my $sth = dbh->prepare($sql)     or die  dbh->errstr;
   $sth->execute($self->pkgnum, @_) or die $sth->errstr;
   $sth->fetchrow_arrayref->[0];
 }
   $sth->execute($self->pkgnum, @_) or die $sth->errstr;
   $sth->fetchrow_arrayref->[0];
 }
@@ -1064,7 +1615,8 @@ sub part_svc {
     $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
     $part_svc->{'Hash'}{'num_avail'}    =
       max( 0, $pkg_svc->quantity - $num_cust_svc );
     $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
     $part_svc->{'Hash'}{'num_avail'}    =
       max( 0, $pkg_svc->quantity - $num_cust_svc );
-    $part_svc->{'Hash'}{'cust_pkg_svc'} = [ $self->cust_svc($part_svc->svcpart) ];
+    $part_svc->{'Hash'}{'cust_pkg_svc'} =
+      $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
     $part_svc;
   } $self->part_pkg->pkg_svc;
 
     $part_svc;
   } $self->part_pkg->pkg_svc;
 
@@ -1074,7 +1626,8 @@ sub part_svc {
     my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
     $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
     $part_svc->{'Hash'}{'num_avail'}    = 0; #0-$num_cust_svc ?
     my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
     $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
     $part_svc->{'Hash'}{'num_avail'}    = 0; #0-$num_cust_svc ?
-    $part_svc->{'Hash'}{'cust_pkg_svc'} = [ $self->cust_svc($part_svc->svcpart) ];
+    $part_svc->{'Hash'}{'cust_pkg_svc'} =
+      $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
     $part_svc;
   } $self->extra_part_svc;
 
     $part_svc;
   } $self->extra_part_svc;
 
@@ -1096,20 +1649,38 @@ sub extra_part_svc {
   my $pkgnum  = $self->pkgnum;
   my $pkgpart = $self->pkgpart;
 
   my $pkgnum  = $self->pkgnum;
   my $pkgpart = $self->pkgpart;
 
+#  qsearch( {
+#    'table'     => 'part_svc',
+#    'hashref'   => {},
+#    'extra_sql' =>
+#      "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc 
+#                     WHERE pkg_svc.svcpart = part_svc.svcpart 
+#                       AND pkg_svc.pkgpart = ?
+#                       AND quantity > 0 
+#                 )
+#       AND 0 < ( SELECT COUNT(*) FROM cust_svc
+#                       LEFT JOIN cust_pkg USING ( pkgnum )
+#                     WHERE cust_svc.svcpart = part_svc.svcpart
+#                       AND pkgnum = ?
+#                 )",
+#    'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
+#  } );
+
+#seems to benchmark slightly faster...
   qsearch( {
   qsearch( {
-    'table'     => 'part_svc',
-    'hashref'   => {},
-    'extra_sql' => "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc 
-                                  WHERE pkg_svc.svcpart = part_svc.svcpart 
-                                   AND pkg_svc.pkgpart = $pkgpart
-                                   AND quantity > 0 
-                             )
-                     AND 0 < ( SELECT count(*)
-                                 FROM cust_svc
-                                   LEFT JOIN cust_pkg using ( pkgnum )
-                                 WHERE cust_svc.svcpart = part_svc.svcpart
-                                   AND pkgnum = $pkgnum
-                             )",
+    'select'      => 'DISTINCT ON (svcpart) part_svc.*',
+    'table'       => 'part_svc',
+    'addl_from'   =>
+      'LEFT JOIN pkg_svc  ON (     pkg_svc.svcpart   = part_svc.svcpart 
+                               AND pkg_svc.pkgpart   = ?
+                               AND quantity > 0
+                             )
+       LEFT JOIN cust_svc ON (     cust_svc.svcpart = part_svc.svcpart )
+       LEFT JOIN cust_pkg USING ( pkgnum )
+      ',
+    'hashref'     => {},
+    'extra_sql'   => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ",
+    'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
   } );
 }
 
   } );
 }
 
@@ -1164,8 +1735,8 @@ tie my %statuscolor, 'Tie::IxHash',
 
 sub statuses {
   my $self = shift; #could be class...
 
 sub statuses {
   my $self = shift; #could be class...
-  grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
-                                      # mayble split btw one-time vs. recur
+  #grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
+  #                                    # mayble split btw one-time vs. recur
     keys %statuscolor;
 }
 
     keys %statuscolor;
 }
 
@@ -1180,6 +1751,63 @@ sub statuscolor {
   $statuscolor{$self->status};
 }
 
   $statuscolor{$self->status};
 }
 
+=item pkg_label
+
+Returns a label for this package.  (Currently "pkgnum: pkg - comment" or
+"pkg-comment" depending on user preference).
+
+=cut
+
+sub pkg_label {
+  my $self = shift;
+  my $label = $self->part_pkg->pkg_comment( 'nopkgpart' => 1 );
+  $label = $self->pkgnum. ": $label"
+    if $FS::CurrentUser::CurrentUser->option('show_pkgnum');
+  $label;
+}
+
+=item pkg_label_long
+
+Returns a long label for this package, adding the primary service's label to
+pkg_label.
+
+=cut
+
+sub pkg_label_long {
+  my $self = shift;
+  my $label = $self->pkg_label;
+  my $cust_svc = $self->primary_cust_svc;
+  $label .= ' ('. ($cust_svc->label)[1]. ')' if $cust_svc;
+  $label;
+}
+
+=item primary_cust_svc
+
+Returns a primary service (as FS::cust_svc object) if one can be identified.
+
+=cut
+
+#for labeling purposes - might not 100% match up with part_pkg->svcpart's idea
+
+sub primary_cust_svc {
+  my $self = shift;
+
+  my @cust_svc = $self->cust_svc;
+
+  return '' unless @cust_svc; #no serivces - irrelevant then
+  
+  return $cust_svc[0] if scalar(@cust_svc) == 1; #always return a single service
+
+  # primary service as specified in the package definition
+  # or exactly one service definition with quantity one
+  my $svcpart = $self->part_pkg->svcpart;
+  @cust_svc = grep { $_->svcpart == $svcpart } @cust_svc;
+  return $cust_svc[0] if scalar(@cust_svc) == 1;
+
+  #couldn't identify one thing..
+  return '';
+}
+
 =item labels
 
 Returns a list of lists, calling the label method for all services
 =item labels
 
 Returns a list of lists, calling the label method for all services
@@ -1208,16 +1836,37 @@ sub h_labels {
   map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
 }
 
   map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
 }
 
+=item labels_short
+
+Like 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 labels_short {
+  shift->_labels_short( '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 {
 
 =cut
 
 sub h_labels_short {
-  my $self = shift;
+  shift->_labels_short( 'h_labels', @_ );
+}
+
+sub _labels_short {
+  my( $self, $method ) = ( shift, shift );
+
+  my $conf = new FS::Conf;
+  my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
 
   my %labels;
   #tie %labels, 'Tie::IxHash';
 
   my %labels;
   #tie %labels, 'Tie::IxHash';
@@ -1225,9 +1874,10 @@ sub h_labels_short {
     foreach $self->h_labels(@_);
   my @labels;
   foreach my $label ( keys %labels ) {
     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;
@@ -1249,6 +1899,30 @@ sub cust_main {
   qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 }
 
   qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 }
 
+=item cust_location
+
+Returns the location object, if any (see L<FS::cust_location>).
+
+=cut
+
+sub cust_location {
+  my $self = shift;
+  return '' unless $self->locationnum;
+  qsearchs( 'cust_location', { 'locationnum' => $self->locationnum } );
+}
+
+=item cust_location_or_main
+
+If this package is associated with a location, returns the locaiton (see
+L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>).
+
+=cut
+
+sub cust_location_or_main {
+  my $self = shift;
+  $self->cust_location || $self->cust_main;
+}
+
 =item seconds_since TIMESTAMP
 
 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
 =item seconds_since TIMESTAMP
 
 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
@@ -1539,6 +2213,18 @@ sub active_sql { "
   AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
 "; }
 
   AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
 "; }
 
+=item not_yet_billed_sql
+
+Returns an SQL expression identifying packages which have not yet been billed.
+
+=cut
+
+sub not_yet_billed_sql { "
+      ( cust_pkg.setup  IS NULL OR cust_pkg.setup  = 0 )
+  AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
+  AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
+"; }
+
 =item inactive_sql
 
 Returns an SQL expression identifying inactive packages (one-time packages
 =item inactive_sql
 
 Returns an SQL expression identifying inactive packages (one-time packages
@@ -1548,6 +2234,7 @@ that are otherwise unsuspended/uncancelled).
 
 sub inactive_sql { "
   ". $_[0]->onetime_sql(). "
 
 sub inactive_sql { "
   ". $_[0]->onetime_sql(). "
+  AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
   AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
 "; }
   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
   AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
 "; }
@@ -1583,6 +2270,8 @@ sub cancel_sql {
 
 =item search_sql HASHREF
 
 
 =item search_sql HASHREF
 
+(Class method)
+
 Returns a qsearch hash expression to search for parameters specified in HASHREF.
 Valid parameters are
 
 Returns a qsearch hash expression to search for parameters specified in HASHREF.
 Valid parameters are
 
@@ -1598,11 +2287,15 @@ active, inactive, suspended, cancel (or cancelled)
 
 active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
 
 
 active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
 
+=item custom
+
+ boolean selects custom packages
+
 =item classnum
 
 =item pkgpart
 
 =item classnum
 
 =item pkgpart
 
-list specified how?
+pkgpart or arrayref or hashref of pkgparts
 
 =item setup
 
 
 =item setup
 
@@ -1670,8 +2363,13 @@ sub search_sql {
 
     push @where, FS::cust_pkg->active_sql();
 
 
     push @where, FS::cust_pkg->active_sql();
 
-  } elsif (    $params->{'magic'}  eq 'inactive'
-            || $params->{'status'} eq 'inactive' ) {
+  } elsif (    $params->{'magic'}  eq 'not yet billed'
+            || $params->{'status'} eq 'not yet billed' ) {
+
+    push @where, FS::cust_pkg->not_yet_billed_sql();
+
+  } elsif (    $params->{'magic'}  =~ /^(one-time charge|inactive)/
+            || $params->{'status'} =~ /^(one-time charge|inactive)/ ) {
 
     push @where, FS::cust_pkg->inactive_sql();
 
 
     push @where, FS::cust_pkg->inactive_sql();
 
@@ -1685,10 +2383,6 @@ sub search_sql {
 
     push @where, FS::cust_pkg->cancelled_sql();
 
 
     push @where, FS::cust_pkg->cancelled_sql();
 
-  } elsif ( $params->{'status'} =~ /^(one-time charge|inactive)$/ ) {
-
-    push @where, FS::cust_pkg->inactive_sql();
-
   }
 
   ###
   }
 
   ###
@@ -1725,12 +2419,68 @@ sub search_sql {
   #eslaf
 
   ###
   #eslaf
 
   ###
+  # parse package report options
+  ###
+
+  my @report_option = ();
+  if ( exists($params->{'report_option'})
+       && $params->{'report_option'} =~ /^([,\d]*)$/
+     )
+  {
+    @report_option = split(',', $1);
+  }
+
+  if (@report_option) {
+    # this will result in the empty set for the dangling comma case as it should
+    push @where, 
+      map{ "0 < ( SELECT count(*) FROM part_pkg_option
+                    WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
+                    AND optionname = 'report_option_$_'
+                    AND optionvalue = '1' )"
+         } @report_option;
+  }
+
+  #eslaf
+
+  ###
+  # parse custom
+  ###
+
+  push @where,  "part_pkg.custom = 'Y'" if $params->{custom};
+
+  ###
+  # parse censustract
+  ###
+
+  if ( exists($params->{'censustract'}) ) {
+    $params->{'censustract'} =~ /^([.\d]*)$/;
+    my $censustract = "cust_main.censustract = '$1'";
+    $censustract .= ' OR cust_main.censustract is NULL' unless $1;
+    push @where,  "( $censustract )";
+  }
+
+  ###
   # parse part_pkg
   ###
 
   # parse part_pkg
   ###
 
-  my $pkgpart = join (' OR pkgpart=',
-                      grep {$_} map { /^(\d+)$/; } ($params->{'pkgpart'}));
-  push @where,  '(pkgpart=' . $pkgpart . ')' if $pkgpart;
+  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). ')';
+
+  } elsif ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
+    push @where, "pkgpart = $1";
+  } 
 
   ###
   # parse dates
 
   ###
   # parse dates
@@ -1845,6 +2595,97 @@ sub search_sql {
 
 }
 
 
 }
 
+=item location_sql
+
+Returns a list: the first item is an SQL fragment identifying matching 
+packages/customers via location (taking into account shipping and package
+address taxation, if enabled), and subsequent items are the parameters to
+substitute for the placeholders in that fragment.
+
+=cut
+
+sub location_sql {
+  my($class, %opt) = @_;
+  my $ornull = $opt{'ornull'};
+
+  my $conf = new FS::Conf;
+
+  # '?' placeholders in _location_sql_where
+  my @bill_param;
+  if ( $ornull ) {
+    @bill_param = qw( county county state state state country );
+  } else {
+    @bill_param = qw( county state state country );
+  }
+  unshift @bill_param, 'county'; # unless $nec;
+
+  my $main_where;
+  my @main_param;
+  if ( $conf->exists('tax-ship_address') ) {
+
+    $main_where = "(
+         (     ( ship_last IS NULL     OR  ship_last  = '' )
+           AND ". _location_sql_where('cust_main', '', $ornull ). "
+         )
+      OR (       ship_last IS NOT NULL AND ship_last != ''
+           AND ". _location_sql_where('cust_main', 'ship_', $ornull ). "
+         )
+    )";
+    #    AND payby != 'COMP'
+
+    @main_param = ( @bill_param, @bill_param );
+
+  } else {
+
+    $main_where = _location_sql_where('cust_main'); # AND payby != 'COMP'
+    @main_param = @bill_param;
+
+  }
+
+  my $where;
+  my @param;
+  if ( $conf->exists('tax-pkg_address') ) {
+
+    my $loc_where = _location_sql_where( 'cust_location', '', $ornull );
+
+    $where = " (
+                    ( cust_pkg.locationnum IS     NULL AND $main_where )
+                 OR ( cust_pkg.locationnum IS NOT NULL AND $loc_where  )
+               )
+             ";
+    @param = ( @main_param, @bill_param );
+  
+  } else {
+
+    $where = $main_where;
+    @param = @main_param;
+
+  }
+
+  ( $where, @param );
+
+}
+
+#subroutine, helper for location_sql
+sub _location_sql_where {
+  my $table  = shift;
+  my $prefix = @_ ? shift : '';
+  my $ornull = @_ ? shift : '';
+
+#  $ornull             = $ornull          ? " OR ( ? IS NULL AND $table.${prefix}county IS NULL ) " : '';
+
+  $ornull = $ornull ? ' OR ? IS NULL ' : '';
+
+  my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL ) ";
+  my $or_empty_state =  " OR ( ? = '' AND $table.${prefix}state  IS NULL ) ";
+
+  "
+        ( $table.${prefix}county  = ? $or_empty_county $ornull )
+    AND ( $table.${prefix}state   = ? $or_empty_state  $ornull )
+    AND   $table.${prefix}country = ?
+  ";
+}
+
 =head1 SUBROUTINES
 
 =over 4
 =head1 SUBROUTINES
 
 =over 4
@@ -1892,8 +2733,8 @@ sub order {
   my $dbh = dbh;
 
   my $error;
   my $dbh = dbh;
 
   my $error;
-  my $cust_main = qsearchs('cust_main', { custnum => $custnum });
-  return "Customer not found: $custnum" unless $cust_main;
+#  my $cust_main = qsearchs('cust_main', { custnum => $custnum });
+#  return "Customer not found: $custnum" unless $cust_main;
 
   my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
                          @$remove_pkgnum;
 
   my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
                          @$remove_pkgnum;
@@ -1903,15 +2744,19 @@ sub order {
   my %hash = (); 
   if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
 
   my %hash = (); 
   if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
 
-    my $time = time;
+    my $err_or_cust_pkg =
+      $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
+                                'refnum'  => $refnum,
+                              );
 
 
-    #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( last_bill bill );
-    
-    #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( setup );
-    $hash{'setup'} = $time if $old_cust_pkg[0]->setup;
+    unless (ref($err_or_cust_pkg)) {
+      $dbh->rollback if $oldAutoCommit;
+      return $err_or_cust_pkg;
+    }
+
+    push @$return_cust_pkg, $err_or_cust_pkg;
+    return '';
 
 
-    $hash{'change_date'} = $time;
-    $hash{"change_$_"}  = $old_cust_pkg[0]->$_() foreach qw( pkgnum pkgpart );
   }
 
   # Create the new packages.
   }
 
   # Create the new packages.
@@ -1972,30 +2817,12 @@ 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 ]
 
 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
 
+A bulk change method to change packages for multiple customers.
+
 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
 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
+L<FS::part_pkg>) to order for each customer.  Duplicates are of course
 permitted.
 
 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
 permitted.
 
 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
@@ -2050,10 +2877,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) = @_;
 
 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+)$/ ) {
 
   my $reasonnum;
   if ( $options{'reason'} =~ /^(\d+)$/ ) {
@@ -2082,6 +2942,7 @@ sub insert_reason {
     new FS::cust_pkg_reason({ 'pkgnum'    => $self->pkgnum,
                               'reasonnum' => $reasonnum, 
                              'otaker'    => $otaker,
     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,
                              'date'      => $options{'date'}
                                               ? $options{'date'}
                                               : time,
@@ -2101,11 +2962,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");
   }
 }