[freeside-commits] freeside/FS/FS AccessRight.pm, 1.24, 1.25 Conf.pm, 1.213, 1.214 Schema.pm, 1.74, 1.75 Setup.pm, 1.11, 1.12 Upgrade.pm, 1.1, 1.2 cust_credit.pm, 1.26, 1.27 cust_main.pm, 1.325, 1.326 cust_pkg.pm, 1.85, 1.86 reason.pm, 1.3, 1.4 reason_type.pm, 1.1, 1.2 Conf_compat17.pm, 1.1, 1.2

Jeff Finucane,420,, jeff at wavetail.420.am
Tue Dec 4 10:21:00 PST 2007


Update of /home/cvs/cvsroot/freeside/FS/FS
In directory wavetail:/tmp/cvs-serv23022/FS/FS

Modified Files:
	AccessRight.pm Conf.pm Schema.pm Setup.pm cust_credit.pm 
	cust_main.pm cust_pkg.pm reason.pm reason_type.pm 
	Conf_compat17.pm 
Added Files:
	Upgrade.pm 
Log Message:
change credit reasons from freetext to new reason/reason type system (#2777)

Index: Conf.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Conf.pm,v
retrieving revision 1.213
retrieving revision 1.214
diff -u -d -r1.213 -r1.214
--- Conf.pm	9 Nov 2007 19:20:10 -0000	1.213
+++ Conf.pm	4 Dec 2007 18:20:56 -0000	1.214
@@ -2102,6 +2102,63 @@
     '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;

Index: cust_credit.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_credit.pm,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -d -r1.26 -r1.27
--- cust_credit.pm	1 Aug 2007 22:24:36 -0000	1.26
+++ cust_credit.pm	4 Dec 2007 18:20:56 -0000	1.27
@@ -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 @@
 
 };
 
+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 @@
 
 =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 @@
 =cut
 
 sub insert {
-  my $self = shift;
+  my ($self, %options) = @_;
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
@@ -107,6 +119,20 @@
   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 @@
     || $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 @@
 }
 
 
+=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

Index: cust_main.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_main.pm,v
retrieving revision 1.325
retrieving revision 1.326
diff -u -d -r1.325 -r1.326
--- cust_main.pm	30 Nov 2007 03:24:40 -0000	1.325
+++ cust_main.pm	4 Dec 2007 18:20:56 -0000	1.326
@@ -4589,13 +4589,13 @@
 =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 ] ] ]

Index: cust_pkg.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_pkg.pm,v
retrieving revision 1.85
retrieving revision 1.86
diff -u -d -r1.85 -r1.86
--- cust_pkg.pm	17 Oct 2007 16:07:59 -0000	1.85
+++ cust_pkg.pm	4 Dec 2007 18:20:57 -0000	1.86
@@ -229,9 +229,11 @@
 
         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 @@
     # 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".

Index: Conf_compat17.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Conf_compat17.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- Conf_compat17.pm	12 Jul 2007 13:36:25 -0000	1.1
+++ Conf_compat17.pm	4 Dec 2007 18:20:57 -0000	1.2
@@ -2133,7 +2133,62 @@
     '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 : '';
+                         },
+  },
 
 );
 

Index: reason_type.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/reason_type.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- reason_type.pm	19 Oct 2006 14:23:36 -0000	1.1
+++ reason_type.pm	4 Dec 2007 18:20:57 -0000	1.2
@@ -6,6 +6,18 @@
 
 @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 @@
 
 =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 @@
 
   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 @@
 		     } );
 }
 
+# _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

Index: Setup.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Setup.pm,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -d -r1.11 -r1.12
--- Setup.pm	28 Oct 2007 12:51:29 -0000	1.11
+++ Setup.pm	4 Dec 2007 18:20:56 -0000	1.12
@@ -150,6 +150,9 @@
     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 @@
       { 'groupname' => 'Superuser' },
     ],
 
+    #reason types
+    'reason_type' => [],
+
 #XXX need default new-style billing events
 #    #billing events
 #    'part_bill_event' => [

Index: reason.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/reason.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- reason.pm	1 Aug 2007 19:19:15 -0000	1.3
+++ reason.pm	4 Dec 2007 18:20:57 -0000	1.4
@@ -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 @@
   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

Index: Schema.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Schema.pm,v
retrieving revision 1.74
retrieving revision 1.75
diff -u -d -r1.74 -r1.75
--- Schema.pm	29 Nov 2007 03:05:46 -0000	1.74
+++ Schema.pm	4 Dec 2007 18:20:56 -0000	1.75
@@ -512,6 +512,7 @@
         'amount',   @money_type, '', '', 
         'otaker',   'varchar', '', 32, '', '', 
         'reason',   'text', 'NULL', '', '', '', 
+        'reasonnum', 'int', 'NULL', '', '', '', 
         'closed',    'char', 'NULL', 1, '', '', 
       ],
       'primary_key' => 'crednum',
@@ -1891,7 +1892,7 @@
       'columns' => [
         'reasonnum',     'serial',  '', '', '', '', 
         'reason_type',   'int',  '', '', '', '', 
-        'reason',        'varchar', '', $char_d, '', '', 
+        'reason',        'text', '', '', '', '', 
         'disabled',      'char',    'NULL', 1, '', '', 
       ],
       'primary_key' => 'reasonnum',

Index: AccessRight.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/AccessRight.pm,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -d -r1.24 -r1.25
--- AccessRight.pm	24 Sep 2007 00:56:49 -0000	1.24
+++ AccessRight.pm	4 Dec 2007 18:20:56 -0000	1.25
@@ -169,6 +169,7 @@
     { 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
   ],
   
   ###

--- NEW FILE: Upgrade.pm ---
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;




More information about the freeside-commits mailing list