change credit reasons from freetext to new reason/reason type system (#2777)

16 files changed, 600 insertions, 25 deletions

diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm
index 5ab6809..8ebfc40 100644
--- a/FS/FS/AccessRight.pm
+++ b/FS/FS/AccessRight.pm
@@ -169,6 +169,7 @@ tie my %rights, 'Tie::IxHash',
     { rightname=>'Unapply credit', desc=>'Enable "unapplication" of unclosed credits.' }, #aka unapplycredits
     { rightname=>'Delete credit', desc=>'Enable deletion of unclosed credits. Be very careful!  Only delete credits that were data-entry errors, not adjustments.' }, #aka. deletecredits Optionally specify one or more comma-separated email addresses to be notified when a credit is deleted.
     'Delete refund', #NEW
+    'Add on-the-fly credit reason', #NEW
   ],
   
   ###
diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm
index fef47e8..6e4545a 100644
--- a/FS/FS/ClientAPI/MyAccount.pm
+++ b/FS/FS/ClientAPI/MyAccount.pm
@@ -992,8 +992,11 @@ sub _do_bop_realtime {
          && ( $cust_main->payby !~ /^(BILL|DCRD|DCHK)$/ ?
               1 : $status eq 'suspended' ) ) {
       #this makes sense.  credit is "un-doing" the invoice
+      my $conf = new FS::Conf;
       $cust_main->credit( sprintf("%.2f", $cust_main->balance - $old_balance ),
-                          'self-service decline' );
+                          'self-service decline',
+                          'reason_type' => $conf->config('signup_credit_type'),
+                        );
       $cust_main->apply_credits( 'order' => 'newest' );
 
       return { 'error' => '_decline', 'bill_error' => $bill_error };
diff --git a/FS/FS/ClientAPI/Signup.pm b/FS/FS/ClientAPI/Signup.pm
index 00b4d44..d33dd79 100644
--- a/FS/FS/ClientAPI/Signup.pm
+++ b/FS/FS/ClientAPI/Signup.pm
@@ -451,7 +451,9 @@ sub new_customer {
     if ( $cust_main->balance > 0 ) {
 
       #this makes sense.  credit is "un-doing" the invoice
-      $cust_main->credit( $cust_main->balance, 'signup server decline' );
+      $cust_main->credit( $cust_main->balance, 'signup server decline',
+                          'reason_type' => $conf->config('signup_credit_type'),
+                        );
       $cust_main->apply_credits;
 
       #should check list for errors...
diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm
index 0ad12c1..0f1fcbb 100644
--- a/FS/FS/Conf.pm
+++ b/FS/FS/Conf.pm
@@ -2102,6 +2102,63 @@ worry that config_items is freeside-specific and icky.
     'type'        => 'checkbox',
   },
 
+  {
+    'key'         => 'cancel_credit_type',
+    'section'     => 'billing',
+    'description' => 'The group to use for new, automatically generated credit reasons resulting from cancellation.',
+    'type'        => 'select-sub',
+    'options_sub' => sub { require FS::Record;
+                           require FS::reason_type;
+			   map { $_->typenum => $_->type }
+                               FS::Record::qsearch('reason_type', { class=>'R' } );
+			 },
+    'option_sub'  => sub { require FS::Record;
+                           require FS::reason_type;
+			   my $reason_type = FS::Record::qsearchs(
+			     'reason_type', { 'typenum' => shift }
+			   );
+                           $reason_type ? $reason_type->type : '';
+			 },
+  },
+
+  {
+    'key'         => 'referral_credit_type',
+    'section'     => 'billing',
+    'description' => 'The group to use for new, automatically generated credit reasons resulting from referrals.',
+    'type'        => 'select-sub',
+    'options_sub' => sub { require FS::Record;
+                           require FS::reason_type;
+			   map { $_->typenum => $_->type }
+                               FS::Record::qsearch('reason_type', { class=>'R' } );
+			 },
+    'option_sub'  => sub { require FS::Record;
+                           require FS::reason_type;
+			   my $reason_type = FS::Record::qsearchs(
+			     'reason_type', { 'typenum' => shift }
+			   );
+                           $reason_type ? $reason_type->type : '';
+			 },
+  },
+
+  {
+    'key'         => 'signup_credit_type',
+    'section'     => 'billing',
+    'description' => 'The group to use for new, automatically generated credit reasons resulting from signup and self-service declines.',
+    'type'        => 'select-sub',
+    'options_sub' => sub { require FS::Record;
+                           require FS::reason_type;
+			   map { $_->typenum => $_->type }
+                               FS::Record::qsearch('reason_type', { class=>'R' } );
+			 },
+    'option_sub'  => sub { require FS::Record;
+                           require FS::reason_type;
+			   my $reason_type = FS::Record::qsearchs(
+			     'reason_type', { 'typenum' => shift }
+			   );
+                           $reason_type ? $reason_type->type : '';
+			 },
+  },
+
 );
 
 1;
diff --git a/FS/FS/Conf_compat17.pm b/FS/FS/Conf_compat17.pm
index 1c33b5b..bcd78e8 100644
--- a/FS/FS/Conf_compat17.pm
+++ b/FS/FS/Conf_compat17.pm
@@ -2133,7 +2133,62 @@ httemplate/docs/config.html
     'type'        => 'checkbox',
   },
 
-  
+  {
+    'key'         => 'cancel_credit_type',
+    'section'     => 'billing',
+    'description' => 'The group to use for new, automatically generated credit reasons resulting from cancellation.',
+    'type'        => 'select-sub',
+    'options_sub' => sub { require FS::Record;
+                           require FS::reason_type;
+                           map { $_->typenum => $_->type }
+                               FS::Record::qsearch('reason_type', { class=>'R' } );
+                         },
+    'option_sub'  => sub { require FS::Record;
+                           require FS::reason_type;
+                           my $reason_type = FS::Record::qsearchs(
+                             'reason_type', { 'typenum' => shift }
+                           );
+                           $reason_type ? $reason_type->type : '';
+                         },
+  },
+
+  {
+    'key'         => 'referral_credit_type',
+    'section'     => 'billing',
+    'description' => 'The group to use for new, automatically generated credit reasons resulting from referrals.',
+    'type'        => 'select-sub',
+    'options_sub' => sub { require FS::Record;
+                           require FS::reason_type;
+                           map { $_->typenum => $_->type }
+                               FS::Record::qsearch('reason_type', { class=>'R' } );
+                         },
+    'option_sub'  => sub { require FS::Record;
+                           require FS::reason_type;
+                           my $reason_type = FS::Record::qsearchs(
+                             'reason_type', { 'typenum' => shift }
+                           );
+                           $reason_type ? $reason_type->type : '';
+                         },
+  },
+
+  {
+    'key'         => 'signup_credit_type',
+    'section'     => 'billing',
+    'description' => 'The group to use for new, automatically generated credit reasons resulting from signup and self-service declines.',
+    'type'        => 'select-sub',
+    'options_sub' => sub { require FS::Record;
+                           require FS::reason_type;
+                           map { $_->typenum => $_->type }
+                               FS::Record::qsearch('reason_type', { class=>'R' } );
+                         },
+    'option_sub'  => sub { require FS::Record;
+                           require FS::reason_type;
+                           my $reason_type = FS::Record::qsearchs(
+                             'reason_type', { 'typenum' => shift }
+                           );
+                           $reason_type ? $reason_type->type : '';
+                         },
+  },
 
 );
 
diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
index 3d07af6..60f917a 100644
--- a/FS/FS/Schema.pm
+++ b/FS/FS/Schema.pm
@@ -512,6 +512,7 @@ sub tables_hashref {
         'amount',   @money_type, '', '', 
         'otaker',   'varchar', '', 32, '', '', 
         'reason',   'text', 'NULL', '', '', '', 
+        'reasonnum', 'int', 'NULL', '', '', '', 
         'closed',    'char', 'NULL', 1, '', '', 
       ],
       'primary_key' => 'crednum',
@@ -1891,7 +1892,7 @@ sub tables_hashref {
       'columns' => [
         'reasonnum',     'serial',  '', '', '', '', 
         'reason_type',   'int',  '', '', '', '', 
-        'reason',        'varchar', '', $char_d, '', '', 
+        'reason',        'text', '', '', '', '', 
         'disabled',      'char',    'NULL', 1, '', '', 
       ],
       'primary_key' => 'reasonnum',
diff --git a/FS/FS/Setup.pm b/FS/FS/Setup.pm
index 6807ef7..d8099c6 100644
--- a/FS/FS/Setup.pm
+++ b/FS/FS/Setup.pm
@@ -150,6 +150,9 @@ sub populate_initial_data {
     eval "use $class;";
     die $@ if $@;
 
+    $class->_populate_initial_data(%opt)
+      if $class->can('_populate_inital_data');
+
     my @records = @{ $data->{$table} };
 
     foreach my $record ( @records ) {
@@ -175,6 +178,9 @@ sub initial_data {
       { 'groupname' => 'Superuser' },
     ],
 
+    #reason types
+    'reason_type' => [],
+
 #XXX need default new-style billing events
 #    #billing events
 #    'part_bill_event' => [
diff --git a/FS/FS/Upgrade.pm b/FS/FS/Upgrade.pm
new file mode 100644
index 0000000..55972dd
--- /dev/null
+++ b/FS/FS/Upgrade.pm
@@ -0,0 +1,105 @@
+package FS::Upgrade;
+
+use strict;
+use vars qw( @ISA @EXPORT_OK );
+use Exporter;
+use Tie::IxHash;
+use FS::UID qw( dbh driver_name );
+use FS::Record;
+
+use FS::svc_domain;
+$FS::svc_domain::whois_hack = 1;
+
+@ISA = qw( Exporter );
+@EXPORT_OK = qw( upgrade );
+
+=head1 NAME
+
+FS::Upgrade - Database upgrade routines
+
+=head1 SYNOPSIS
+
+  use FS::Upgrade;
+
+=head1 DESCRIPTION
+
+Currently this module simply provides a place to store common subroutines for
+database upgrades.
+
+=head1 SUBROUTINES
+
+=over 4
+
+=item
+
+=cut
+
+sub upgrade {
+  my %opt = @_;
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  $FS::UID::AutoCommit = 0;
+
+  my $data = upgrade_data(%opt);
+
+  foreach my $table ( keys %$data ) {
+
+    my $class = "FS::$table";
+    eval "use $class;";
+    die $@ if $@;
+
+    $class->_upgrade_data(%opt)
+      if $class->can('_upgrade_data');
+
+#    my @records = @{ $data->{$table} };
+#
+#    foreach my $record ( @records ) {
+#      my $args = delete($record->{'_upgrade_args'}) || [];
+#      my $object = $class->new( $record );
+#      my $error = $object->insert( @$args );
+#      die "error inserting record into $table: $error\n"
+#        if $error;
+#    }
+
+  }
+
+  if ( $oldAutoCommit ) {
+    dbh->commit or die dbh->errstr;
+  }
+
+}
+
+
+sub upgrade_data {
+  my %opt = @_;
+
+  tie my %hash, 'Tie::IxHash', 
+
+    #reason type and reasons
+    'reason_type' => [],
+    'reason'      => [],
+
+    #customer credits
+    'cust_credit' => [],
+
+
+  ;
+
+  \%hash;
+
+}
+
+
+=back
+
+=head1 BUGS
+
+Sure.
+
+=head1 SEE ALSO
+
+=cut
+
+1;
+
diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm
index e07461d..4c94e15 100644
--- a/FS/FS/cust_credit.pm
+++ b/FS/FS/cust_credit.pm
@@ -1,17 +1,22 @@
 package FS::cust_credit;
 
 use strict;
-use vars qw( @ISA $conf $unsuspendauto );
+use vars qw( @ISA $conf $unsuspendauto $me $DEBUG );
 use Date::Format;
 use FS::UID qw( dbh getotaker );
 use FS::Misc qw(send_email);
-use FS::Record qw( qsearch qsearchs );
+use FS::Record qw( qsearch qsearchs dbdef );
 use FS::cust_main_Mixin;
 use FS::cust_main;
 use FS::cust_refund;
 use FS::cust_credit_bill;
+use FS::part_pkg;
+use FS::reason_type;
+use FS::reason;
 
 @ISA = qw( FS::cust_main_Mixin FS::Record );
+$me = '[ FS::cust_credit ]';
+$DEBUG = 0;
 
 #ask FS::UID to run this stuff for us later
 $FS::UID::callback{'FS::cust_credit'} = sub { 
@@ -21,6 +26,11 @@ $FS::UID::callback{'FS::cust_credit'} = sub {
 
 };
 
+our %reasontype_map = ( 'referral_credit_type' => 'Referral Credit',
+                        'cancel_credit_type'   => 'Cancellation Credit',
+                        'signup_credit_type'   => 'Self-Service Credit',
+                      );
+
 =head1 NAME
 
 FS::cust_credit - Object methods for cust_credit records
@@ -59,7 +69,9 @@ L<Time::Local> and L<Date::Parse> for conversion functions.
 
 =item otaker - order taker (assigned automatically, see L<FS::UID>)
 
-=item reason - text
+=item reason - text ( deprecated )
+
+=item reasonum - int reason (see L<FS::reason>)
 
 =item closed - books closed flag, empty or `Y'
 
@@ -91,7 +103,7 @@ returns the error, otherwise returns false.
 =cut
 
 sub insert {
-  my $self = shift;
+  my ($self, %options) = @_;
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
@@ -107,6 +119,20 @@ 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) {
+      $dbh->rollback if $oldAutoCommit;
+      return "failed to set reason for $me: ". $dbh->errstr;
+    }
+  }
+
+  $self->setfield('reason', '');
+
   my $error = $self->SUPER::insert;
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
@@ -242,6 +268,7 @@ sub check {
     || $self->ut_numbern('_date')
     || $self->ut_money('amount')
     || $self->ut_textn('reason')
+    || $self->ut_foreign_key('reasonnum', 'reason', 'reasonnum')
     || $self->ut_enum('closed', [ '', 'Y' ])
   ;
   return $error if $error;
@@ -331,6 +358,166 @@ sub cust_main {
 }
 
 
+=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,
+                              } );
+      $reason->insert and $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 : '';
+}
+
+# _upgrade_data
+#
+# Used by FS::Upgrade to migrate to a new database.
+#
+#
+
+sub _upgrade_data {  # class method
+  my ($self, %opts) = @_;
+
+  warn "$me upgrading $self\n" if $DEBUG;
+
+  if (defined dbdef->table($self->table)->column('reason')) {
+
+    warn "$me Checking for unmigrated reasons\n" if $DEBUG;
+
+    my @cust_credits = qsearch({ 'table' => $self->table,
+                                 'hashref' => {},
+                                 'extrasql' => '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 "$self 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) {
+        $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;
+
+        die "error inserting $self into database: $error\n"
+          if $error;
+      }
+    }
+
+    warn "$me Ensuring existance of auto reasons\n" if $DEBUG;
+
+    foreach ( keys %reasontype_map ) {
+      unless ($conf->config($_)) {       # hmmmm
+#       warn "$me Found $_ reason type lacking\n" if $DEBUG;
+#       my $hashref = { 'class' => 'R', 'type' => $reasontype_map{$_} };
+        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 "$self had error inserting FS::reason_type into database: $error\n"
+            if $error;
+        }
+                                            # or clause for 1.7.x
+        $conf->set($_, $reason_type->typenum) or die "failed setting config";
+      }
+    }
+
+    warn "$me Ensuring commission packages have a reason type\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 "$self had error inserting FS::reason_type into database: $error\n"
+        if $error;
+    }
+
+    my @plans = qw( flat_comission flat_comission_cust flat_comission_pkg );
+    foreach my $plan ( @plans ) {
+      foreach my $pkg ( qsearch('part_pkg', { 'plan' => $plan } ) ) {
+        unless ($pkg->option('reason_type', 1) ) { 
+          my $plandata = $pkg->plandata.
+                        "reason_type=". $reason_type->typenum. "\n";
+          $pkg->plandata($plandata);
+          my $error =
+            $pkg->replace( undef,
+                           'pkg_svc' => { map { $_->svcpart => $_->quantity }
+                                          $pkg->pkg_svc
+                                        },
+                           'primary_svc' => $pkg->svcpart,
+                         );
+            die "failed setting reason_type option: $error"
+              if $error;
+        }
+      }
+    }
+  }
+
+  '';
+
+}
+
 =back
 
 =head1 CLASS METHODS
diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm
index 9300f2c..9d317b6 100644
--- a/FS/FS/cust_main.pm
+++ b/FS/FS/cust_main.pm
@@ -4589,13 +4589,13 @@ otherwise returns false.
 =cut
 
 sub credit {
-  my( $self, $amount, $reason ) = @_;
+  my( $self, $amount, $reason, %options ) = @_;
   my $cust_credit = new FS::cust_credit {
     'custnum' => $self->custnum,
     'amount'  => $amount,
     'reason'  => $reason,
   };
-  $cust_credit->insert;
+  $cust_credit->insert(%options);
 }
 
 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index e09b8ab..71ae0ad 100644
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -229,9 +229,11 @@ sub insert {
 
         my $amount = sprintf( "%.2f", $part_pkg->base_recur / $part_pkg->freq );
         my $error =
-          $referring_cust_main->credit( $amount,
-                                        'Referral credit for '. $cust_main->name
-                                      );
+          $referring_cust_main->
+            credit( $amount,
+                    'Referral credit for '.$cust_main->name,
+                    'reason_type' => $conf->config('referral_credit_type')
+                  );
         if ( $error ) {
           $dbh->rollback if $oldAutoCommit;
           return "Error crediting customer ". $cust_main->referral_custnum.
@@ -523,10 +525,12 @@ sub cancel {
     # 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,
-                                           );
+        $remaining_value,
+        'Credit for unused time on '. $self->part_pkg->pkg,
+        'reason_type' => $conf->config('cancel_credit_type'),
+      );
       if ($error) {
         $dbh->rollback if $oldAutoCommit;
         return "Error crediting customer \$$remaining_value for unused time on".
diff --git a/FS/FS/part_pkg/flat_comission.pm b/FS/FS/part_pkg/flat_comission.pm
index bc02f96..4592bed 100644
--- a/FS/FS/part_pkg/flat_comission.pm
+++ b/FS/FS/part_pkg/flat_comission.pm
@@ -26,8 +26,15 @@ use FS::part_pkg::flat;
     'comission_depth'  => { 'name' => 'Number of layers',
                             'default' => 1,
                           },
+    'reason_type'      => { 'name' => 'Reason type for commission credits',
+                            'type' => 'select',
+                            'select_table' => 'reason_type',
+                            'select_hash'  => { 'class' => 'R' },
+                            'select_key'   => 'typenum',
+                            'select_label' => 'type',
+                          },
   },
-  'fieldorder' => [ 'setup_fee', 'recur_fee', 'unused_credit', 'comission_depth', 'comission_amount' ],
+  'fieldorder' => [ 'setup_fee', 'recur_fee', 'unused_credit', 'comission_depth', 'comission_amount', 'reason_type' ],
   #'setup' => 'what.setup_fee.value',
   #'recur' => '\'my $error = $cust_pkg->cust_main->credit( \' + what.comission_amount.value + \' * scalar($cust_pkg->cust_main->referral_cust_pkg(\' + what.comission_depth.value+ \')), "commission" ); die $error if $error; \' + what.recur_fee.value + \';\'',
   'weight' => 62,
@@ -45,7 +52,10 @@ sub calc_recur {
 
   if ( $commission > 0 ) {
 
-    my $error = $cust_pkg->cust_main->credit( $commission, "commission" );
+    my $error =
+      $cust_pkg->cust_main->credit( $commission, "commission",
+                                    'reason_type'=>$self->option('reason_type'),
+                                  );
     die $error if $error;
 
   }
diff --git a/FS/FS/part_pkg/flat_comission_cust.pm b/FS/FS/part_pkg/flat_comission_cust.pm
index 4abe66a..82e5111 100644
--- a/FS/FS/part_pkg/flat_comission_cust.pm
+++ b/FS/FS/part_pkg/flat_comission_cust.pm
@@ -26,8 +26,15 @@ use FS::part_pkg::flat;
     'comission_depth'  => { 'name' => 'Number of layers',
                             'default' => 1,
                           },
+    'reason_type'      => { 'name' => 'Reason type for commission credits',
+                            'type' => 'select_table',
+                            'select_table' => 'reason_type',
+                            'select_hash'  => { 'class' => 'R' },
+                            'select_key'   => 'typenum',
+                            'select_label' => 'type',
+                          },
   },
-  'fieldorder' => [ 'setup_fee', 'recur_fee', 'unused_credit', 'comission_depth', 'comission_amount' ],
+  'fieldorder' => [ 'setup_fee', 'recur_fee', 'unused_credit', 'comission_depth', 'comission_amount', 'reason_type' ],
   #'setup' => 'what.setup_fee.value',
   #'recur' => '\'my $error = $cust_pkg->cust_main->credit( \' + what.comission_amount.value + \' * scalar($cust_pkg->cust_main->referral_cust_main_ncancelled(\' + what.comission_depth.value+ \')), "commission" ); die $error if $error; \' + what.recur_fee.value + \';\'',
   'weight' => '60',
@@ -45,7 +52,9 @@ sub calc_recur {
 
   if ( $amount && $num_active ) {
     my $error =
-      $cust_pkg->cust_main->credit( $amount*$num_active, "commission" );
+      $cust_pkg->cust_main->credit( $amount*$num_active, "commission",
+                                    'reason_type'=>$self->option('reason_type'),
+                                  );
     die $error if $error;
   }
 
diff --git a/FS/FS/part_pkg/flat_comission_pkg.pm b/FS/FS/part_pkg/flat_comission_pkg.pm
index 0f4d02a..07c3d1b 100644
--- a/FS/FS/part_pkg/flat_comission_pkg.pm
+++ b/FS/FS/part_pkg/flat_comission_pkg.pm
@@ -33,8 +33,15 @@ use FS::part_pkg::flat;
                              'select_key'   => 'pkgpart',
                              'select_label' => 'pkg',
                            },
+    'reason_type'       => { 'name' => 'Reason type for commission credits',
+                             'type' => 'select',
+                             'select_table' => 'reason_type',
+                             'select_hash'  => { 'class' => 'R' } ,
+                             'select_key'   => 'typenum',
+                             'select_label' => 'type',
+                           },
   },
-  'fieldorder' => [ 'setup_fee', 'recur_fee', 'unused_credit', 'comission_depth', 'comission_amount', 'comission_pkgpart' ],
+  'fieldorder' => [ 'setup_fee', 'recur_fee', 'unused_credit', 'comission_depth', 'comission_amount', 'comission_pkgpart', 'reason_type' ],
   #'setup' => 'what.setup_fee.value',
   #'recur' => '""; var pkgparts = ""; for ( var c=0; c < document.flat_comission_pkg.comission_pkgpart.options.length; c++ ) { if (document.flat_comission_pkg.comission_pkgpart.options[c].selected) { pkgparts = pkgparts + document.flat_comission_pkg.comission_pkgpart.options[c].value + \', \'; } } what.recur.value = \'my $error = $cust_pkg->cust_main->credit( \' + what.comission_amount.value + \' * scalar( grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } ( \' + pkgparts + \'  ) } $cust_pkg->cust_main->referral_cust_pkg(\' + what.comission_depth.value+ \')), "commission" ); die $error if $error; \' + what.recur_fee.value + \';\'',
   #'disabled' => 1,
diff --git a/FS/FS/reason.pm b/FS/FS/reason.pm
index 08e76de..3c925d4 100644
--- a/FS/FS/reason.pm
+++ b/FS/FS/reason.pm
@@ -1,11 +1,16 @@
 package FS::reason;
 
 use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
+use vars qw( @ISA $DEBUG $me );
+use DBIx::DBSchema;
+use DBIx::DBSchema::Table;
+use DBIx::DBSchema::Column;
+use FS::Record qw( qsearch qsearchs dbh dbdef );
 use FS::reason_type;
 
 @ISA = qw(FS::Record);
+$DEBUG = 0;
+$me = '[FS::reason]';
 
 =head1 NAME
 
@@ -109,6 +114,53 @@ sub reasontype {
   qsearchs( 'reason_type', { 'typenum' => shift->reason_type } );
 }
 
+# _upgrade_data
+#
+# Used by FS::Upgrade to migrate to a new database.
+#
+#
+
+sub _upgrade_data {  # class method
+  my ($self, %opts) = @_;
+  my $dbh = dbh;
+
+  warn "$me upgrading $self\n" if $DEBUG;
+
+  my $column = dbdef->table($self->table)->column('reason');
+  unless ($column->type eq 'text') { # assume history matches main table
+
+    # ideally this would be supported in DBIx-DBSchema and friends
+    warn "$me Shifting reason column to type 'text'\n" if $DEBUG;
+    foreach my $table ( $self->table, 'h_'. $self->table ) {
+      my @sql = ();
+
+      $column = dbdef->table($self->table)->column('reason');
+      my $columndef = $column->line($dbh);
+      $columndef =~ s/varchar\(\d+\)/text/i;
+      if ( $dbh->{Driver}->{Name} eq 'Pg' ) {
+        my $notnull = $columndef =~ s/not null//i;
+        push @sql,"ALTER TABLE $table RENAME reason TO freeside_upgrade_reason";
+        push @sql,"ALTER TABLE $table ADD $columndef";
+        push @sql,"UPDATE $table SET reason = freeside_upgrade_reason";
+        push @sql,"ALTER TABLE $table ALTER reason SET NOT NULL"
+          if $notnull;
+        push @sql,"ALTER TABLE $table DROP freeside_upgrade_reason";
+      }elsif( $dbh->{Driver}->{Name} =~ /^mysql/i ){
+        push @sql,"ALTER TABLE $table MODIFY reason ". $column->line($dbh);
+      }else{
+        die "watchu talkin' 'bout, Willis? (unsupported database type)";
+      }
+
+      foreach (@sql) {
+        my $sth = $dbh->prepare($_) or die $dbh->errstr;
+        $sth->execute or die $dbh->errstr;
+      }
+    }
+  }
+
+ '';
+
+}
 =back
 
 =head1 BUGS
diff --git a/FS/FS/reason_type.pm b/FS/FS/reason_type.pm
index 89278d0..193d47e 100644
--- a/FS/FS/reason_type.pm
+++ b/FS/FS/reason_type.pm
@@ -6,6 +6,18 @@ use FS::Record qw( qsearch qsearchs );
 
 @ISA = qw(FS::Record);
 
+our %class_name = (  
+  'C' => 'cancel',
+  'R' => 'credit',
+  'S' => 'suspend',
+);
+
+our %class_purpose = (  
+  'C' => 'explain why we cancel a package',
+  'R' => 'explain why we credit a customer',
+  'S' => 'explain why we suspend a package',
+);
+
 =head1 NAME
 
 FS::reason_type - Object methods for reason_type records
@@ -34,7 +46,7 @@ inherits from FS::Record.  The following fields are currently supported:
 
 =item typenum - primary key
 
-=item class - currently 'C' or 'S' for cancel or suspend 
+=item class - currently 'C', 'R',  or 'S' for cancel, credit, or suspend 
 
 =item type - name of the type of reason
 
@@ -89,7 +101,7 @@ sub check {
 
   my $error = 
     $self->ut_numbern('typenum')
-    || $self->ut_enum('class', [ 'C', 'S' ] )
+    || $self->ut_enum('class', [ keys %class_name ] )
     || $self->ut_text('type')
   ;
   return $error if $error;
@@ -119,6 +131,70 @@ sub enabled_reasons {
 		     } );
 }
 
+# _populate_initial_data
+#
+# Used by FS::Setup to initialize a new database.
+#
+#
+
+sub _populate_initial_data {  # class method
+  my ($self, %opts) = @_;
+
+  my $conf = new FS::Conf;
+
+  foreach ( keys %class_name ) {
+    my $object  = $self->new( {'class' => $_,
+                               'type' => ucfirst($class_name{$_}). ' Reason',
+                            } );
+    my $error   = $object->insert();
+    die "error inserting $self into database: $error\n"
+      if $error;
+  }
+
+  my $object = qsearchs('reason_type', { 'class' => 'R' });
+  die "can't find credit reason type just inserted!\n"
+    unless $object;
+
+  foreach ( keys %FS::cust_credit::reasontype_map ) {
+#   my $object  = $self->new( {'class' => 'R',
+#                              'type' => $FS::cust_credit::reasontype_map{$_},
+#                           } );
+#   my $error   = $object->insert();
+#   die "error inserting $self into database: $error\n"
+#     if $error;
+#                                      # or clause for 1.7.x
+    $conf->set($_, $object->typenum)
+      or die "failed setting config";
+  }
+
+  '';
+
+}
+
+# _upgrade_data
+#
+# Used by FS::Upgrade to migrate to a new database.
+#
+#
+
+sub _upgrade_data {  # class method
+  my ($self, %opts) = @_;
+
+  foreach ( keys %class_name ) {
+    unless (scalar(qsearch('reason_type', { 'class' => $_ }))) {
+      my $object  = $self->new( {'class' => $_,
+                                 'type' => ucfirst($class_name{$_}),
+                              } );
+      my $error   = $object->insert();
+      die "error inserting $self into database: $error\n"
+        if $error;
+    }
+  }
+
+  '';
+
+}
+
 =back
 
 =head1 BUGS