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.
25 if ( $self->reasonnum ) {
26 my $reason = FS::reason->by_key($self->reasonnum);
27 $reason_text = $reason->reason;
28 } else { # in case one of these somehow still exists
29 $reason_text = $self->get('reason');
31 if ( $self->get('addlinfo') ) {
32 $reason_text .= ' ' . $self->get('addlinfo');
38 # it was a mistake to allow setting the reason this way; use
39 # FS::reason->new_or_existing
41 # Used by FS::Upgrade to migrate reason text fields to reasonnum.
42 sub _upgrade_reasonnum { # class method
44 my $table = $class->table;
46 for my $fieldname (qw(reason void_reason)) {
47 if ( defined dbdef->table($table)->column($fieldname)
48 && defined dbdef->table($table)->column( $fieldname . 'num' ) )
51 warn "$me Checking for unmigrated reasons\n" if $DEBUG;
53 my @legacy_reason_records = qsearch(
57 'extra_sql' => 'WHERE ' . $fieldname . ' IS NOT NULL',
63 grep { $_->getfield($fieldname) =~ /\S/ }
64 @legacy_reason_records
68 warn "$me Found unmigrated reasons\n" if $DEBUG;
71 _upgrade_get_legacy_reason_type( $class, $table );
72 my $noreason = _upgrade_get_no_reason( $class, $reason_type );
74 foreach my $record_to_upgrade (@legacy_reason_records) {
75 my $reason = $record_to_upgrade->getfield($fieldname);
76 warn "Contemplating reason $reason\n" if $DEBUG > 1;
77 if ( $reason =~ /\S/ ) {
79 _upgrade_get_reason( $class, $reason, $reason_type );
80 $record_to_upgrade->set( $fieldname . 'num',
84 $record_to_upgrade->set( $fieldname . 'num',
85 $noreason->reasonnum );
88 $record_to_upgrade->setfield( $fieldname, '' );
89 my $error = $record_to_upgrade->replace;
91 my $primary_key = $record_to_upgrade->primary_key;
92 warn "*** WARNING: error replacing $fieldname in $class "
93 . $record_to_upgrade->get($primary_key)
102 # _upgrade_get_legacy_reason_type is class method supposed to be used only
103 # within the reason_Mixin class which will either find or create a reason_type
104 sub _upgrade_get_legacy_reason_type {
110 ( $table =~ /void/ ) ? 'X' : 'F'; # see FS::reason_type (%class_name)
111 my $reason_type_params = { 'class' => $reason_class, 'type' => 'Legacy' };
112 my $reason_type = qsearchs( 'reason_type', $reason_type_params );
113 unless ($reason_type) {
114 $reason_type = new FS::reason_type($reason_type_params);
115 my $error = $reason_type->insert();
116 die "$class had error inserting FS::reason_type into database: $error\n"
122 # _upgrade_get_no_reason is class method supposed to be used only within the
123 # reason_Mixin class which will either find or create a default (no reason)
125 sub _upgrade_get_no_reason {
128 my $reason_type = shift;
129 return _upgrade_get_reason( $class, '(none)', $reason_type );
132 # _upgrade_get_reason is class method supposed to be used only within the
133 # reason_Mixin class which will either find or create a reason
134 sub _upgrade_get_reason {
137 my $reason_text = shift;
138 my $reason_type = shift;
140 my $reason_params = {
141 'reason_type' => $reason_type->typenum,
142 'reason' => $reason_text
144 my $reason = qsearchs( 'reason', $reason_params );
146 $reason_params->{'disabled'} = 'Y';
147 $reason = new FS::reason($reason_params);
148 my $error = $reason->insert();
149 die "can't insert legacy reason '$reason_text' into database: $error\n"