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

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

diff --git a/FS/FS/reason.pm b/FS/FS/reason.pm
index 08e76de..3c925d4 100644 (file)
--- 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