1 package FS::reason_Mixin;
4 use Carp qw( croak ); #confess );
5 use FS::Record qw( qsearch qsearchs dbdef );
12 our $me = '[FS::reason_Mixin]';
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>.
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');
32 if ( $self->get('addlinfo') ) {
33 $reason_text .= ' ' . $self->get('addlinfo');
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.
43 sub _upgrade_reasonnum { # class method
45 my $table = $class->table;
48 if ( $table eq 'cust_bill' or $table eq 'cust_bill_pkg' ) {
50 } elsif ( $table eq 'cust_pay' ) {
52 } elsif ( $table eq 'cust_refund' ) {
54 } elsif ( $table eq 'cust_credit' ) {
57 die "don't know the reason class to use for upgrading $table";
60 for my $fieldname (qw(reason void_reason)) {
62 if ( $table eq 'cust_credit' and $fieldname eq 'void_reason' ) {
66 if ( defined dbdef->table($table)->column($fieldname)
67 && defined dbdef->table($table)->column( $fieldname . 'num' ) )
70 warn "$me Checking for unmigrated reasons\n" if $DEBUG;
72 my @legacy_reason_records = qsearch(
76 'extra_sql' => 'WHERE ' . $fieldname . ' IS NOT NULL',
82 grep { $_->getfield($fieldname) =~ /\S/ }
83 @legacy_reason_records
87 warn "$me Found unmigrated reasons\n" if $DEBUG;
90 _upgrade_get_legacy_reason_type( $class, $table );
91 my $noreason = _upgrade_get_no_reason( $class, $reason_type );
93 foreach my $record_to_upgrade (@legacy_reason_records) {
94 my $reason = $record_to_upgrade->getfield($fieldname);
95 warn "Contemplating reason $reason\n" if $DEBUG > 1;
96 if ( $reason =~ /\S/ ) {
98 _upgrade_get_reason( $class, $reason, $reason_type );
99 $record_to_upgrade->set( $fieldname . 'num',
100 $reason->reasonnum );
103 $record_to_upgrade->set( $fieldname . 'num',
104 $noreason->reasonnum );
107 $record_to_upgrade->setfield( $fieldname, '' );
108 my $error = $record_to_upgrade->replace;
110 my $primary_key = $record_to_upgrade->primary_key;
111 warn "*** WARNING: error replacing $fieldname in $class "
112 . $record_to_upgrade->get($primary_key)
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 {
129 ( $table =~ /void/ ) ? 'X' : 'F'; # see FS::reason_type (%class_name)
130 my $reason_type_params = { 'class' => $reason_class, 'type' => 'Legacy' };
131 my $reason_type = qsearchs( 'reason_type', $reason_type_params );
132 unless ($reason_type) {
133 $reason_type = new FS::reason_type($reason_type_params);
134 my $error = $reason_type->insert();
135 die "$class had error inserting FS::reason_type into database: $error\n"
141 # _upgrade_get_no_reason is class method supposed to be used only within the
142 # reason_Mixin class which will either find or create a default (no reason)
144 sub _upgrade_get_no_reason {
147 my $reason_type = shift;
148 return _upgrade_get_reason( $class, '(none)', $reason_type );
151 # _upgrade_get_reason is class method supposed to be used only within the
152 # reason_Mixin class which will either find or create a reason
153 sub _upgrade_get_reason {
156 my $reason_text = shift;
157 my $reason_type = shift;
159 my $reason_params = {
160 'reason_type' => $reason_type->typenum,
161 'reason' => $reason_text
163 my $reason = qsearchs( 'reason', $reason_params );
165 $reason_params->{'disabled'} = 'Y';
166 $reason = new FS::reason($reason_params);
167 my $error = $reason->insert();
168 die "can't insert legacy reason '$reason_text' into database: $error\n"