diff options
| -rw-r--r-- | FS/FS/AccessRight.pm | 1 | ||||
| -rw-r--r-- | FS/FS/Schema.pm | 6 | ||||
| -rw-r--r-- | FS/FS/access_right.pm | 1 | ||||
| -rw-r--r-- | FS/FS/cust_credit.pm | 103 | ||||
| -rw-r--r-- | FS/FS/cust_refund.pm | 42 | ||||
| -rw-r--r-- | FS/FS/reason_Mixin.pm | 121 | ||||
| -rw-r--r-- | FS/FS/reason_type.pm | 2 | ||||
| -rwxr-xr-x | httemplate/edit/cust_refund.cgi | 13 | ||||
| -rw-r--r-- | httemplate/elements/menu.html | 4 | ||||
| -rwxr-xr-x | httemplate/elements/tr-select-reason.html | 6 |
10 files changed, 186 insertions, 113 deletions
diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm index 4b165eb3f..4d9cff99e 100644 --- a/FS/FS/AccessRight.pm +++ b/FS/FS/AccessRight.pm @@ -230,6 +230,7 @@ tie my %rights, 'Tie::IxHash', 'Refund Echeck payment', 'Delete refund', #NEW 'Add on-the-fly credit reason', #NEW + 'Add on-the-fly refund reason', #NEW ], ### diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index a9fc13d95..bf756d129 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -2853,7 +2853,8 @@ sub tables_hashref { 'currency', 'char', 'NULL', 3, '', '', '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 @@ -2877,6 +2878,9 @@ sub tables_hashref { { columns => [ 'usernum' ], table => 'access_user', }, + { columns => [ 'reasonnum' ], + table => 'reason', + }, { columns => [ 'gatewaynum' ], table => 'payment_gateway', }, diff --git a/FS/FS/access_right.pm b/FS/FS/access_right.pm index 0906c0c9a..d26db4895 100644 --- a/FS/FS/access_right.pm +++ b/FS/FS/access_right.pm @@ -244,6 +244,7 @@ sub _upgrade_data { # class method 'Services: Accounts' => 'Services: Conferencing', 'Services: Accounts' => 'Services: Video', 'Edit global package definitions' => 'Edit package definition costs', + '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 189084525..58bd475b1 100644 --- a/FS/FS/cust_credit.pm +++ b/FS/FS/cust_credit.pm @@ -1,5 +1,6 @@ package FS::cust_credit; -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 strict; use vars qw( $conf $unsuspendauto $me $DEBUG @@ -447,57 +448,8 @@ sub credited { Returns the customer (see L<FS::cust_main>) for this credit. -=item reason - -Returns the text of the associated reason (see L<FS::reason>) 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. @@ -507,56 +459,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 d29db5cfa..e3fc910ec 100644 --- a/FS/FS/cust_refund.pm +++ b/FS/FS/cust_refund.pm @@ -2,15 +2,22 @@ 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::Record qw( qsearch qsearchs dbh ); +use FS::Record qw( qsearch qsearchs dbh dbdef ); use FS::CurrentUser; 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'); } @@ -56,7 +63,11 @@ Amount of the refund =item reason -Reason for the refund +Text stating the reason for the refund ( deprecated ) + +=item reasonnum + +Reason (see L<FS::reason>) =item _date @@ -119,7 +130,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'; @@ -132,6 +143,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 { @@ -274,13 +299,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; @@ -380,6 +409,7 @@ sub unapplied_sql { # 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_Mixin.pm b/FS/FS/reason_Mixin.pm new file mode 100644 index 000000000..fdf796219 --- /dev/null +++ b/FS/FS/reason_Mixin.pm @@ -0,0 +1,121 @@ +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 ); + +our $DEBUG = 0; +our $me = '[FS::reason_Mixin]'; + +=item reason + +Returns the text of the associated reason (see L<FS::reason>) 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 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 a603809e2..00ac9a87e 100644 --- a/FS/FS/reason_type.pm +++ b/FS/FS/reason_type.pm @@ -10,12 +10,14 @@ our %class_name = ( 'C' => 'cancel', 'R' => 'credit', 'S' => 'suspend', + 'F' => 'refund', ); our %class_purpose = ( 'C' => 'explain why a customer package was cancelled', 'R' => 'explain why a customer was credited', 'S' => 'explain why a customer package was suspended', + 'F' => 'explain why a customer was refunded', ); =head1 NAME diff --git a/httemplate/edit/cust_refund.cgi b/httemplate/edit/cust_refund.cgi index df42e63ae..9f7ac8dee 100755 --- a/httemplate/edit/cust_refund.cgi +++ b/httemplate/edit/cust_refund.cgi @@ -106,14 +106,17 @@ <INPUT TYPE="hidden" NAME="payinfo" VALUE=""> % } - <TR> - <TD ALIGN="right">Reason</TD> - <TD BGCOLOR="#ffffff"><INPUT TYPE="text" NAME="reason" VALUE="<% $reason %>"></TD> - </TR> +<& /elements/tr-select-reason.html, + 'field' => 'reasonnum', + 'reason_class' => 'F', + 'control_button' => "document.getElementById('confirm_refund_button')", + 'cgi' => $cgi, +&> + </TABLE> <BR> -<INPUT TYPE="submit" NAME="submit" VALUE="Post refund"> +<INPUT TYPE="submit" ID="confirm_refund_button" VALUE="<% mt('Post refund') |h %>" DISABLED> </FORM> diff --git a/httemplate/elements/menu.html b/httemplate/elements/menu.html index cd4fb39ec..4ba7b2f00 100644 --- a/httemplate/elements/menu.html +++ b/httemplate/elements/menu.html @@ -656,6 +656,10 @@ if ( $curuser->access_right('Configuration') ) { $config_billing{'separator4'} = ''; #its a separator! $config_billing{'Credit reasons'} = [ $fsurl.'browse/reason.html?class=R', 'Credit reasons explain why a credit was issued.' ]; $config_billing{'Credit reason types'} = [ $fsurl.'browse/reason_type.html?class=R', 'Credit 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 9a670a26b..b7a715b42 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', or 'S' - # for cancel, credit, or suspend + 'reason_class' => 'C', # currently 'C', 'R', 'F', or 'S' + # for cancel, credit, refund, or suspend #recommended 'cgi' => $cgi, #easiest way for things to be properly "sticky" on errors @@ -161,6 +161,8 @@ if ($class eq 'C') { $add_access_right = 'Add on-the-fly suspend reason'; } elsif ($class eq 'R') { $add_access_right = 'Add on-the-fly credit reason'; +} elsif ($class eq 'F') { + $add_access_right = 'Add on-the-fly refund reason'; } else { die "illegal class: $class"; } |