dist/standard/config/pay_cert_redeem.tag

   1 # Copyright 2004-2007 Interchange Development Group and others
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or
   6 # (at your option) any later version.  See the LICENSE file for details.
   7 #
   8 # $Id: pay_cert_redeem.tag,v 1.4 2007-08-09 13:40:53 pajamian Exp $
   9
  10 UserTag pay-cert-redeem Order certs
  11 UserTag pay-cert-redeem addAttr
  12 UserTag pay-cert-redeem Routine <<EOR
  13 sub {
  14         my ($certs, $opt) = @_;
  15
  16         my $ctab = $opt->{table} || 'pay_certs';
  17         my $cdb = dbref($ctab)
  18                                 or die errmsg("No payment cert table '%s'", $ctab);
  19
  20         use vars qw/$Tag/;
  21         $opt->{set_scratch} = 'amount_remaining' unless defined $opt->{set_scratch};
  22
  23         my $svar = $opt->{set_scratch};
  24
  25         my @tid;
  26
  27         if($opt->{capture}) {
  28                 $certs ||= $::Scratch->{pay_certs_to_capture};
  29                 return unless $certs;
  30                 my @certs = split /[\s,\0]+/, $certs;
  31
  32                 foreach my $code (@certs) {
  33                         my $success = $Tag->pay_cert({ capture => 1, tid => $code });
  34                         if($success) {
  35                                 push @tid, $code;
  36                         }
  37                         else {
  38                                 for(@tid) {
  39                                         my $o = {
  40                                                 void => 1,
  41                                                 code => $_,
  42                                         };
  43                                         $Tag->pay_cert( $o );
  44                                         ::logError(
  45                                                 "Voided capture tid %s due to capture error on %s",
  46                                                 $_,
  47                                                 $code,
  48                                         );
  49                                 }
  50                         }
  51                 }
  52         }
  53         else {
  54                 my $total_cost = round_to_frac_digits($Tag->total_cost( { noformat => 1 }));
  55                 my $remaining = $total_cost;
  56
  57                 $certs ||= $::Values->{use_pay_cert} || $::Scratch->{pay_cert_code};
  58                 return $remaining unless $certs;
  59                 my @certs = split /[\s,\0]+/, $certs;
  60
  61                 foreach my $code (@certs) {
  62                         last if $remaining <= 0;
  63                         my $this = $cdb->field($code, 'amount');
  64                         my $amount;
  65                         if($this < $remaining) {
  66                                 $remaining -= $this;
  67                                 $amount = $this;
  68                         }
  69                         else {
  70                                 $amount = $remaining;
  71                                 $remaining = 0;
  72                         }
  73                         my $o = {
  74                                 auth => 1,
  75                                 amount => $amount,
  76                                 code => $code,
  77                         };
  78                         my $tid = $Tag->pay_cert($o);
  79                         if($tid) {
  80                                 push @tid, $tid;
  81 #::logDebug("authorized pay_cert=$code amount=$amount tid=$tid");
  82                         }
  83                         else {
  84 #::logDebug("failed to auth pay_cert=$code amount=$amount tid=$tid");
  85                                 for(@tid) {
  86                                         my $o = {
  87                                                 void => 1,
  88                                                 code => $_,
  89                                         };
  90                                         $Tag->pay_cert( $o );
  91                                         my $msg = errmsg(
  92                                                 "Voided authorization tid %s due to auth error on %s",
  93                                                 $_,
  94                                                 $code,
  95                                         );
  96                                         ::logError($msg);
  97                                 }
  98                                 die errmsg("failed to authorize pay_cert %s", $code)
  99                                         if $opt->{die};
 100                                 return $total_cost;
 101                         }
 102                 }
 103
 104                 $::Scratch->{pay_certs_to_capture} = join ",", @tid;
 105                 if($opt->{set_scratch}) {
 106                         $::Scratch->{$svar} = $remaining;
 107                 }
 108                 return $opt->{success} if $opt->{success};
 109                 return $remaining;
 110         }
 111
 112 }
 113 EOR