'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
'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 ) {
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
);
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', '');
qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
}
-
=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.
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;
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 );
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'); }
=item reason
-Reason for the refund
+Text stating the reason for the refund ( deprecated )
+
+=item reasonnum
+
+Reason (see L<FS::reason>)
=item _date
=cut
sub insert {
- my $self = shift;
+ my ($self, %options) = @_;
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
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 {
|| $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;
}
+=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 to a new database.
sub _upgrade_data { # class method
my ($class, %opts) = @_;
+ $class->_upgrade_reasonnum(%opts);
$class->_upgrade_otaker(%opts);
}
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.
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);
--- /dev/null
+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<FS::reason>) 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;
'C' => 'cancel',
'R' => 'credit',
'S' => 'suspend',
+ 'F' => 'refund',
'X' => 'void credit',
);
'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
<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' => "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>
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})?$/
$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
#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
$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";
}
'action' => "${p}edit/cust_refund.cgi?popup=1;payby=BILL",
'cust_main' => $cust_main,
'actionlabel' => emt('Enter check refund'),
- 'width' => 392,
+ 'width' => 440,
&>
% }
projects / freeside.git / commitdiff