From b3db3e68f602f3ca395a6bc272a4de6fef2d0895 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Mon, 14 Dec 2015 13:40:17 -0800 Subject: [PATCH] backport refund reasons, #39398 --- FS/FS/Schema.pm | 3 +- FS/FS/access_right.pm | 1 + FS/FS/cust_credit.pm | 124 ++++--------------------- FS/FS/cust_refund.pm | 91 +++++++++++++++++- FS/FS/reason.pm | 26 ++++-- FS/FS/reason_Mixin.pm | 96 +++++++++++++++++++ FS/FS/reason_type.pm | 2 + httemplate/edit/cust_refund.cgi | 13 ++- httemplate/edit/process/cust_refund.cgi | 9 +- httemplate/elements/menu.html | 4 + httemplate/elements/tr-select-reason.html | 6 +- httemplate/view/cust_main/payment_history.html | 2 +- 12 files changed, 250 insertions(+), 127 deletions(-) create mode 100644 FS/FS/reason_Mixin.pm diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index e55a8f1b7..0793af457 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -2134,7 +2134,8 @@ sub tables_hashref { 'refund', @money_type, '', '', 'otaker', 'varchar', 'NULL', 32, '', '', 'usernum', 'int', 'NULL', '', '', '', - 'reason', 'varchar', '', $char_d, '', '', + 'reason', 'varchar', 'NULL', $char_d, '', '', + 'reasonnum', 'int', 'NULL', '', '', '', 'payby', 'char', '', 4, '', '', # CARD/BILL/COMP, should # be index into payby # table eventually diff --git a/FS/FS/access_right.pm b/FS/FS/access_right.pm index 14a60981e..121bd4a40 100644 --- a/FS/FS/access_right.pm +++ b/FS/FS/access_right.pm @@ -252,6 +252,7 @@ sub _upgrade_data { # class method 'Unvoid credit' => 'Unvoid credit', 'Add on-the-fly void credit reason' => 'Add on-the-fly void credit reason', '_ALL' => 'Employee preference telephony integration', + 'Add on-the-fly credit reason' => 'Add on-the-fly refund reason', ); # foreach my $old_acl ( keys %onetime ) { diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm index 4e0c4c8da..25bd482c6 100644 --- a/FS/FS/cust_credit.pm +++ b/FS/FS/cust_credit.pm @@ -1,7 +1,9 @@ package FS::cust_credit; use strict; -use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::Record ); +use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::reason_Mixin + FS::Record ); + use vars qw( $conf $unsuspendauto $me $DEBUG $otaker_upgrade_kludge $ignore_empty_reasonnum ); @@ -155,16 +157,23 @@ sub insert { my $cust_main = qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); my $old_balance = $cust_main->balance; - unless ($self->reasonnum) { - my $result = $self->reason( $self->getfield('reason'), - exists($options{ 'reason_type' }) - ? ('reason_type' => $options{ 'reason_type' }) - : (), - ); - unless($result) { + if (!$self->reasonnum) { + my $reason_text = $self->get('reason') + or return "reason text or existing reason required"; + my $reason_type = $options{'reason_type'} + or return "reason type required"; + + local $@; + my $reason = FS::reason->new_or_existing( + reason => $reason_text, + type => $reason_type, + class => 'R', + ); + if ($@) { $dbh->rollback if $oldAutoCommit; - return "failed to set reason for $me"; #: ". $dbh->errstr; + return "failed to set credit reason: $@"; } + $self->set('reasonnum', $reason->reasonnum); } $self->setfield('reason', ''); @@ -460,58 +469,12 @@ sub cust_main { qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); } - =item reason Returns the text of the associated reason (see L) 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='R'"; - - $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 : '' ); -} - # _upgrade_data # # Used by FS::Upgrade to migrate to a new database. @@ -521,56 +484,9 @@ sub _upgrade_data { # class method warn "$me upgrading $class\n" if $DEBUG; - if (defined dbdef->table($class->table)->column('reason')) { - - warn "$me Checking for unmigrated reasons\n" if $DEBUG; - - my @cust_credits = qsearch({ 'table' => $class->table, - 'hashref' => {}, - 'extra_sql' => 'WHERE reason IS NOT NULL', - }); - - if (scalar(grep { $_->getfield('reason') =~ /\S/ } @cust_credits)) { - warn "$me Found unmigrated reasons\n" if $DEBUG; - my $hashref = { 'class' => 'R', '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; - } + $class->_upgrade_reasonnum(%opts); - $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_credit ( @cust_credits ) { - my $reason = $cust_credit->getfield('reason'); - warn "Contemplating reason $reason\n" if $DEBUG > 1; - if ($reason =~ /\S/) { - $cust_credit->reason($reason, 'reason_type' => $reason_type->typenum) - or die "can't insert legacy reason $reason into database\n"; - }else{ - $cust_credit->reasonnum($noreason->reasonnum); - } - - $cust_credit->setfield('reason', ''); - my $error = $cust_credit->replace; - - warn "*** WARNING: error replacing reason in $class ". - $cust_credit->crednum. ": $error ***\n" - if $error; - } - } + if (defined dbdef->table($class->table)->column('reason')) { warn "$me Ensuring existance of auto reasons\n" if $DEBUG; diff --git a/FS/FS/cust_refund.pm b/FS/FS/cust_refund.pm index 166e53783..15335a421 100644 --- a/FS/FS/cust_refund.pm +++ b/FS/FS/cust_refund.pm @@ -2,8 +2,8 @@ package FS::cust_refund; use strict; use base qw( FS::otaker_Mixin FS::payinfo_transaction_Mixin FS::cust_main_Mixin - FS::Record ); -use vars qw( @encrypted_fields ); + FS::reason_Mixin FS::Record ); +use vars qw( @encrypted_fields $me $DEBUG $ignore_empty_reasonnum ); use Business::CreditCard; use FS::UID qw(getotaker); use FS::Record qw( qsearch qsearchs dbh ); @@ -12,6 +12,13 @@ use FS::cust_credit; use FS::cust_credit_refund; use FS::cust_pay_refund; use FS::cust_main; +use FS::reason_type; +use FS::reason; + +$me = '[ FS::cust_refund ]'; +$DEBUG = 0; + +$ignore_empty_reasonnum = 0; @encrypted_fields = ('payinfo'); sub nohistory_fields { ('payinfo'); } @@ -57,7 +64,11 @@ Amount of the refund =item reason -Reason for the refund +Text stating the reason for the refund ( deprecated ) + +=item reasonnum + +Reason (see L) =item _date @@ -120,7 +131,7 @@ amount of the refund will be created. In both cases, custnum is optional. =cut sub insert { - my $self = shift; + my ($self, %options) = @_; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -133,6 +144,20 @@ sub insert { local $FS::UID::AutoCommit = 0; my $dbh = dbh; + unless ($self->reasonnum) { + my $result = $self->reason( $self->getfield('reason'), + exists($options{ 'reason_type' }) + ? ('reason_type' => $options{ 'reason_type' }) + : (), + ); + unless($result) { + $dbh->rollback if $oldAutoCommit; + return "failed to set reason for $me"; #: ". $dbh->errstr; + } + } + + $self->setfield('reason', ''); + if ( $self->crednum ) { my $cust_credit = qsearchs('cust_credit', { 'crednum' => $self->crednum } ) or do { @@ -275,13 +300,17 @@ sub check { || $self->ut_numbern('custnum') || $self->ut_money('refund') || $self->ut_alphan('otaker') - || $self->ut_text('reason') + || $self->ut_textn('reason') || $self->ut_numbern('_date') || $self->ut_textn('paybatch') || $self->ut_enum('closed', [ '', 'Y' ]) ; return $error if $error; + my $method = $ignore_empty_reasonnum ? 'ut_foreign_keyn' : 'ut_foreign_key'; + $error = $self->$method('reasonnum', 'reason', 'reasonnum'); + return $error if $error; + return "refund must be > 0 " if $self->refund <= 0; $self->_date(time) unless $self->_date; @@ -428,9 +457,61 @@ sub unapplied_sql { } +=item reason + +Returns the text of the associated reason (see L) 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 to a new database. sub _upgrade_data { # class method my ($class, %opts) = @_; + $class->_upgrade_reasonnum(%opts); $class->_upgrade_otaker(%opts); } diff --git a/FS/FS/reason.pm b/FS/FS/reason.pm index 1739f9609..f50af7ad3 100644 --- a/FS/FS/reason.pm +++ b/FS/FS/reason.pm @@ -231,7 +231,8 @@ sub merge { Fetches the reason matching these parameters if there is one. If not, inserts one. Will also insert the reason type if necessary. CLASS must -be one of 'C' (cancel reasons), 'R' (credit reasons), or 'S' (suspend reasons). +be one of 'C' (cancel reasons), 'R' (credit reasons), 'S' (suspend reasons), +or 'F' (refund reasons). This will die if anything fails. @@ -242,14 +243,25 @@ sub new_or_existing { my %opt = @_; my $error = ''; - my %hash = ('class' => $opt{'class'}, 'type' => $opt{'type'}); - my $reason_type = qsearchs('reason_type', \%hash) - || FS::reason_type->new(\%hash); + my $reason_type; + if ( ref $opt{type} eq 'FS::reason_type' ) { + $reason_type = $opt{type}; + } elsif ( $opt{type} =~ /^\d+$/ ) { + $reason_type = FS::reason_type->by_key($opt{type}); + if (!$reason_type) { + die "reason_type #$opt{type} not found\n"; + } + } else { + my %hash = ('class' => $opt{'class'}, 'type' => $opt{'type'}); + $reason_type = qsearchs('reason_type', \%hash) + || FS::reason_type->new(\%hash); - $error = $reason_type->insert unless $reason_type->typenum; - die "error inserting reason type: $error\n" if $error; + $error = $reason_type->insert unless $reason_type->typenum; + die "error inserting reason type: $error\n" if $error; + } - %hash = ('reason_type' => $reason_type->typenum, 'reason' => $opt{'reason'}); + my %hash = ('reason_type' => $reason_type->typenum, + 'reason' => $opt{'reason'}); my $reason = qsearchs('reason', \%hash) || FS::reason->new(\%hash); diff --git a/FS/FS/reason_Mixin.pm b/FS/FS/reason_Mixin.pm new file mode 100644 index 000000000..a3975419c --- /dev/null +++ b/FS/FS/reason_Mixin.pm @@ -0,0 +1,96 @@ +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 ); +use FS::reason; + +our $DEBUG = 0; +our $me = '[FS::reason_Mixin]'; + +=item reason + +Returns the text of the associated reason (see L) for this credit. + +=cut + +sub reason { + my ($self, $value, %options) = @_; + 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'); + } + if ( $self->get('addlinfo') ) { + $reason_text .= ' ' . $self->get('addlinfo'); + } + + 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. +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; diff --git a/FS/FS/reason_type.pm b/FS/FS/reason_type.pm index 4a8c03632..3e9162c94 100644 --- a/FS/FS/reason_type.pm +++ b/FS/FS/reason_type.pm @@ -10,6 +10,7 @@ our %class_name = ( 'C' => 'cancel', 'R' => 'credit', 'S' => 'suspend', + 'F' => 'refund', 'X' => 'void credit', ); @@ -18,6 +19,7 @@ our %class_purpose = ( 'R' => 'explain why a customer was credited', 'S' => 'explain why a customer package was suspended', 'X' => 'explain why a credit was voided', + 'F' => 'explain why a customer was refunded', ); =head1 NAME diff --git a/httemplate/edit/cust_refund.cgi b/httemplate/edit/cust_refund.cgi index 3c189afe6..bfcbfe725 100755 --- a/httemplate/edit/cust_refund.cgi +++ b/httemplate/edit/cust_refund.cgi @@ -106,14 +106,17 @@ % } - - Reason - - +<& /elements/tr-select-reason.html, + 'field' => 'reasonnum', + 'reason_class' => 'F', + 'control_button' => "confirm_refund_button", + 'cgi' => $cgi, +&> +
- + diff --git a/httemplate/edit/process/cust_refund.cgi b/httemplate/edit/process/cust_refund.cgi index 0fee6ed30..6ad468b6c 100755 --- a/httemplate/edit/process/cust_refund.cgi +++ b/httemplate/edit/process/cust_refund.cgi @@ -33,8 +33,13 @@ my $payby = $cgi->param('payby'); die "access denied" unless $FS::CurrentUser::CurrentUser->refund_access_right($payby); -my $error = ''; -if ( $payby =~ /^(CARD|CHEK)$/ ) { +$cgi->param('reasonnum') =~ /^(-?\d+)$/ or die "Illegal reasonnum"; +my ($reasonnum, $error) = $m->comp('/misc/process/elements/reason'); +$cgi->param('reasonnum', $reasonnum) unless $error; + +if ( $error ) { + # do nothing +} elsif ( $payby =~ /^(CARD|CHEK)$/ ) { my %options = (); my $bop = $FS::payby::payby2bop{$1}; $cgi->param('refund') =~ /^(\d*)(\.\d{2})?$/ diff --git a/httemplate/elements/menu.html b/httemplate/elements/menu.html index dfd0eaba7..0988b98db 100644 --- a/httemplate/elements/menu.html +++ b/httemplate/elements/menu.html @@ -688,6 +688,10 @@ if ( $curuser->access_right('Configuration') ) { $config_billing{'Credit reason types'} = [ $fsurl.'browse/reason_type.html?class=R', 'Credit reason types define groups of reasons.' ]; $config_billing{'Credit void reasons'} = [ $fsurl.'browse/reason.html?class=X', 'Credit void reasons explain why a credit was voided.' ]; $config_billing{'Credit void reason types'} = [ $fsurl.'browse/reason_type.html?class=X', 'Credit void reason types define groups of reasons.' ]; + + $config_billing{'separator5'} = ''; #its a separator! + $config_billing{'Refund reasons'} = [ $fsurl.'browse/reason.html?class=F', 'Refund reasons explain why a refund was issued.' ]; + $config_billing{'Refund reason types'} = [ $fsurl.'browse/reason_type.html?class=F', 'Refund reason types define groups of reasons.' ]; } #XXX also to be unified diff --git a/httemplate/elements/tr-select-reason.html b/httemplate/elements/tr-select-reason.html index 836dd9bcd..47acd854b 100755 --- a/httemplate/elements/tr-select-reason.html +++ b/httemplate/elements/tr-select-reason.html @@ -6,8 +6,8 @@ Example: #required 'field' => 'reasonnum', - 'reason_class' => 'C', # currently 'C', 'R', 'S' or 'X' - # for cancel, credit, suspend or void credit + 'reason_class' => 'C', # currently 'C', 'R', 'F', 'S' or 'X' + # for cancel, credit, refund, suspend or void credit #recommended 'cgi' => $cgi, #easiest way for things to be properly "sticky" on errors @@ -197,6 +197,8 @@ if ($class eq 'C') { $add_access_right = 'Add on-the-fly credit reason'; } elsif ($class eq 'X') { $add_access_right = 'Add on-the-fly void credit reason'; +} elsif ($class eq 'F') { + $add_access_right = 'Add on-the-fly refund reason'; } else { die "illegal class: $class"; } diff --git a/httemplate/view/cust_main/payment_history.html b/httemplate/view/cust_main/payment_history.html index 5418fb8e5..737b0e251 100644 --- a/httemplate/view/cust_main/payment_history.html +++ b/httemplate/view/cust_main/payment_history.html @@ -102,7 +102,7 @@ 'action' => "${p}edit/cust_refund.cgi?popup=1;payby=BILL", 'cust_main' => $cust_main, 'actionlabel' => emt('Enter check refund'), - 'width' => 392, + 'width' => 440, &> % } -- 2.11.0