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