diff options
Diffstat (limited to 'FS')
| -rw-r--r-- | FS/FS/cust_pay_void.pm | 2 | ||||
| -rw-r--r-- | FS/FS/reason_Mixin.pm | 54 | ||||
| -rw-r--r-- | FS/FS/reason_type.pm | 23 |
3 files changed, 56 insertions, 23 deletions
diff --git a/FS/FS/cust_pay_void.pm b/FS/FS/cust_pay_void.pm index 8fd539616..72ada2534 100644 --- a/FS/FS/cust_pay_void.pm +++ b/FS/FS/cust_pay_void.pm @@ -234,6 +234,8 @@ Returns the text of the associated void reason (see L<FS::reason>) for this. sub _upgrade_data { # class method my ($class, %opts) = @_; + local $FS::payinfo_Mixin::ignore_masked_payinfo = 1; + $class->_upgrade_reasonnum(%opts); my $sql = "SELECT usernum FROM access_user WHERE username = ( SELECT history_user FROM h_cust_pay_void WHERE paynum = ? AND history_action = 'insert' ORDER BY history_date LIMIT 1 ) "; diff --git a/FS/FS/reason_Mixin.pm b/FS/FS/reason_Mixin.pm index af9aa50e6..9c436ab1e 100644 --- a/FS/FS/reason_Mixin.pm +++ b/FS/FS/reason_Mixin.pm @@ -14,7 +14,8 @@ our $me = '[FS::reason_Mixin]'; =item reason Returns the text of the associated reason (see L<FS::reason>) 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<FS::reason/new_or_existing>. =cut @@ -35,15 +36,33 @@ sub reason { return $reason_text; } -# it was a mistake to allow setting the reason this way; use -# FS::reason->new_or_existing - # Used by FS::Upgrade to migrate reason text fields to reasonnum. +# 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. + 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"; + } + for my $fieldname (qw(reason void_reason)) { + + 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' ) ) { @@ -58,25 +77,23 @@ sub _upgrade_reasonnum { # class method } ); - if ( - scalar( - grep { $_->getfield($fieldname) =~ /\S/ } - @legacy_reason_records - ) - ) - { + if ( @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 ); + $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 = - _upgrade_get_reason( $class, $reason, $reason_type ); + $class->_upgrade_get_reason( $reason, $reason_type ); $record_to_upgrade->set( $fieldname . 'num', $reason->reasonnum ); } @@ -99,15 +116,14 @@ sub _upgrade_reasonnum { # class method } } +# 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) { @@ -126,7 +142,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 diff --git a/FS/FS/reason_type.pm b/FS/FS/reason_type.pm index 4042972b4..1d049861d 100644 --- a/FS/FS/reason_type.pm +++ b/FS/FS/reason_type.pm @@ -3,15 +3,18 @@ package FS::reason_type; use strict; use vars qw( @ISA ); use FS::Record qw( qsearch qsearchs ); +use Tie::IxHash; @ISA = qw(FS::Record); -our %class_name = ( +tie our %class_name, 'Tie::IxHash', ( 'C' => 'cancel', 'R' => 'credit', 'S' => 'suspend', 'F' => 'refund', - 'X' => 'void', # credit/invoice/payment + 'X' => 'credit void', + 'I' => 'invoice void', + 'P' => 'payment void', ); our %class_purpose = ( @@ -19,7 +22,19 @@ our %class_purpose = ( 'R' => 'explain why a customer was credited', 'S' => 'explain why a customer package was suspended', 'F' => 'explain why a customer was refunded', - 'X' => 'explain why a transaction was voided', + 'X' => 'explain why a credit was voided', + 'I' => 'explain why an invoice was voided', + 'P' => 'explain why a payment was voided', +); + +our %class_add_access_right = ( + 'C' => 'Add on-the-fly cancel reason', + 'R' => 'Add on-the-fly credit reason', + 'S' => 'Add on-the-fly suspend reason', + 'F' => 'Add on-the-fly refund reason', + 'X' => 'Add on-the-fly void reason', + 'I' => 'Add on-the-fly void reason', + 'P' => 'Add on-the-fly void reason', ); =head1 NAME @@ -50,7 +65,7 @@ inherits from FS::Record. The following fields are currently supported: =item typenum - primary key -=item class - currently 'C', 'R', 'S', 'F' or 'X' for cancel, credit, suspend, refund or void credit +=item class - one of the keys of %class_name =item type - name of the type of reason |