Merge branch 'master' of https://github.com/jgoodman/Freeside

(github pull request #24 -- change refunds to proper refunds)

7 files changed, 170 insertions, 106 deletions

diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm
index 4b165eb3f..4d9cff99e 100644
--- a/FS/FS/AccessRight.pm
+++ b/FS/FS/AccessRight.pm
@@ -230,6 +230,7 @@ tie my %rights, 'Tie::IxHash',
     'Refund Echeck payment',
     'Delete refund', #NEW
     'Add on-the-fly credit reason', #NEW
+    'Add on-the-fly refund reason', #NEW
   ],
   
   ###
diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
index a9fc13d95..bf756d129 100644
--- a/FS/FS/Schema.pm
+++ b/FS/FS/Schema.pm
@@ -2853,7 +2853,8 @@ sub tables_hashref {
         'currency',       'char', 'NULL',       3, '', '',
         'otaker',       'varchar',   'NULL',   32, '', '', 
         'usernum',   'int', 'NULL', '', '', '',
-        'reason',       'varchar',   '',   $char_d, '', '', 
+        'reason',       'varchar',   'NULL',   $char_d, '', '', 
+        'reasonnum',   'int', 'NULL', '', '', '',
         'payby',        'char',   '',     4, '', '', # CARD/BILL/COMP, should
                                                      # be index into payby
                                                      # table eventually
@@ -2877,6 +2878,9 @@ sub tables_hashref {
                           { columns    => [ 'usernum' ],
                             table      => 'access_user',
                           },
+                          { columns    => [ 'reasonnum' ],
+                            table      => 'reason',
+                          },
                           { columns    => [ 'gatewaynum' ],
                             table      => 'payment_gateway',
                           },
diff --git a/FS/FS/access_right.pm b/FS/FS/access_right.pm
index 0906c0c9a..d26db4895 100644
--- a/FS/FS/access_right.pm
+++ b/FS/FS/access_right.pm
@@ -244,6 +244,7 @@ sub _upgrade_data { # class method
     'Services: Accounts' => 'Services: Conferencing',
     'Services: Accounts' => 'Services: Video',
     'Edit global package definitions' => 'Edit package definition costs',
+    'Add on-the-fly credit reason' => 'Add on-the-fly refund reason',
   );
 
 #  foreach my $old_acl ( keys %onetime ) {
diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm
index 189084525..58bd475b1 100644
--- a/FS/FS/cust_credit.pm
+++ b/FS/FS/cust_credit.pm
@@ -1,5 +1,6 @@
 package FS::cust_credit;
-use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::Record );
+use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::reason_Mixin
+             FS::Record );
 
 use strict;
 use vars qw( $conf $unsuspendauto $me $DEBUG
@@ -447,57 +448,8 @@ sub credited {
 
 Returns the customer (see L<FS::cust_main>) for this credit.
 
-=item reason
-
-Returns the text of the associated reason (see L<FS::reason>) for this credit.
-
 =cut
 
-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='R'"; 
-
-    $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;
-  }
-  $reason = qsearchs( 'reason', { 'reasonnum' => $self->reasonnum } );
-
-  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
-  ( $reason ? $reason->reason : '' ).
-  ( $self->addlinfo ? ' '.$self->addlinfo : '' );
-}
-
 # _upgrade_data
 #
 # Used by FS::Upgrade to migrate to a new database.
@@ -507,56 +459,9 @@ sub _upgrade_data {  # class method
 
   warn "$me upgrading $class\n" if $DEBUG;
 
-  if (defined dbdef->table($class->table)->column('reason')) {
-
-    warn "$me Checking for unmigrated reasons\n" if $DEBUG;
-
-    my @cust_credits = qsearch({ 'table'     => $class->table,
-                                 'hashref'   => {},
-                                 'extra_sql' => 'WHERE reason IS NOT NULL',
-                              });
-
-    if (scalar(grep { $_->getfield('reason') =~ /\S/ } @cust_credits)) {
-      warn "$me Found unmigrated reasons\n" if $DEBUG;
-      my $hashref = { 'class' => 'R', 'type' => 'Legacy' };
-      my $reason_type = qsearchs( 'reason_type', $hashref );
-      unless ($reason_type) {
-        $reason_type  = new FS::reason_type( $hashref );
-        my $error   = $reason_type->insert();
-        die "$class had error inserting FS::reason_type into database: $error\n"
-          if $error;
-      }
+  $class->_upgrade_reasonnum(%opts);
 
-      $hashref = { 'reason_type' => $reason_type->typenum,
-                   'reason' => '(none)'
-                 };
-      my $noreason = qsearchs( 'reason', $hashref );
-      unless ($noreason) {
-        $hashref->{'disabled'} = 'Y';
-        $noreason = new FS::reason( $hashref );
-        my $error  = $noreason->insert();
-        die "can't insert legacy reason '(none)' into database: $error\n"
-          if $error;
-      }
-
-      foreach my $cust_credit ( @cust_credits ) {
-        my $reason = $cust_credit->getfield('reason');
-        warn "Contemplating reason $reason\n" if $DEBUG > 1;
-        if ($reason =~ /\S/) {
-          $cust_credit->reason($reason, 'reason_type' => $reason_type->typenum)
-            or die "can't insert legacy reason $reason into database\n";
-        }else{
-          $cust_credit->reasonnum($noreason->reasonnum);
-        }
-
-        $cust_credit->setfield('reason', '');
-        my $error = $cust_credit->replace;
-
-        warn "*** WARNING: error replacing reason in $class ".
-             $cust_credit->crednum. ": $error ***\n"
-          if $error;
-      }
-    }
+  if (defined dbdef->table($class->table)->column('reason')) {
 
     warn "$me Ensuring existance of auto reasons\n" if $DEBUG;
 
diff --git a/FS/FS/cust_refund.pm b/FS/FS/cust_refund.pm
index d29db5cfa..e3fc910ec 100644
--- a/FS/FS/cust_refund.pm
+++ b/FS/FS/cust_refund.pm
@@ -2,15 +2,22 @@ package FS::cust_refund;
 
 use strict;
 use base qw( FS::otaker_Mixin FS::payinfo_transaction_Mixin FS::cust_main_Mixin
-             FS::Record );
-use vars qw( @encrypted_fields );
+             FS::reason_Mixin FS::Record );
+use vars qw( @encrypted_fields $me $DEBUG $ignore_empty_reasonnum );
 use Business::CreditCard;
-use FS::Record qw( qsearch qsearchs dbh );
+use FS::Record qw( qsearch qsearchs dbh dbdef );
 use FS::CurrentUser;
 use FS::cust_credit;
 use FS::cust_credit_refund;
 use FS::cust_pay_refund;
 use FS::cust_main;
+use FS::reason_type;
+use FS::reason;
+
+$me = '[ FS::cust_refund ]';
+$DEBUG = 0;
+
+$ignore_empty_reasonnum = 0;
 
 @encrypted_fields = ('payinfo');
 sub nohistory_fields { ('payinfo'); }
@@ -56,7 +63,11 @@ Amount of the refund
 
 =item reason
 
-Reason for the refund
+Text stating the reason for the refund ( deprecated )
+
+=item reasonnum
+
+Reason (see L<FS::reason>)
 
 =item _date
 
@@ -119,7 +130,7 @@ amount of the refund will be created.  In both cases, custnum is optional.
 =cut
 
 sub insert {
-  my $self = shift;
+  my ($self, %options) = @_;
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
@@ -132,6 +143,20 @@ sub insert {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
+  unless ($self->reasonnum) {
+    my $result = $self->reason( $self->getfield('reason'),
+                                exists($options{ 'reason_type' })
+                                  ? ('reason_type' => $options{ 'reason_type' })
+                                  : (),
+                              );
+    unless($result) {
+      $dbh->rollback if $oldAutoCommit;
+      return "failed to set reason for $me"; #: ". $dbh->errstr;
+    }
+  }
+
+  $self->setfield('reason', '');
+
   if ( $self->crednum ) {
     my $cust_credit = qsearchs('cust_credit', { 'crednum' => $self->crednum } )
       or do {
@@ -274,13 +299,17 @@ sub check {
     || $self->ut_numbern('custnum')
     || $self->ut_money('refund')
     || $self->ut_alphan('otaker')
-    || $self->ut_text('reason')
+    || $self->ut_textn('reason')
     || $self->ut_numbern('_date')
     || $self->ut_textn('paybatch')
     || $self->ut_enum('closed', [ '', 'Y' ])
   ;
   return $error if $error;
 
+  my $method = $ignore_empty_reasonnum ? 'ut_foreign_keyn' : 'ut_foreign_key';
+  $error = $self->$method('reasonnum', 'reason', 'reasonnum');
+  return $error if $error;
+
   return "refund must be > 0 " if $self->refund <= 0;
 
   $self->_date(time) unless $self->_date;
@@ -380,6 +409,7 @@ sub unapplied_sql {
 # Used by FS::Upgrade to migrate to a new database.
 sub _upgrade_data {  # class method
   my ($class, %opts) = @_;
+  $class->_upgrade_reasonnum(%opts);
   $class->_upgrade_otaker(%opts);
 }
 
diff --git a/FS/FS/reason_Mixin.pm b/FS/FS/reason_Mixin.pm
new file mode 100644
index 000000000..fdf796219
--- /dev/null
+++ b/FS/FS/reason_Mixin.pm
@@ -0,0 +1,121 @@
+package FS::reason_Mixin;
+
+use strict;
+use Carp qw( croak ); #confess );
+use FS::Record qw( qsearch qsearchs dbdef );
+use FS::access_user;
+use FS::UID qw( dbh );
+
+our $DEBUG = 0;
+our $me = '[FS::reason_Mixin]';
+
+=item reason
+
+Returns the text of the associated reason (see L<FS::reason>) for this credit.
+
+=cut
+
+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;
+  }
+  $reason = qsearchs( 'reason', { 'reasonnum' => $self->reasonnum } );
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+  ( $reason ? $reason->reason : '' ).
+  ( $self->addlinfo ? ' '.$self->addlinfo : '' );
+}
+
+# Used by FS::Upgrade to migrate reason text fields to reasonnum.
+sub _upgrade_reasonnum {  # class method
+  my $class = shift;
+  my $table = $class->table;
+
+  if (defined dbdef->table($table)->column('reason')) {
+
+    warn "$me Checking for unmigrated reasons\n" if $DEBUG;
+
+    my @cust_refunds = qsearch({ 'table'     => $table,
+                                 'hashref'   => {},
+                                 'extra_sql' => 'WHERE reason IS NOT NULL',
+                              });
+
+    if (scalar(grep { $_->getfield('reason') =~ /\S/ } @cust_refunds)) {
+      warn "$me Found unmigrated reasons\n" if $DEBUG;
+      my $hashref = { 'class' => 'F', 'type' => 'Legacy' };
+      my $reason_type = qsearchs( 'reason_type', $hashref );
+      unless ($reason_type) {
+        $reason_type  = new FS::reason_type( $hashref );
+        my $error   = $reason_type->insert();
+        die "$class had error inserting FS::reason_type into database: $error\n"
+          if $error;
+      }
+
+      $hashref = { 'reason_type' => $reason_type->typenum,
+                   'reason' => '(none)'
+                 };
+      my $noreason = qsearchs( 'reason', $hashref );
+      unless ($noreason) {
+        $hashref->{'disabled'} = 'Y';
+        $noreason = new FS::reason( $hashref );
+        my $error  = $noreason->insert();
+        die "can't insert legacy reason '(none)' into database: $error\n"
+          if $error;
+      }
+
+      foreach my $cust_refund ( @cust_refunds ) {
+        my $reason = $cust_refund->getfield('reason');
+        warn "Contemplating reason $reason\n" if $DEBUG > 1;
+        if ($reason =~ /\S/) {
+          $cust_refund->reason($reason, 'reason_type' => $reason_type->typenum)
+            or die "can't insert legacy reason $reason into database\n";
+        }else{
+          $cust_refund->reasonnum($noreason->reasonnum);
+        }
+
+        $cust_refund->setfield('reason', '');
+        my $error = $cust_refund->replace;
+
+        warn "*** WARNING: error replacing reason in $class ".
+             $cust_refund->refundnum. ": $error ***\n"
+          if $error;
+      }
+    }
+  }
+}
+
+1;
diff --git a/FS/FS/reason_type.pm b/FS/FS/reason_type.pm
index a603809e2..00ac9a87e 100644
--- a/FS/FS/reason_type.pm
+++ b/FS/FS/reason_type.pm
@@ -10,12 +10,14 @@ our %class_name = (
   'C' => 'cancel',
   'R' => 'credit',
   'S' => 'suspend',
+  'F' => 'refund',
 );
 
 our %class_purpose = (  
   'C' => 'explain why a customer package was cancelled',
   'R' => 'explain why a customer was credited',
   'S' => 'explain why a customer package was suspended',
+  'F' => 'explain why a customer was refunded',
 );
 
 =head1 NAME