work around bug in pre-perl5.10 which is at best noisy and at worst missorting

[freeside.git] / FS / FS / cust_pkg.pm

diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index bc6e46b..d32ad1b 100644 (file)
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -216,7 +216,7 @@ sub insert {
              ' 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 =
           $referring_cust_main->
             credit( $amount,
@@ -483,9 +483,12 @@ sub cancel {
   my $date = $options{date} if $options{date}; # expire/cancel later
   $date = '' if ($date && $date <= time);      # complain instead?
 
+  my $cancel_time = $options{'time'} || time;
+
   if ($options{'reason'}) {
     $error = $self->insert_reason( 'reason' => $options{'reason'},
                                    'action' => $date ? 'expire' : 'cancel',
+                                   'date'   => $date ? $date : $cancel_time,
                                    'reason_otaker' => $options{'reason_otaker'},
                                  );
     if ( $error ) {
@@ -530,7 +533,7 @@ sub cancel {
   }
 
   my %hash = $self->hash;
-  $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = time);
+  $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time);
   my $new = new FS::cust_pkg ( \%hash );
   $error = $new->replace( $self, options => { $self->options } );
   if ( $error ) {
@@ -660,9 +663,12 @@ sub suspend {
     return "Package $pkgnum expires before it would be suspended.";     
   }
 
+  my $suspend_time = $options{'time'} || time;
+
   if ($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 ) {
@@ -672,6 +678,9 @@ sub suspend {
   }
 
   unless ( $date ) {
+
+    my @labels = ();
+
     foreach my $cust_svc (
       qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
     ) {
@@ -691,12 +700,43 @@ sub suspend {
           $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";
+      }
+
+    }
+
   }
 
   my %hash = $self->hash;
-  $date ? ($hash{'adjourn'} = $date) : ($hash{'susp'} = time);
+  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 ) {
@@ -786,7 +826,7 @@ sub unsuspend {
 
   $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
     if ( $opt{'adjust_next_bill'}
-         || $conf->config('unsuspend-always_adjust_next_bill_date') )
+         || $conf->exists('unsuspend-always_adjust_next_bill_date') )
     && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} );
 
   $hash{'susp'} = '';
@@ -1133,8 +1173,12 @@ sub h_cust_svc {
 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] }
-  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     } );
@@ -1760,7 +1804,7 @@ active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
 
 =item pkgpart
 
-list specified how?
+pkgpart or arrayref or hashref of pkgparts
 
 =item setup
 
@@ -1886,9 +1930,24 @@ sub search_sql {
   # 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). ')' if scalar(@pkgpart);
+
+  } elsif ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
+    push @where, "pkgpart = $1";
+  } 
 
   ###
   # parse dates
@@ -2113,6 +2172,24 @@ sub order {
       $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;
@@ -2258,11 +2335,11 @@ All svc_accts which are part of this package have their values reset.
 =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;
-    $svc_x->set_usage($valueref)
+    $svc_x->set_usage($valueref, %opt)
       if $svc_x->can("set_usage");
   }
 }