FS/FS/reason_Mixin.pm

   1 package FS::reason_Mixin;
   2
   3 use strict;
   4 use Carp qw( croak ); #confess );
   5 use FS::Record qw( qsearch qsearchs dbdef );
   6 use FS::access_user;
   7 use FS::UID qw( dbh );
   8
   9 our $DEBUG = 0;
  10 our $me = '[FS::reason_Mixin]';
  11
  12 =item reason
  13
  14 Returns the text of the associated reason (see L<FS::reason>) for this credit.
  15
  16 =cut
  17
  18 sub reason {
  19   my ($self, $value, %options) = @_;
  20   my $dbh = dbh;
  21   my $reason;
  22   my $typenum = $options{'reason_type'};
  23
  24   my $oldAutoCommit = $FS::UID::AutoCommit;  # this should already be in
  25   local $FS::UID::AutoCommit = 0;            # a transaction if it matters
  26
  27   if ( defined( $value ) ) {
  28     my $hashref = { 'reason' => $value };
  29     $hashref->{'reason_type'} = $typenum if $typenum;
  30     my $addl_from = "LEFT JOIN reason_type ON ( reason_type = typenum ) ";
  31     my $extra_sql = " AND reason_type.class='F'";
  32
  33     $reason = qsearchs( { 'table'     => 'reason',
  34                           'hashref'   => $hashref,
  35                           'addl_from' => $addl_from,
  36                           'extra_sql' => $extra_sql,
  37                        } );
  38
  39     if (!$reason && $typenum) {
  40       $reason = new FS::reason( { 'reason_type' => $typenum,
  41                                   'reason' => $value,
  42                                   'disabled' => 'Y',
  43                               } );
  44       my $error = $reason->insert;
  45       if ( $error ) {
  46         warn "error inserting reason: $error\n";
  47         $reason = undef;
  48       }
  49     }
  50
  51     $self->reasonnum($reason ? $reason->reasonnum : '') ;
  52     warn "$me reason used in set mode with non-existant reason -- clearing"
  53       unless $reason;
  54   }
  55   $reason = qsearchs( 'reason', { 'reasonnum' => $self->reasonnum } );
  56
  57   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
  58
  59   ( $reason ? $reason->reason : '' ).
  60   ( $self->addlinfo ? ' '.$self->addlinfo : '' );
  61 }
  62
  63 # Used by FS::Upgrade to migrate reason text fields to reasonnum.
  64 sub _upgrade_reasonnum {  # class method
  65   my $class = shift;
  66   my $table = $class->table;
  67
  68   if (defined dbdef->table($table)->column('reason')) {
  69
  70     warn "$me Checking for unmigrated reasons\n" if $DEBUG;
  71
  72     my @cust_refunds = qsearch({ 'table'     => $table,
  73                                  'hashref'   => {},
  74                                  'extra_sql' => 'WHERE reason IS NOT NULL',
  75                               });
  76
  77     if (scalar(grep { $_->getfield('reason') =~ /\S/ } @cust_refunds)) {
  78       warn "$me Found unmigrated reasons\n" if $DEBUG;
  79       my $hashref = { 'class' => 'F', 'type' => 'Legacy' };
  80       my $reason_type = qsearchs( 'reason_type', $hashref );
  81       unless ($reason_type) {
  82         $reason_type  = new FS::reason_type( $hashref );
  83         my $error   = $reason_type->insert();
  84         die "$class had error inserting FS::reason_type into database: $error\n"
  85           if $error;
  86       }
  87
  88       $hashref = { 'reason_type' => $reason_type->typenum,
  89                    'reason' => '(none)'
  90                  };
  91       my $noreason = qsearchs( 'reason', $hashref );
  92       unless ($noreason) {
  93         $hashref->{'disabled'} = 'Y';
  94         $noreason = new FS::reason( $hashref );
  95         my $error  = $noreason->insert();
  96         die "can't insert legacy reason '(none)' into database: $error\n"
  97           if $error;
  98       }
  99
 100       foreach my $cust_refund ( @cust_refunds ) {
 101         my $reason = $cust_refund->getfield('reason');
 102         warn "Contemplating reason $reason\n" if $DEBUG > 1;
 103         if ($reason =~ /\S/) {
 104           $cust_refund->reason($reason, 'reason_type' => $reason_type->typenum)
 105             or die "can't insert legacy reason $reason into database\n";
 106         }else{
 107           $cust_refund->reasonnum($noreason->reasonnum);
 108         }
 109
 110         $cust_refund->setfield('reason', '');
 111         my $error = $cust_refund->replace;
 112
 113         warn "*** WARNING: error replacing reason in $class ".
 114              $cust_refund->refundnum. ": $error ***\n"
 115           if $error;
 116       }
 117     }
 118   }
 119 }
 120
 121 1;