FS/FS/reason.pm

   1 package FS::reason;
   2
   3 use strict;
   4 use vars qw( @ISA $DEBUG $me );
   5 use DBIx::DBSchema;
   6 use DBIx::DBSchema::Table;
   7 use DBIx::DBSchema::Column;
   8 use FS::Record qw( qsearch qsearchs dbh dbdef );
   9 use FS::reason_type;
  10
  11 @ISA = qw(FS::Record);
  12 $DEBUG = 0;
  13 $me = '[FS::reason]';
  14
  15 =head1 NAME
  16
  17 FS::reason - Object methods for reason records
  18
  19 =head1 SYNOPSIS
  20
  21   use FS::reason;
  22
  23   $record = new FS::reason \%hash;
  24   $record = new FS::reason { 'column' => 'value' };
  25
  26   $error = $record->insert;
  27
  28   $error = $new_record->replace($old_record);
  29
  30   $error = $record->delete;
  31
  32   $error = $record->check;
  33
  34 =head1 DESCRIPTION
  35
  36 An FS::reason object represents a reason message.  FS::reason inherits from
  37 FS::Record.  The following fields are currently supported:
  38
  39 =over 4
  40
  41 =item reasonnum - primary key
  42
  43 =item reason_type - index into FS::reason_type
  44
  45 =item reason - text of the reason
  46
  47 =item disabled - 'Y' or ''
  48
  49
  50 =back
  51
  52 =head1 METHODS
  53
  54 =over 4
  55
  56 =item new HASHREF
  57
  58 Creates a new reason.  To add the example to the database, see L<"insert">.
  59
  60 Note that this stores the hash reference, not a distinct copy of the hash it
  61 points to.  You can ask the object for a copy with the I<hash> method.
  62
  63 =cut
  64
  65 sub table { 'reason'; }
  66
  67 =item insert
  68
  69 Adds this record to the database.  If there is an error, returns the error,
  70 otherwise returns false.
  71
  72 =cut
  73
  74 =item delete
  75
  76 Delete this record from the database.
  77
  78 =cut
  79
  80 =item replace OLD_RECORD
  81
  82 Replaces the OLD_RECORD with this one in the database.  If there is an error,
  83 returns the error, otherwise returns false.
  84
  85 =cut
  86
  87 =item check
  88
  89 Checks all fields to make sure this is a valid reason.  If there is
  90 an error, returns the error, otherwise returns false.  Called by the insert
  91 and replace methods.
  92
  93 =cut
  94
  95 sub check {
  96   my $self = shift;
  97
  98   my $error =
  99     $self->ut_numbern('reasonnum')
 100     || $self->ut_text('reason')
 101   ;
 102   return $error if $error;
 103
 104   $self->SUPER::check;
 105 }
 106
 107 =item reasontype
 108
 109 Returns the reason_type (see <I>FS::reason_type</I>) associated with this reason.
 110
 111 =cut
 112
 113 sub reasontype {
 114   qsearchs( 'reason_type', { 'typenum' => shift->reason_type } );
 115 }
 116
 117 # _upgrade_data
 118 #
 119 # Used by FS::Upgrade to migrate to a new database.
 120 #
 121 #
 122
 123 sub _upgrade_data {  # class method
 124   my ($self, %opts) = @_;
 125   my $dbh = dbh;
 126
 127   warn "$me upgrading $self\n" if $DEBUG;
 128
 129   my $column = dbdef->table($self->table)->column('reason');
 130   unless ($column->type eq 'text') { # assume history matches main table
 131
 132     # ideally this would be supported in DBIx-DBSchema and friends
 133     warn "$me Shifting reason column to type 'text'\n" if $DEBUG;
 134     foreach my $table ( $self->table, 'h_'. $self->table ) {
 135       my @sql = ();
 136
 137       $column = dbdef->table($self->table)->column('reason');
 138       my $columndef = $column->line($dbh);
 139       $columndef =~ s/varchar\(\d+\)/text/i;
 140
 141       if ( $dbh->{Driver}->{Name} eq 'Pg' ) {
 142
 143         my $notnull = $columndef =~ s/not null//i;
 144         push @sql,"ALTER TABLE $table RENAME reason TO freeside_upgrade_reason";
 145         push @sql,"ALTER TABLE $table ADD $columndef";
 146         push @sql,"UPDATE $table SET reason = freeside_upgrade_reason";
 147         push @sql,"ALTER TABLE $table ALTER reason SET NOT NULL"
 148           if $notnull;
 149         push @sql,"ALTER TABLE $table DROP freeside_upgrade_reason";
 150
 151       } elsif ( $dbh->{Driver}->{Name} =~ /^mysql/i ){
 152
 153         #crap, this isn't working
 154         #push @sql,"ALTER TABLE $table MODIFY reason ". $column->line($dbh);
 155         warn "WARNING: reason table upgrade not yet supported for mysql, sorry";
 156
 157       } else {
 158         die "watchu talkin' 'bout, Willis? (unsupported database type)";
 159       }
 160
 161       foreach (@sql) {
 162         my $sth = $dbh->prepare($_) or die $dbh->errstr;
 163         $sth->execute or die $sth->errstr;
 164       }
 165     }
 166   }
 167
 168  '';
 169
 170 }
 171 =back
 172
 173 =head1 BUGS
 174
 175 Here be termintes.  Don't use on wooden computers.
 176
 177 =head1 SEE ALSO
 178
 179 L<FS::Record>, schema.html from the base documentation.
 180
 181 =cut
 182
 183 1;
 184