| pay_cert.tag (interchange-5.8.2) | : | pay_cert.tag (interchange-5.10.0) |
|---|
|
| # Copyright 2004-2007 Interchange Development Group and others | | |
| # | | |
| # This program is free software; you can redistribute it and/or modify | | |
| # it under the terms of the GNU General Public License as published by | | |
| # the Free Software Foundation; either version 2 of the License, or | | |
| # (at your option) any later version. See the LICENSE file for details. | | |
| # | | |
| # $Id: pay_cert.tag,v 1.4 2009-05-01 13:50:00 pajamian Exp $ | | |
| | | |
| UserTag pay-cert Order code | | UserTag pay-cert Order code |
| UserTag pay-cert addAttr | | UserTag pay-cert addAttr |
| UserTag pay-cert Routine <<EOR | | UserTag pay-cert Routine <<EOR |
| sub { | | sub { |
| my ($code, $opt) = @_; | | my ($code, $opt) = @_; |
| | |
| use vars qw/$Tag/; | | use vars qw/$Tag/; |
|
| | |
| | my ($log, $die2, $warn) = $Tag->logger('pay_cert', 'logs/pay_cert.log'); |
| | |
| my $counter_file = $::Variable->{GIFT_CERT_COUNTER} || 'etc/pay_cert.numb
er'; | | my $counter_file = $::Variable->{GIFT_CERT_COUNTER} || 'etc/pay_cert.numb
er'; |
| my $cert_table = $::Variable->{GIFT_CERT_TABLE} || 'pay_
certs'; | | my $cert_table = $::Variable->{GIFT_CERT_TABLE} || 'pay_
certs'; |
| my $redeem_table = $::Variable->{GIFT_CERT_REDEEM_TABLE} || 'pay_cert_red
eem'; | | my $redeem_table = $::Variable->{GIFT_CERT_REDEEM_TABLE} || 'pay_cert_red
eem'; |
| my $lock_table = $::Variable->{GIFT_CERT_LOCK_TABLE} || 'pay_cert_loc
k'; | | my $lock_table = $::Variable->{GIFT_CERT_LOCK_TABLE} || 'pay_cert_loc
k'; |
| | |
| my $ldb = dbref($lock_table) | | my $ldb = dbref($lock_table) |
|
| or die errmsg("cannot open payment certs lock table '%s'", $lock_
table); | | or return $die2->("cannot open payment certs lock table '%s'", $l
ock_table); |
| | |
| my $ltab = $ldb->name(); | | my $ltab = $ldb->name(); |
| my $ldbh = $ldb->dbh() | | my $ldbh = $ldb->dbh() |
|
| or die errmsg("cannot get handle for certs lock table '%s'", $loc
k_table); | | or return $die2->("cannot get handle for certs lock table '%s'",
$lock_table); |
| my $q = "insert into $ltab (code, pid, ip_addr) values (?,?,?)"; | | my $q = "insert into $ltab (code, pid, ip_addr) values (?,?,?)"; |
| | |
| my $locked; | | my $locked; |
| | |
| my $sth_lock = $ldbh->prepare($q) | | my $sth_lock = $ldbh->prepare($q) |
|
| or die errmsg("cannot prepare lock query '%s'", $q); | | or return $die2->("cannot prepare lock query '%s'", $q); |
| | |
| $q = "delete from $ltab where code = ?"; | | $q = "delete from $ltab where code = ?"; |
| my $sth_unlock = $ldbh->prepare($q) | | my $sth_unlock = $ldbh->prepare($q) |
|
| or die errmsg("cannot prepare lock query '%s'", $q); | | or return $die2->("cannot prepare lock query '%s'", $q); |
| | | |
| $opt->{code_scratch} = 'pay_cert_code' unless defined $opt->{cod | | |
| e_scratch}; | | |
| $opt->{check_scratch} = 'pay_cert_check' unless defined $opt->{che | | |
| ck_scratch}; | | |
| $opt->{order_number} ||= $::Values->{mv_order_number}; | | |
| | |
| if($opt->{transaction}) { | | |
| $opt->{$opt->{transaction}} = 1; | | |
| } | | |
| | |
| my $errname; | | |
| | |
| my $die = sub { | | my $die = sub { |
| my $msg = errmsg(@_); | | my $msg = errmsg(@_); |
|
| ::logError($msg); | | Log( "died: $msg", { file => 'logs/pay_cert.log' }); |
| $errname ||= 'pay_certificate'; | | |
| eval { | | eval { |
| $sth_unlock->execute($code) if $locked; | | $sth_unlock->execute($code) if $locked; |
| }; | | }; |
|
| $Tag->error( { name => $errname, set => $msg } ); | | $Tag->error( { name => 'pay_cert', set => $msg } ); |
| return undef; | | return undef; |
| }; | | }; |
| | |
|
| | $opt->{code_scratch} = 'pay_cert_code' unless defined $opt->{cod |
| | e_scratch}; |
| | $opt->{check_scratch} = 'pay_cert_check' unless defined $opt->{che |
| | ck_scratch}; |
| | $opt->{order_number} ||= $::Values->{mv_order_number}; |
| | |
| | if($opt->{transaction}) { |
| | $opt->{$opt->{transaction}} = 1; |
| | } |
| | |
| if($opt->{issue}) { | | if($opt->{issue}) { |
| if(! $opt->{order_number}) { | | if(! $opt->{order_number}) { |
| return $die->("Must have order number to issue payment ce
rtificate. Not issued."); | | return $die->("Must have order number to issue payment ce
rtificate. Not issued."); |
| } | | } |
| if(! $opt->{amount}) { | | if(! $opt->{amount}) { |
| return $die->("Must specify amount to issue payment certi
ficate. Not issued."); | | return $die->("Must specify amount to issue payment certi
ficate. Not issued."); |
| } | | } |
| | |
| ## Time to issue a certificate | | ## Time to issue a certificate |
| my $start = int(rand 300000); | | my $start = int(rand 300000); |
| | |
| skipping to change at line 96 | | skipping to change at line 87 |
|---|
| $date_expires[5] += $1; | | $date_expires[5] += $1; |
| } | | } |
| elsif($opt->{expires} =~ /^\s*(\d+)\s*mon/i) { | | elsif($opt->{expires} =~ /^\s*(\d+)\s*mon/i) { |
| @date_expires = @date_issued; | | @date_expires = @date_issued; |
| $date_expires[4] += $1; | | $date_expires[4] += $1; |
| } | | } |
| elsif($opt->{expires} =~ /^\s*(\d+)\s*[mhdwy]/) { | | elsif($opt->{expires} =~ /^\s*(\d+)\s*[mhdwy]/) { |
| @date_expires = localtime(adjust_time($opt->{expires}, $n
ow)); | | @date_expires = localtime(adjust_time($opt->{expires}, $n
ow)); |
| } | | } |
| elsif($opt->{expires}) { | | elsif($opt->{expires}) { |
|
| ::logError("Expiration date '%s' not understood, ignoring
.", $opt->{expires}); | | $log->("Expiration date '%s' not understood, ignoring.",
$opt->{expires}); |
| } | | } |
| | |
| if(@date_expires) { | | if(@date_expires) { |
| $expire_date = POSIX::strftime('%Y%m%d%H%M%S', @date_expi
res); | | $expire_date = POSIX::strftime('%Y%m%d%H%M%S', @date_expi
res); |
| } | | } |
| | |
|
| #::logDebug("generated code=$code, expires=$opt->{expires} date_expires=$expire_
date "); | | $log->("generated code=$code, expires=$opt->{expires} date_expires=$expire_date
"); |
| my $check = int rand(10); | | my $check = int rand(10); |
| $check .= int(rand(10)) while length($check) < 4; | | $check .= int(rand(10)) while length($check) < 4; |
|
| #::logDebug("generated check=$check"); | | #$log->("generated check=$check"); |
| my %record = ( | | my %record = ( |
| amount => $opt->{amount}, | | amount => $opt->{amount}, |
| ip_addr => $CGI::remote_addr, | | ip_addr => $CGI::remote_addr, |
| order_number => $opt->{order_number}, | | order_number => $opt->{order_number}, |
| date_issued => $issue_date, | | date_issued => $issue_date, |
| date_expires => $expire_date, | | date_expires => $expire_date, |
| check_value => $check, | | check_value => $check, |
| orig_amount => $opt->{amount}, | | orig_amount => $opt->{amount}, |
| process_flag => 0, | | process_flag => 0, |
| ); | | ); |
| my $db = dbref($cert_table) | | my $db = dbref($cert_table) |
|
| or die errmsg("cannot open pay_cert table '%s'", $cert_ta
ble); | | or return $die->("cannot open pay_cert table '%s'", $cert
_table); |
| $db->set_slice($code, \%record) | | $db->set_slice($code, \%record) |
|
| or die errmsg("cannot write cert number $code in pay_cert
table '%s'", $cert_table); | | or return $die->("cannot write cert number $code in pay_c
ert table '%s'", $cert_table); |
| | |
| ## Create expire date for cookie | | ## Create expire date for cookie |
| my $edate; | | my $edate; |
| $edate = POSIX::strftime("%a, %d-%b-%Y %H:%M:%S GMT ", @date_expi
res) | | $edate = POSIX::strftime("%a, %d-%b-%Y %H:%M:%S GMT ", @date_expi
res) |
| unless ! $expire_date or $opt->{no_cookie}; | | unless ! $expire_date or $opt->{no_cookie}; |
| | |
| if($opt->{code_scratch}) { | | if($opt->{code_scratch}) { |
|
| $::Scratch->{$opt->{code_scratch}} = $code; | | $::Scratch->{$opt->{code_scratch}} = $code unless $opt->{
no_cookie}; |
| unless( ! $edate or $opt->{no_cookie}) { | | unless( ! $edate or $opt->{no_cookie}) { |
|
| #::logDebug("setting cookie"); | | #$log->("setting code cookie"); |
| my $prior_cookie = $Tag->read_cookie({name => 'MV
_GIFT_CERT_CODE'}); | | my $prior_cookie = $Tag->read_cookie({name => 'MV
_GIFT_CERT_CODE'}); |
| my $cvalue = $code; | | my $cvalue = $code; |
| if($prior_cookie) { | | if($prior_cookie) { |
| $cvalue = join ",", $prior_cookie, $cvalu
e; | | $cvalue = join ",", $prior_cookie, $cvalu
e; |
| } | | } |
| $Tag->set_cookie({ | | $Tag->set_cookie({ |
| name => 'MV_GIFT_
CERT_CODE', | | name => 'MV_GIFT_
CERT_CODE', |
| expire => $edate, | | expire => $edate, |
| value => $cvalue, | | value => $cvalue, |
| }); | | }); |
| } | | } |
| } | | } |
| | |
| if($opt->{check_scratch}) { | | if($opt->{check_scratch}) { |
|
| $::Scratch->{$opt->{check_scratch}} = $check; | | $::Scratch->{$opt->{check_scratch}} = $check unless $opt-
>{no_cookie}; |
| my $prior_cookie = $Tag->read_cookie({name => 'MV_GIFT_CE
RT_CHECK'}); | | my $prior_cookie = $Tag->read_cookie({name => 'MV_GIFT_CE
RT_CHECK'}); |
| my $cvalue = $check; | | my $cvalue = $check; |
| if($prior_cookie) { | | if($prior_cookie) { |
| $cvalue = join ",", $prior_cookie, $cvalue; | | $cvalue = join ",", $prior_cookie, $cvalue; |
| } | | } |
| unless( ! $edate or $opt->{no_cookie}) { | | unless( ! $edate or $opt->{no_cookie}) { |
|
| #::logDebug("setting cookie"); | | #$log->("setting cookie"); |
| $Tag->set_cookie({ | | $Tag->set_cookie({ |
| name => '
MV_GIFT_CERT_CHECK', | | name => '
MV_GIFT_CERT_CHECK', |
| expire =>
$edate, | | expire =>
$edate, |
| value =>
$cvalue, | | value =>
$cvalue, |
| }); | | }); |
| } | | } |
| } | | } |
| | |
| if(defined $opt->{item_pointer}) { | | if(defined $opt->{item_pointer}) { |
| my $ptr = $opt->{item_pointer}; | | my $ptr = $opt->{item_pointer}; |
| my $cart = $opt->{cart} | | my $cart = $opt->{cart} |
| ? ($Vend::Session->{carts}{$opt->
{cart}}) | | ? ($Vend::Session->{carts}{$opt->
{cart}}) |
| : $Vend::Items; | | : $Vend::Items; |
| my $item = $cart->[$ptr]; | | my $item = $cart->[$ptr]; |
| $item->{pay_cert_code} = $code; | | $item->{pay_cert_code} = $code; |
| $item->{pay_cert_check} = $check; | | $item->{pay_cert_check} = $check; |
| } | | } |
|
| return $code; | | return $opt->{admin} ? "$code/$check" : $code; |
| } | | } |
| | |
| my $cdb = dbref($cert_table) | | my $cdb = dbref($cert_table) |
|
| or die errmsg("cannot open pay_certs table '%s'", $cert_table); | | or return $die->("cannot open pay_certs table '%s'", $cert_table)
; |
| | |
| my $status; | | my $status; |
| | |
| my $record; | | my $record; |
| | |
| my $rdb = dbref($redeem_table) | | my $rdb = dbref($redeem_table) |
| or return $die->("Cannot open redemption table %s", $redeem_table
); | | or return $die->("Cannot open redemption table %s", $redeem_table
); |
| my $rname = $rdb->name(); | | my $rname = $rdb->name(); |
| my $rdbh = $rdb->dbh() | | my $rdbh = $rdb->dbh() |
| or return $die->("Cannot get redemption table %s DBI handle", $re
deem_table); | | or return $die->("Cannot get redemption table %s DBI handle", $re
deem_table); |
| | |
| skipping to change at line 214 | | skipping to change at line 205 |
|---|
| trans_type => 'auth', | | trans_type => 'auth', |
| voided => 0, | | voided => 0, |
| captured => 0, | | captured => 0, |
| username => $Vend::username, | | username => $Vend::username, |
| amount => $opt->{amount}, | | amount => $opt->{amount}, |
| items => $opt->{items}, | | items => $opt->{items}, |
| ); | | ); |
| | |
| $opt->{tid} = $status = $rdb->set_slice(undef, \%redeem) | | $opt->{tid} = $status = $rdb->set_slice(undef, \%redeem) |
| or $die->("Auth redemption of %s failed: %s", $code, $rdb
->errstr()); | | or $die->("Auth redemption of %s failed: %s", $code, $rdb
->errstr()); |
|
| #::logDebug("Redemption auth tid=$status"); | | #$log->("Redemption auth tid=$status"); |
| my $new_amount = $cdb->set_field( | | my $new_amount = $cdb->set_field( |
| $code, | | $code, |
| 'amount', | | 'amount', |
| $record->{amount}
- $opt->{amount}, | | $record->{amount}
- $opt->{amount}, |
| ); | | ); |
|
| #::logDebug("Redemption amount=$record->{amount} redeeming=$opt->{amount} new_am
ount=$new_amount"); | | #$log->("Redemption amount=$record->{amount} redeeming=$opt->{amount} new_amount
=$new_amount"); |
| | |
| defined $new_amount | | defined $new_amount |
| or $die->("Auth redemption of %s failed: %s", $code, $rdb
->errstr()); | | or $die->("Auth redemption of %s failed: %s", $code, $rdb
->errstr()); |
| | |
| } | | } |
| elsif($opt->{capture}) { | | elsif($opt->{capture}) { |
| $opt->{tid} or return $die->("Must have transaction ID to cap
ture."); | | $opt->{tid} or return $die->("Must have transaction ID to cap
ture."); |
| my $red_record = $rdb->row_hash($opt->{tid}) | | my $red_record = $rdb->row_hash($opt->{tid}) |
| or return $die->("Unknown transaction ID %s.", $opt->{tid
}); | | or return $die->("Unknown transaction ID %s.", $opt->{tid
}); |
| if($red_record->{voided}) { | | if($red_record->{voided}) { |
| | |
| skipping to change at line 261 | | skipping to change at line 252 |
|---|
| ip_addr => $CGI::remote_addr, | | ip_addr => $CGI::remote_addr, |
| trans_type => 'capture', | | trans_type => 'capture', |
| voided => 0, | | voided => 0, |
| captured => 0, | | captured => 0, |
| username => $Vend::username, | | username => $Vend::username, |
| amount => $red_record->{amount}, | | amount => $red_record->{amount}, |
| ); | | ); |
| | |
| $opt->{new_tid} = $status = $rdb->set_slice(undef, \%redeem) | | $opt->{new_tid} = $status = $rdb->set_slice(undef, \%redeem) |
| or $die->("Auth redemption of %s failed: %s", $code, $rdb
->errstr()); | | or $die->("Auth redemption of %s failed: %s", $code, $rdb
->errstr()); |
|
| #::logDebug("Redemption auth tid=$status"); | | #$log->("Redemption auth tid=$status"); |
| | |
| $rdb->set_field($opt->{tid}, 'captured', 1); | | $rdb->set_field($opt->{tid}, 'captured', 1); |
|
| #::logDebug("Capture amount=$red_record->{amount}"); | | #$log->("Capture amount=$red_record->{amount}"); |
| | |
| } | | } |
| elsif($opt->{void}) { | | elsif($opt->{void}) { |
| $opt->{tid} or return $die->("Must have transaction ID to voi
d."); | | $opt->{tid} or return $die->("Must have transaction ID to voi
d."); |
| | |
| my $red_record = $rdb->row_hash($opt->{tid}) | | my $red_record = $rdb->row_hash($opt->{tid}) |
| or return $die->("Unknown transaction ID %s.", $opt->{tid
}); | | or return $die->("Unknown transaction ID %s.", $opt->{tid
}); |
| | |
| if($red_record->{voided}) { | | if($red_record->{voided}) { |
| return $die->("Cannot void already voided auth %s.", $opt
->{tid}); | | return $die->("Cannot void already voided auth %s.", $opt
->{tid}); |
| | |
| skipping to change at line 314 | | skipping to change at line 305 |
|---|
| ip_addr => $CGI::remote_addr, | | ip_addr => $CGI::remote_addr, |
| trans_type => 'void', | | trans_type => 'void', |
| voided => 0, | | voided => 0, |
| captured => 1, | | captured => 1, |
| username => $Vend::username, | | username => $Vend::username, |
| amount => $red_record->{amount}, | | amount => $red_record->{amount}, |
| ); | | ); |
| | |
| $opt->{new_tid} = $status = $rdb->set_slice(undef, \%redeem) | | $opt->{new_tid} = $status = $rdb->set_slice(undef, \%redeem) |
| or $die->("Auth redemption of %s failed: %s", $code, $rdb
->errstr()); | | or $die->("Auth redemption of %s failed: %s", $code, $rdb
->errstr()); |
|
| #::logDebug("Redemption auth tid=$status"); | | #$log->("Redemption auth tid=$status"); |
| | |
| $rdb->set_field($opt->{tid}, 'voided', 1); | | $rdb->set_field($opt->{tid}, 'voided', 1); |
|
| #::logDebug("Capture amount=$red_record->{amount}"); | | #$log->("Capture amount=$red_record->{amount}"); |
| | |
| my $new_amount = $cdb->set_field($code, 'amount', $record->{amoun
t} + $red_record->{amount}); | | my $new_amount = $cdb->set_field($code, 'amount', $record->{amoun
t} + $red_record->{amount}); |
|
| #::logDebug("void amount=$red_record->{amount} new_amount=$new_amount"); | | #$log->("void amount=$red_record->{amount} new_amount=$new_amount"); |
| | |
| } | | } |
| elsif ($opt->{return}) { | | elsif ($opt->{return}) { |
| $code or return $die->("Must have payment certificate number for
a return."); | | $code or return $die->("Must have payment certificate number for
a return."); |
| eval { | | eval { |
| $sth_lock->execute($code, $$, $CGI::remote_addr) | | $sth_lock->execute($code, $$, $CGI::remote_addr) |
| and $locked = 1; | | and $locked = 1; |
| }; | | }; |
| | |
| not $locked and return $die->("Cannot lock payment cert %s", $cod
e); | | not $locked and return $die->("Cannot lock payment cert %s", $cod
e); |
| | |
| skipping to change at line 354 | | skipping to change at line 345 |
|---|
| trans_type => 'return', | | trans_type => 'return', |
| voided => 0, | | voided => 0, |
| captured => 1, | | captured => 1, |
| username => $Vend::username, | | username => $Vend::username, |
| amount => $opt->{amount}, | | amount => $opt->{amount}, |
| items => $opt->{items}, | | items => $opt->{items}, |
| ); | | ); |
| | |
| $opt->{tid} = $status = $rdb->set_slice(undef, \%redeem) | | $opt->{tid} = $status = $rdb->set_slice(undef, \%redeem) |
| or $die->("Auth redemption of %s failed: %s", $code, $rdb
->errstr()); | | or $die->("Auth redemption of %s failed: %s", $code, $rdb
->errstr()); |
|
| #::logDebug("Redemption auth tid=$status"); | | #$log->("Redemption auth tid=$status"); |
| my $new_amount = $cdb->set_field( | | my $new_amount = $cdb->set_field( |
| $code, | | $code, |
| 'amount', | | 'amount', |
| $record->{amount}
+ $opt->{amount}, | | $record->{amount}
+ $opt->{amount}, |
| ); | | ); |
|
| #::logDebug("return amount=$record->{amount} redeeming=$opt->{amount} new_amount
=$new_amount"); | | #$log->("return amount=$record->{amount} redeeming=$opt->{amount} new_amount=$ne
w_amount"); |
| | |
| defined $new_amount | | defined $new_amount |
| or $die->("Return of %s failed: %s", $code, $rdb->errstr(
)); | | or $die->("Return of %s failed: %s", $code, $rdb->errstr(
)); |
| } | | } |
| | |
| if($locked) { | | if($locked) { |
| my $rc = $sth_unlock->execute($code) and $locked = 0; | | my $rc = $sth_unlock->execute($code) and $locked = 0; |
|
| #::logDebug("unlock rc=$rc"); | | #$log->("unlock rc=$rc"); |
| if($locked) { | | if($locked) { |
| undef $locked; | | undef $locked; |
| return $die->("Gift certificate %s lock was not released.
", $code); | | return $die->("Gift certificate %s lock was not released.
", $code); |
| } | | } |
| } | | } |
| else { | | else { |
|
| #::logDebug("Not locked??!!?? THis should not happen."); | | #$log->("Not locked??!!?? THis should not happen."); |
| } | | } |
| return $status; | | return $status; |
| } | | } |
| EOR | | EOR |
| | | |
| End of changes. 31 change blocks. |
|---|
| 50 lines changed or deleted | | 41 lines changed or added |
|---|
"Fossies" - the Fresh Open Source Software Archive 