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 use FS::reason;
   9 use FS::reason_type;
  10
  11 our $DEBUG = 0;
  12 our $me = '[FS::reason_Mixin]';
  13
  14 =item reason
  15
  16 Returns the text of the associated reason (see L<FS::reason>) for this credit /
  17 voided payment / voided invoice. This can no longer be used to set the
  18 (deprecated) free-text "reason" field; see L<FS::reason/new_or_existing>.
  19
  20 =cut
  21
  22 sub reason {
  23   my $self = shift;
  24
  25   my $reason_text;
  26   if ( $self->reasonnum ) {
  27     my $reason = FS::reason->by_key($self->reasonnum);
  28     $reason_text = $reason->reason;
  29   } else { # in case one of these somehow still exists
  30     $reason_text = $self->get('reason');
  31   }
  32   if ( $self->get('addlinfo') ) {
  33     $reason_text .= ' ' . $self->get('addlinfo');
  34   }
  35
  36   return $reason_text;
  37 }
  38
  39 # Used by FS::Upgrade to migrate reason text fields to reasonnum.
  40 # Note that any new tables that get reasonnum fields do NOT need to be
  41 # added here unless they have previously had a free-text "reason" field.
  42
  43 sub _upgrade_reasonnum {    # class method
  44     my $class = shift;
  45     my $table = $class->table;
  46
  47     my $reason_class;
  48     if ( $table =~ /^cust_bill/ ) { # also includes cust_bill_pkg
  49       $reason_class = 'I';
  50     } elsif ( $table =~ /^cust_pay/ ) {
  51       $reason_class = 'P';
  52     } elsif ( $table eq 'cust_refund' ) {
  53       $reason_class = 'F';
  54     } elsif ( $table =~ /^cust_credit/ ) {
  55       $reason_class = 'R';
  56     } else {
  57       die "don't know the reason class to use for upgrading $table";
  58     }
  59
  60     for my $fieldname (qw(reason void_reason)) {
  61
  62         if ( $table =~ /^cust_credit/ and $fieldname eq 'void_reason' ) {
  63             $reason_class = 'X';
  64         }
  65
  66         if (   defined dbdef->table($table)->column($fieldname)
  67             && defined dbdef->table($table)->column( $fieldname . 'num' ) )
  68         {
  69
  70             warn "$me Checking for unmigrated reasons\n" if $DEBUG;
  71
  72             my @legacy_reason_records = qsearch(
  73                 {
  74                     'table'     => $table,
  75                     'hashref'   => {},
  76                     'extra_sql' => 'WHERE ' . $fieldname . ' IS NOT NULL',
  77                 }
  78             );
  79
  80             if ( @legacy_reason_records ) {
  81
  82                 warn "$me Found unmigrated reasons\n" if $DEBUG;
  83
  84                 my $reason_type =
  85                   $class->_upgrade_get_legacy_reason_type( $reason_class );
  86                 # XXX "noreason" does not actually work, because we limited to
  87                 # "reason is not null" above. Records where the reason string
  88                 # is null will end up with a reasonnum of null also.
  89                 my $noreason = $class->_upgrade_get_no_reason( $reason_type );
  90
  91                 foreach my $record_to_upgrade (@legacy_reason_records) {
  92                     my $reason = $record_to_upgrade->getfield($fieldname);
  93                     warn "Contemplating reason $reason\n" if $DEBUG > 1;
  94                     if ( $reason =~ /\S/ ) {
  95                         my $reason =
  96                           $class->_upgrade_get_reason( $reason, $reason_type );
  97                         $record_to_upgrade->set( $fieldname . 'num',
  98                             $reason->reasonnum );
  99                     }
 100                     else {
 101                         $record_to_upgrade->set( $fieldname . 'num',
 102                             $noreason->reasonnum );
 103                     }
 104
 105                     $record_to_upgrade->setfield( $fieldname, '' );
 106                     my $error = $record_to_upgrade->replace;
 107
 108                     my $primary_key = $record_to_upgrade->primary_key;
 109                     warn "*** WARNING: error replacing $fieldname in $class "
 110                       . $record_to_upgrade->get($primary_key)
 111                       . ": $error ***\n"
 112                       if $error;
 113                 }
 114             }
 115         }
 116     }
 117 }
 118
 119 # internal methods for upgrade
 120
 121 # _upgrade_get_legacy_reason_type is class method supposed to be used only
 122 # within the reason_Mixin class which will either find or create a reason_type
 123 sub _upgrade_get_legacy_reason_type {
 124
 125     my $class = shift;
 126     my $reason_class = shift;
 127     my $reason_type_params = { 'class' => $reason_class, 'type' => 'Legacy' };
 128     my $reason_type = qsearchs( 'reason_type', $reason_type_params );
 129     unless ($reason_type) {
 130         $reason_type = new FS::reason_type($reason_type_params);
 131         my $error = $reason_type->insert();
 132         die "$class had error inserting FS::reason_type into database: $error\n"
 133            if $error;
 134     }
 135     return $reason_type;
 136 }
 137
 138 # _upgrade_get_no_reason is class method supposed to be used only within the
 139 # reason_Mixin class which will either find or create a default (no reason)
 140 # reason
 141 sub _upgrade_get_no_reason {
 142
 143     my $class       = shift;
 144     my $reason_type = shift;
 145     return $class->_upgrade_get_reason( '(none)', $reason_type );
 146 }
 147
 148 # _upgrade_get_reason is class method supposed to be used only within the
 149 # reason_Mixin class which will either find or create a reason
 150 sub _upgrade_get_reason {
 151
 152     my $class       = shift;
 153     my $reason_text = shift;
 154     my $reason_type = shift;
 155
 156     my $reason_params = {
 157         'reason_type' => $reason_type->typenum,
 158         'reason'      => $reason_text
 159     };
 160     my $reason = qsearchs( 'reason', $reason_params );
 161     unless ($reason) {
 162         $reason_params->{'disabled'} = 'Y';
 163         $reason = new FS::reason($reason_params);
 164         my $error = $reason->insert();
 165         die "can't insert legacy reason '$reason_text' into database: $error\n"
 166            if $error;
 167      }
 168     return $reason;
 169 }
 170
 171 1;