X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Freason_Mixin.pm;h=a1b32f2b582504ddee17294bcc37caa9c7108215;hp=a4c2d3feba1d154ddc966ba713773acbf0c7eb48;hb=ff27c3f36240aee48ed50153dd5d8fe3ac3f2443;hpb=9170a3f9609625af49cd9e20003948713389c634 diff --git a/FS/FS/reason_Mixin.pm b/FS/FS/reason_Mixin.pm index a4c2d3feb..a1b32f2b5 100644 --- a/FS/FS/reason_Mixin.pm +++ b/FS/FS/reason_Mixin.pm @@ -14,20 +14,16 @@ our $me = '[FS::reason_Mixin]'; =item reason Returns the text of the associated reason (see L) for this credit / -voided payment / voided invoice. +voided payment / voided invoice. This can no longer be used to set the +(deprecated) free-text "reason" field; see L. =cut sub reason { my $self = shift; - my $reason_text; - if ( $self->reasonnum ) { - my $reason = FS::reason->by_key($self->reasonnum); - $reason_text = $reason->reason; - } else { # in case one of these somehow still exists - $reason_text = $self->get('reason'); - } + my $reason_text = $self->reason_only; + if ( $self->get('addlinfo') ) { $reason_text .= ' ' . $self->get('addlinfo'); } @@ -35,67 +31,116 @@ sub reason { return $reason_text; } -# it was a mistake to allow setting the reason this way; use -# FS::reason->new_or_existing - +=item reason_only + +Returns only the text of the associated reason, +absent any addlinfo that is included by L. +(Currently only affects credit and credit void reasons.) + +=cut + +# a bit awkward, but much easier to invoke this in the few reports +# that need separate fields than to update every place +# that displays them together + +sub reason_only { + my $self = shift; + if ( $self->reasonnum ) { + my $reason = FS::reason->by_key($self->reasonnum); + return $reason->reason; + } else { # in case one of these somehow still exists + return $self->get('reason'); + } +} + # Used by FS::Upgrade to migrate reason text fields to reasonnum. -sub _upgrade_reasonnum { # class method - my $class = shift; - my $table = $class->table; +# Note that any new tables that get reasonnum fields do NOT need to be +# added here unless they have previously had a free-text "reason" field. - if ( defined dbdef->table($table)->column('reason') - && defined dbdef->table($table)->column('reasonnum') ) - { +sub _upgrade_reasonnum { # class method + my $class = shift; + my $table = $class->table; + + my $reason_class; + if ( $table =~ /^cust_bill/ ) { # also includes cust_bill_pkg + $reason_class = 'I'; + } elsif ( $table =~ /^cust_pay/ ) { + $reason_class = 'P'; + } elsif ( $table eq 'cust_refund' ) { + $reason_class = 'F'; + } elsif ( $table =~ /^cust_credit/ ) { + $reason_class = 'R'; + } else { + die "don't know the reason class to use for upgrading $table"; + } - warn "$me Checking for unmigrated reasons\n" if $DEBUG; + for my $fieldname (qw(reason void_reason)) { - my @legacy_reason_records = qsearch( + if ( $table =~ /^cust_credit/ and $fieldname eq 'void_reason' ) { + $reason_class = 'X'; + } + + if ( defined dbdef->table($table)->column($fieldname) + && defined dbdef->table($table)->column( $fieldname . 'num' ) ) { - 'table' => $table, - 'hashref' => {}, - 'extra_sql' => 'WHERE reason IS NOT NULL', + + warn "$me Checking for unmigrated reasons\n" if $DEBUG; + + my @legacy_reason_records = qsearch( + { + 'table' => $table, + 'hashref' => {}, + 'extra_sql' => 'WHERE ' . $fieldname . ' IS NOT NULL', + } + ); + + if ( @legacy_reason_records ) { + + warn "$me Found unmigrated reasons\n" if $DEBUG; + + my $reason_type = + $class->_upgrade_get_legacy_reason_type( $reason_class ); + # XXX "noreason" does not actually work, because we limited to + # "reason is not null" above. Records where the reason string + # is null will end up with a reasonnum of null also. + my $noreason = $class->_upgrade_get_no_reason( $reason_type ); + + foreach my $record_to_upgrade (@legacy_reason_records) { + my $reason = $record_to_upgrade->getfield($fieldname); + warn "Contemplating reason $reason\n" if $DEBUG > 1; + if ( $reason =~ /\S/ ) { + my $reason = + $class->_upgrade_get_reason( $reason, $reason_type ); + $record_to_upgrade->set( $fieldname . 'num', + $reason->reasonnum ); + } + else { + $record_to_upgrade->set( $fieldname . 'num', + $noreason->reasonnum ); + } + + $record_to_upgrade->setfield( $fieldname, '' ); + my $error = $record_to_upgrade->replace; + + my $primary_key = $record_to_upgrade->primary_key; + warn "*** WARNING: error replacing $fieldname in $class " + . $record_to_upgrade->get($primary_key) + . ": $error ***\n" + if $error; + } + } } - ); - - if (scalar(grep { $_->getfield('reason') =~ /\S/ } @legacy_reason_records)) { - warn "$me Found unmigrated reasons\n" if $DEBUG; - - my $reason_type = _upgrade_get_legacy_reason_type($class, $table); - my $noreason = _upgrade_get_no_reason($class, $reason_type); - - foreach my $record_to_upgrade (@legacy_reason_records) { - my $reason = $record_to_upgrade->getfield('reason'); - warn "Contemplating reason $reason\n" if $DEBUG > 1; - if ( $reason =~ /\S/ ) { - my $reason = _upgrade_get_reason( $class, $reason, $reason_type ); - $record_to_upgrade->reasonnum( $reason->reasonnum ); - } - else { - $record_to_upgrade->reasonnum( $noreason->reasonnum ); - } - - $record_to_upgrade->setfield( 'reason', '' ); - my $error = $record_to_upgrade->replace; - - my $primary_key = $record_to_upgrade->primary_key; - warn "*** WARNING: error replacing reason in $class " - . $record_to_upgrade->get($primary_key) - . ": $error ***\n" - if $error; - } } - } } +# internal methods for upgrade + # _upgrade_get_legacy_reason_type is class method supposed to be used only # within the reason_Mixin class which will either find or create a reason_type sub _upgrade_get_legacy_reason_type { my $class = shift; - my $table = shift; - - my $reason_class = - ( $table =~ /void/ ) ? 'X' : 'F'; # see FS::reason_type (%class_name) + my $reason_class = shift; my $reason_type_params = { 'class' => $reason_class, 'type' => 'Legacy' }; my $reason_type = qsearchs( 'reason_type', $reason_type_params ); unless ($reason_type) { @@ -114,7 +159,7 @@ sub _upgrade_get_no_reason { my $class = shift; my $reason_type = shift; - return _upgrade_get_reason( $class, '(none)', $reason_type ); + return $class->_upgrade_get_reason( '(none)', $reason_type ); } # _upgrade_get_reason is class method supposed to be used only within the