Merge branch 'master' of git.freeside.biz:/home/git/freeside

8 files changed, 93 insertions, 60 deletions

diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm
index ad60b21..bcfbbc7 100644
--- a/FS/FS/cust_bill.pm
+++ b/FS/FS/cust_bill.pm
@@ -1059,7 +1059,7 @@ sub send {
 
   $self->email($opt)
     if ( grep { $_ !~ /^(POST|FAX)$/ } @invoicing_list or !@invoicing_list )
-    && ! $self->invoice_noemail;
+    && ! $cust_main->invoice_noemail;
 
   $self->print($opt)
     if grep { $_ eq 'POST' } @invoicing_list; #postal
diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm
index 9eb624e..df2a6cc 100644
--- a/FS/FS/cust_credit.pm
+++ b/FS/FS/cust_credit.pm
@@ -172,16 +172,23 @@ sub insert {
   my $cust_main = qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
   my $old_balance = $cust_main->balance;
 
-  unless ($self->reasonnum) {
-    my $result = $self->reason( $self->getfield('reason'),
-                                exists($options{ 'reason_type' })
-                                  ? ('reason_type' => $options{ 'reason_type' })
-                                  : (),
-                              );
-    unless($result) {
+  if (!$self->reasonnum) {
+    my $reason_text = $self->get('reason')
+      or return "reason text or existing reason required";
+    my $reason_type = $options{'reason_type'}
+      or return "reason type required";
+
+    local $@;
+    my $reason = FS::reason->new_or_existing(
+      reason => $reason_text,
+      type   => $reason_type,
+      class  => 'R',
+    );
+    if ($@) {
       $dbh->rollback if $oldAutoCommit;
-      return "failed to set reason for $me"; #: ". $dbh->errstr;
+      return "failed to set credit reason: $@";
     }
+    $self->set('reasonnum', $reason->reasonnum);
   }
 
   $self->setfield('reason', '');
diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index 5e070e3..b51c955 100644
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -1424,6 +1424,21 @@ are mandatory.
 
 =cut
 
+# Implementation note:
+#
+# If you pkgpart-change a package that has been billed, and it's set to give
+# credit on package change, then this method gets called and then the new
+# package will have no last_bill date. Therefore the customer will be credited
+# only once (per billing period) even if there are multiple package changes.
+#
+# If you location-change a package that has been billed, this method will NOT
+# be called and the new package WILL have the last bill date of the old
+# package.
+#
+# If the new package is then canceled within the same billing cycle, 
+# credit_remaining needs to run calc_remain on the OLD package to determine
+# the amount of unused time to credit.
+
 sub credit_remaining {
   # Add a credit for remaining service
   my ($self, $mode, $time) = @_;
@@ -1441,10 +1456,29 @@ sub credit_remaining {
       and $next_bill >= $time # which is in the future
   ) {
     my @cust_credit_source_bill_pkg = ();
-    my $remaining_value = $self->calc_remain(
+    my $remaining_value = 0;
+
+    my $remain_pkg = $self;
+    $remaining_value = $remain_pkg->calc_remain(
       'time' => $time, 
       'cust_credit_source_bill_pkg' => \@cust_credit_source_bill_pkg,
     );
+
+    # we may have to walk back past some package changes to get to the 
+    # one that actually has unused time
+    while ( $remaining_value == 0 ) {
+      if ( $remain_pkg->change_pkgnum ) {
+        $remain_pkg = FS::cust_pkg->by_key($remain_pkg->change_pkgnum);
+      } else {
+        # the package has really never been billed
+        return;
+      }
+      $remaining_value = $remain_pkg->calc_remain(
+        'time' => $time, 
+        'cust_credit_source_bill_pkg' => \@cust_credit_source_bill_pkg,
+      );
+    }
+
     if ( $remaining_value > 0 ) {
       warn "Crediting for $remaining_value on package ".$self->pkgnum."\n"
         if $DEBUG;
diff --git a/FS/FS/reason.pm b/FS/FS/reason.pm
index f28989a..864804d 100644
--- a/FS/FS/reason.pm
+++ b/FS/FS/reason.pm
@@ -152,7 +152,8 @@ sub reasontype {
 
 Fetches the reason matching these parameters if there is one.  If not,
 inserts one.  Will also insert the reason type if necessary.  CLASS must
-be one of 'C' (cancel reasons), 'R' (credit reasons), or 'S' (suspend reasons).
+be one of 'C' (cancel reasons), 'R' (credit reasons), 'S' (suspend reasons),
+or 'F' (refund reasons).
 
 This will die if anything fails.
 
@@ -163,14 +164,25 @@ sub new_or_existing {
   my %opt = @_;
 
   my $error = '';
-  my %hash = ('class' => $opt{'class'}, 'type' => $opt{'type'});
-  my $reason_type = qsearchs('reason_type', \%hash)
-                    || FS::reason_type->new(\%hash);
+  my $reason_type;
+  if ( ref $opt{type} eq 'FS::reason_type' ) {
+    $reason_type = $opt{type};
+  } elsif ( $opt{type} =~ /^\d+$/ ) {
+    $reason_type = FS::reason_type->by_key($opt{type});
+    if (!$reason_type) {
+      die "reason_type #$opt{type} not found\n";
+    }
+  } else {
+    my %hash = ('class' => $opt{'class'}, 'type' => $opt{'type'});
+    my $reason_type = qsearchs('reason_type', \%hash)
+                      || FS::reason_type->new(\%hash);
 
-  $error = $reason_type->insert unless $reason_type->typenum;
-  die "error inserting reason type: $error\n" if $error;
+    $error = $reason_type->insert unless $reason_type->typenum;
+    die "error inserting reason type: $error\n" if $error;
+  }
 
-  %hash = ('reason_type' => $reason_type->typenum, 'reason' => $opt{'reason'});
+  my %hash = ('reason_type' => $reason_type->typenum,
+              'reason' => $opt{'reason'});
   my $reason = qsearchs('reason', \%hash)
                || FS::reason->new(\%hash);
 
diff --git a/FS/FS/reason_Mixin.pm b/FS/FS/reason_Mixin.pm
index fdf7962..a397541 100644
--- a/FS/FS/reason_Mixin.pm
+++ b/FS/FS/reason_Mixin.pm
@@ -5,6 +5,7 @@ use Carp qw( croak ); #confess );
 use FS::Record qw( qsearch qsearchs dbdef );
 use FS::access_user;
 use FS::UID qw( dbh );
+use FS::reason;
 
 our $DEBUG = 0;
 our $me = '[FS::reason_Mixin]';
@@ -17,49 +18,23 @@ Returns the text of the associated reason (see L<FS::reason>) for this credit.
 
 sub reason {
   my ($self, $value, %options) = @_;
-  my $dbh = dbh;
-  my $reason;
-  my $typenum = $options{'reason_type'};
-
-  my $oldAutoCommit = $FS::UID::AutoCommit;  # this should already be in
-  local $FS::UID::AutoCommit = 0;            # a transaction if it matters
-
-  if ( defined( $value ) ) {
-    my $hashref = { 'reason' => $value };
-    $hashref->{'reason_type'} = $typenum if $typenum;
-    my $addl_from = "LEFT JOIN reason_type ON ( reason_type = typenum ) ";
-    my $extra_sql = " AND reason_type.class='F'";
-
-    $reason = qsearchs( { 'table'     => 'reason',
-                          'hashref'   => $hashref,
-                          'addl_from' => $addl_from,
-                          'extra_sql' => $extra_sql,
-                       } );
-
-    if (!$reason && $typenum) {
-      $reason = new FS::reason( { 'reason_type' => $typenum,
-                                  'reason' => $value,
-                                  'disabled' => 'Y',
-                              } );
-      my $error = $reason->insert;
-      if ( $error ) {
-        warn "error inserting reason: $error\n";
-        $reason = undef;
-      }
-    }
-
-    $self->reasonnum($reason ? $reason->reasonnum : '') ;
-    warn "$me reason used in set mode with non-existant reason -- clearing"
-      unless $reason;
+  my $reason_text;
+  if ( $self->reasonnum ) {
+    my $reason = FS::reason->by_key($self->reasonnum);
+    $reason_text = $reason->reason;
+  } else { # in case one of these somehow still exists
+    $reason_text = $self->get('reason');
+  }
+  if ( $self->get('addlinfo') ) {
+    $reason_text .= ' ' . $self->get('addlinfo');
   }
-  $reason = qsearchs( 'reason', { 'reasonnum' => $self->reasonnum } );
-
-  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
-  ( $reason ? $reason->reason : '' ).
-  ( $self->addlinfo ? ' '.$self->addlinfo : '' );
+  return $reason_text;
 }
 
+# it was a mistake to allow setting the reason this way; use 
+# FS::reason->new_or_existing
+ 
 # Used by FS::Upgrade to migrate reason text fields to reasonnum.
 sub _upgrade_reasonnum {  # class method
   my $class = shift;
diff --git a/httemplate/edit/cust_refund.cgi b/httemplate/edit/cust_refund.cgi
index 9f7ac8d..f9095fd 100755
--- a/httemplate/edit/cust_refund.cgi
+++ b/httemplate/edit/cust_refund.cgi
@@ -109,7 +109,7 @@
 <& /elements/tr-select-reason.html,
               'field'          => 'reasonnum',
               'reason_class'   => 'F',
-              'control_button' => "document.getElementById('confirm_refund_button')",
+              'control_button' => "confirm_refund_button",
               'cgi'            => $cgi,
 &>
 
diff --git a/httemplate/edit/process/cust_refund.cgi b/httemplate/edit/process/cust_refund.cgi
index bde4072..599c8b8 100755
--- a/httemplate/edit/process/cust_refund.cgi
+++ b/httemplate/edit/process/cust_refund.cgi
@@ -41,8 +41,13 @@ push @rights, 'Refund Echeck payment'      if $payby eq 'CHEK';
 die "access denied"
   unless $FS::CurrentUser::CurrentUser->access_right(\@rights);
 
-my $error = '';
-if ( $payby =~ /^(CARD|CHEK)$/ ) { 
+$cgi->param('reasonnum') =~ /^(-?\d+)$/ or die "Illegal reasonnum";
+my ($reasonnum, $error) = $m->comp('/misc/process/elements/reason');
+$cgi->param('reasonnum', $reasonnum) unless $error;
+
+if ( $error ) {
+  # do nothing
+} elsif ( $payby =~ /^(CARD|CHEK)$/ ) { 
   my %options = ();
   my $bop = $FS::payby::payby2bop{$1};
   $cgi->param('refund') =~ /^(\d*)(\.\d{2})?$/
diff --git a/httemplate/view/cust_main/payment_history.html b/httemplate/view/cust_main/payment_history.html
index fcc4470..a8f2f86 100644
--- a/httemplate/view/cust_main/payment_history.html
+++ b/httemplate/view/cust_main/payment_history.html
@@ -97,7 +97,7 @@
                'action'      => "${p}edit/cust_refund.cgi?popup=1;payby=BILL",
                'cust_main'   => $cust_main,
                'actionlabel' => emt('Enter check refund'),
-               'width'       => 392,
+               'width'       => 440,
   &>
 % }