1 package FS::reason_Mixin;
4 use Carp qw( croak ); #confess );
5 use FS::Record qw( qsearch qsearchs dbdef );
10 our $me = '[FS::reason_Mixin]';
14 Returns the text of the associated reason (see L<FS::reason>) for this credit.
19 my ($self, $value, %options) = @_;
22 my $typenum = $options{'reason_type'};
24 my $oldAutoCommit = $FS::UID::AutoCommit; # this should already be in
25 local $FS::UID::AutoCommit = 0; # a transaction if it matters
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'";
33 $reason = qsearchs( { 'table' => 'reason',
34 'hashref' => $hashref,
35 'addl_from' => $addl_from,
36 'extra_sql' => $extra_sql,
39 if (!$reason && $typenum) {
40 $reason = new FS::reason( { 'reason_type' => $typenum,
44 my $error = $reason->insert;
46 warn "error inserting reason: $error\n";
51 $self->reasonnum($reason ? $reason->reasonnum : '') ;
52 warn "$me reason used in set mode with non-existant reason -- clearing"
55 $reason = qsearchs( 'reason', { 'reasonnum' => $self->reasonnum } );
57 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
59 ( $reason ? $reason->reason : '' ).
60 ( $self->addlinfo ? ' '.$self->addlinfo : '' );
63 # Used by FS::Upgrade to migrate reason text fields to reasonnum.
64 sub _upgrade_reasonnum { # class method
66 my $table = $class->table;
68 if (defined dbdef->table($table)->column('reason')) {
70 warn "$me Checking for unmigrated reasons\n" if $DEBUG;
72 my @cust_refunds = qsearch({ 'table' => $table,
74 'extra_sql' => 'WHERE reason IS NOT NULL',
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"
88 $hashref = { 'reason_type' => $reason_type->typenum,
91 my $noreason = qsearchs( 'reason', $hashref );
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"
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";
107 $cust_refund->reasonnum($noreason->reasonnum);
110 $cust_refund->setfield('reason', '');
111 my $error = $cust_refund->replace;
113 warn "*** WARNING: error replacing reason in $class ".
114 $cust_refund->refundnum. ": $error ***\n"