dist/standard/config/pay_cert.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.tag,v 1.4 2009-05-01 13:50:00 pajamian Exp $
   9
  10 UserTag pay-cert Order code
  11 UserTag pay-cert addAttr
  12 UserTag pay-cert Routine <<EOR
  13 sub {
  14         my ($code, $opt) = @_;
  15
  16         use vars qw/$Tag/;
  17         my $counter_file = $::Variable->{GIFT_CERT_COUNTER} || 'etc/pay_cert.number';
  18         my $cert_table   = $::Variable->{GIFT_CERT_TABLE}                || 'pay_certs';
  19         my $redeem_table = $::Variable->{GIFT_CERT_REDEEM_TABLE} || 'pay_cert_redeem';
  20         my $lock_table   = $::Variable->{GIFT_CERT_LOCK_TABLE}   || 'pay_cert_lock';
  21
  22         my $ldb = dbref($lock_table)
  23                 or die errmsg("cannot open payment certs lock table '%s'", $lock_table);
  24
  25         my $ltab = $ldb->name();
  26         my $ldbh = $ldb->dbh()
  27                 or die errmsg("cannot get handle for certs lock table '%s'", $lock_table);
  28         my $q = "insert into $ltab (code, pid, ip_addr) values (?,?,?)";
  29
  30         my $locked;
  31
  32         my $sth_lock = $ldbh->prepare($q)
  33                 or die errmsg("cannot prepare lock query '%s'", $q);
  34
  35         $q = "delete from $ltab where code = ?";
  36         my $sth_unlock = $ldbh->prepare($q)
  37                 or die errmsg("cannot prepare lock query '%s'", $q);
  38
  39         $opt->{code_scratch} = 'pay_cert_code'          unless defined $opt->{code_scratch};
  40         $opt->{check_scratch} = 'pay_cert_check'        unless defined $opt->{check_scratch};
  41         $opt->{order_number} ||= $::Values->{mv_order_number};
  42
  43         if($opt->{transaction}) {
  44                 $opt->{$opt->{transaction}} = 1;
  45         }
  46
  47         my $errname;
  48
  49         my $die = sub {
  50                 my $msg = errmsg(@_);
  51                 ::logError($msg);
  52                 $errname ||= 'pay_certificate';
  53                 eval {
  54                         $sth_unlock->execute($code) if $locked;
  55                 };
  56                 $Tag->error( { name => $errname, set => $msg } );
  57                 return undef;
  58         };
  59
  60         if($opt->{issue}) {
  61                 if(! $opt->{order_number}) {
  62                         return $die->("Must have order number to issue payment certificate. Not issued.");
  63                 }
  64                 if(! $opt->{amount}) {
  65                         return $die->("Must specify amount to issue payment certificate. Not issued.");
  66                 }
  67
  68                 ## Time to issue a certificate
  69                 my $start = int(rand 300000);
  70                 $start .= '0' while length($start) < 6;
  71                 my $base = $Tag->counter({ file => $counter_file, start => $start });
  72                 $base .= int(rand(10));
  73                 for(0 .. 9) {
  74                         $code = $base . $_;
  75                         last if Vend::Order::luhn($code, 8);
  76                 }
  77
  78                 my $now = time;
  79                 my @date_issued = localtime($now);
  80                 my @date_expires;
  81                 my $issue_date = POSIX::strftime('%Y%m%d%H%M%S', @date_issued);
  82                 my $expire_date = '';
  83                 $opt->{expires} ||= $opt->{expire} || $opt->{expiration};
  84                 if($opt->{expires} =~ /^\s*(\d+)\s*y/i) {
  85                         @date_expires = @date_issued;
  86                         $date_expires[5] += $1;
  87                 }
  88                 elsif($opt->{expires} =~ /^\s*(\d+)\s*mon/i) {
  89                         @date_expires = @date_issued;
  90                         $date_expires[4] += $1;
  91                 }
  92                 elsif($opt->{expires} =~ /^\s*(\d+)\s*[mhdwy]/) {
  93                         @date_expires = localtime(adjust_time($opt->{expires}, $now));
  94                 }
  95                 elsif($opt->{expires}) {
  96                         ::logError("Expiration date '%s' not understood, ignoring.", $opt->{expires});
  97                 }
  98
  99                 if(@date_expires) {
 100                         $expire_date = POSIX::strftime('%Y%m%d%H%M%S', @date_expires);
 101                 }
 102
 103 #::logDebug("generated code=$code, expires=$opt->{expires} date_expires=$expire_date ");
 104                 my $check = int rand(10);
 105                 $check .= int(rand(10)) while length($check) < 4;
 106 #::logDebug("generated check=$check");
 107                 my %record = (
 108                         amount => $opt->{amount},
 109                         ip_addr => $CGI::remote_addr,
 110                         order_number => $opt->{order_number},
 111                         date_issued => $issue_date,
 112                         date_expires => $expire_date,
 113                         check_value => $check,
 114                         orig_amount => $opt->{amount},
 115                         process_flag => 0,
 116                 );
 117                 my $db = dbref($cert_table)
 118                         or die errmsg("cannot open pay_cert table '%s'", $cert_table);
 119                 $db->set_slice($code, \%record)
 120                         or die errmsg("cannot write cert number $code in pay_cert table '%s'", $cert_table);
 121
 122                 ## Create expire date for cookie
 123                 my $edate;
 124                 $edate = POSIX::strftime("%a, %d-%b-%Y %H:%M:%S GMT ", @date_expires)
 125                         unless ! $expire_date or $opt->{no_cookie};
 126
 127                 if($opt->{code_scratch}) {
 128                         $::Scratch->{$opt->{code_scratch}} = $code;
 129                         unless( ! $edate or $opt->{no_cookie}) {
 130 #::logDebug("setting cookie");
 131                                 my $prior_cookie = $Tag->read_cookie({name => 'MV_GIFT_CERT_CODE'});
 132                                 my $cvalue = $code;
 133                                 if($prior_cookie) {
 134                                         $cvalue = join ",", $prior_cookie, $cvalue;
 135                                 }
 136                                 $Tag->set_cookie({
 137                                                                 name => 'MV_GIFT_CERT_CODE',
 138                                                                 expire => $edate,
 139                                                                 value => $cvalue,
 140                                                         });
 141                         }
 142                 }
 143
 144                 if($opt->{check_scratch}) {
 145                         $::Scratch->{$opt->{check_scratch}} = $check;
 146                         my $prior_cookie = $Tag->read_cookie({name => 'MV_GIFT_CERT_CHECK'});
 147                         my $cvalue = $check;
 148                         if($prior_cookie) {
 149                                 $cvalue = join ",", $prior_cookie, $cvalue;
 150                         }
 151                         unless( ! $edate or $opt->{no_cookie}) {
 152 #::logDebug("setting cookie");
 153                                 $Tag->set_cookie({
 154                                                                         name => 'MV_GIFT_CERT_CHECK',
 155                                                                         expire => $edate,
 156                                                                         value => $cvalue,
 157                                                         });
 158                         }
 159                 }
 160
 161                 if(defined $opt->{item_pointer}) {
 162                         my $ptr =  $opt->{item_pointer};
 163                         my $cart        = $opt->{cart}
 164                                                 ? ($Vend::Session->{carts}{$opt->{cart}})
 165                                                 : $Vend::Items;
 166                         my $item = $cart->[$ptr];
 167                         $item->{pay_cert_code} = $code;
 168                         $item->{pay_cert_check} = $check;
 169                 }
 170                 return $code;
 171         }
 172
 173         my $cdb = dbref($cert_table)
 174                 or die errmsg("cannot open pay_certs table '%s'", $cert_table);
 175
 176         my $status;
 177
 178         my $record;
 179
 180         my $rdb = dbref($redeem_table)
 181                 or return $die->("Cannot open redemption table %s", $redeem_table);
 182         my $rname = $rdb->name();
 183         my $rdbh  = $rdb->dbh()
 184                 or return $die->("Cannot get redemption table %s DBI handle", $redeem_table);
 185
 186         if($opt->{auth}) {
 187                 eval {
 188                         $sth_lock->execute($code, $$, $CGI::remote_addr)
 189                                 and $locked = 1;
 190                 };
 191
 192                 not $locked and return $die->("Cannot lock pay cert %s", $code);
 193
 194                 $code or return $die->("Must have payment certificate number.");
 195                 $record = $cdb->row_hash($code)
 196                         or return $die->("Gift certificate %s does not exist.", $code);
 197                 if($opt->{amount} > $record->{amount}) {
 198                         return $die->("Tried to redeem, limit (%s) exceeded.", $record->{amount} );
 199                 }
 200                 my %redeem = (
 201                         pay_id => $code,
 202                         trans_date => POSIX::strftime('%Y%m%d%H%M%S', localtime()),
 203                         ip_addr => $CGI::remote_addr,
 204                         trans_type => 'auth',
 205                         voided => 0,
 206                         captured => 0,
 207                         username => $Vend::username,
 208                         amount => $opt->{amount},
 209                         items => $opt->{items},
 210                         );
 211
 212                 $opt->{tid} = $status = $rdb->set_slice(undef, \%redeem)
 213                         or $die->("Auth redemption of %s failed: %s", $code, $rdb->errstr());
 214 #::logDebug("Redemption auth tid=$status");
 215                 my $new_amount = $cdb->set_field(
 216                                                                 $code,
 217                                                                 'amount',
 218                                                                 $record->{amount} - $opt->{amount},
 219                                                         );
 220 #::logDebug("Redemption amount=$record->{amount} redeeming=$opt->{amount} new_amount=$new_amount");
 221
 222                 defined $new_amount
 223                         or $die->("Auth redemption of %s failed: %s", $code, $rdb->errstr());
 224
 225         }
 226         elsif($opt->{capture}) {
 227                 $opt->{tid}     or return $die->("Must have transaction ID to capture.");
 228                 my $red_record = $rdb->row_hash($opt->{tid})
 229                         or return $die->("Unknown transaction ID %s.", $opt->{tid});
 230                 if($red_record->{voided}) {
 231                         return $die->("Cannot capture voided auth %s.", $opt->{tid});
 232                 }
 233
 234                 if($red_record->{captured}) {
 235                         return $die->("Auth %s already captured.", $opt->{tid});
 236                 }
 237
 238                 $code = $red_record->{pay_id};
 239
 240                 eval {
 241                         $sth_lock->execute($code, $$, $CGI::remote_addr)
 242                                 and $locked = 1;
 243                 };
 244
 245                 not $locked and return $die->("Cannot lock payment cert %s", $code);
 246
 247                 my %redeem = (
 248                         pay_id => $code,
 249                         trans_date => POSIX::strftime('%Y%m%d%H%M%S', localtime()),
 250                         link_tid => $opt->{tid},
 251                         ip_addr => $CGI::remote_addr,
 252                         trans_type => 'capture',
 253                         voided => 0,
 254                         captured => 0,
 255                         username => $Vend::username,
 256                         amount => $red_record->{amount},
 257                         );
 258
 259                 $opt->{new_tid} = $status = $rdb->set_slice(undef, \%redeem)
 260                         or $die->("Auth redemption of %s failed: %s", $code, $rdb->errstr());
 261 #::logDebug("Redemption auth tid=$status");
 262
 263                 $rdb->set_field($opt->{tid}, 'captured', 1);
 264 #::logDebug("Capture amount=$red_record->{amount}");
 265
 266         }
 267         elsif($opt->{void}) {
 268                 $opt->{tid}     or return $die->("Must have transaction ID to void.");
 269
 270                 my $red_record = $rdb->row_hash($opt->{tid})
 271                         or return $die->("Unknown transaction ID %s.", $opt->{tid});
 272
 273                 if($red_record->{voided}) {
 274                         return $die->("Cannot void already voided auth %s.", $opt->{tid});
 275                 }
 276
 277                 if($red_record->{captured}) {
 278                         return $die->("Cannot void captured auth %s.", $opt->{tid});
 279                 }
 280
 281                 $code = $red_record->{pay_id};
 282
 283                 $record = $cdb->row_hash($code)
 284                         or return $die->("Gift certificate %s does not exist.", $code);
 285
 286                 eval {
 287                         $sth_lock->execute($code, $$, $CGI::remote_addr)
 288                                 and $locked = 1;
 289                 };
 290
 291                 not $locked and return $die->("Cannot lock payment cert %s", $code);
 292
 293                 if( ($red_record->{amount} + $record->{amount}) > $record->{orig_amount}) {
 294                         return $die->(
 295                                                 "Cannot void to equal more than original_amount %s.",
 296                                                 $record->{orig_amount},
 297                                         );
 298                 }
 299
 300                 my %redeem = (
 301                         pay_id => $code,
 302                         trans_date => POSIX::strftime('%Y%m%d%H%M%S', localtime()),
 303                         link_tid => $opt->{tid},
 304                         ip_addr => $CGI::remote_addr,
 305                         trans_type => 'void',
 306                         voided => 0,
 307                         captured => 1,
 308                         username => $Vend::username,
 309                         amount => $red_record->{amount},
 310                         );
 311
 312                 $opt->{new_tid} = $status = $rdb->set_slice(undef, \%redeem)
 313                         or $die->("Auth redemption of %s failed: %s", $code, $rdb->errstr());
 314 #::logDebug("Redemption auth tid=$status");
 315
 316                 $rdb->set_field($opt->{tid}, 'voided', 1);
 317 #::logDebug("Capture amount=$red_record->{amount}");
 318
 319                 my $new_amount = $cdb->set_field($code, 'amount', $record->{amount} + $red_record->{amount});
 320 #::logDebug("void amount=$red_record->{amount} new_amount=$new_amount");
 321
 322         }
 323         elsif ($opt->{return}) {
 324                 $code or return $die->("Must have payment certificate number for a return.");
 325                 eval {
 326                         $sth_lock->execute($code, $$, $CGI::remote_addr)
 327                                 and $locked = 1;
 328                 };
 329
 330                 not $locked and return $die->("Cannot lock payment cert %s", $code);
 331
 332                 $record = $cdb->row_hash($code)
 333                         or return $die->("Gift certificate %s does not exist.", $code);
 334                 if( ($opt->{amount} + $record->{amount}) > $record->{orig_amount}) {
 335                         return $die->(
 336                                                 "Cannot return more than original_amount %s.",
 337                                                 $record->{orig_amount},
 338                                         );
 339                 }
 340                 my %redeem = (
 341                         pay_id => $code,
 342                         trans_date => POSIX::strftime('%Y%m%d%H%M%S', localtime()),
 343                         ip_addr => $CGI::remote_addr,
 344                         trans_type => 'return',
 345                         voided => 0,
 346                         captured => 1,
 347                         username => $Vend::username,
 348                         amount => $opt->{amount},
 349                         items => $opt->{items},
 350                         );
 351
 352                 $opt->{tid} = $status = $rdb->set_slice(undef, \%redeem)
 353                         or $die->("Auth redemption of %s failed: %s", $code, $rdb->errstr());
 354 #::logDebug("Redemption auth tid=$status");
 355                 my $new_amount = $cdb->set_field(
 356                                                                 $code,
 357                                                                 'amount',
 358                                                                 $record->{amount} + $opt->{amount},
 359                                                         );
 360 #::logDebug("return amount=$record->{amount} redeeming=$opt->{amount} new_amount=$new_amount");
 361
 362                 defined $new_amount
 363                         or $die->("Return of %s failed: %s", $code, $rdb->errstr());
 364         }
 365
 366         if($locked) {
 367                 my $rc = $sth_unlock->execute($code) and $locked = 0;
 368 #::logDebug("unlock rc=$rc");
 369                 if($locked) {
 370                         undef $locked;
 371                         return $die->("Gift certificate %s lock was not released.", $code);
 372                 }
 373         }
 374         else {
 375 #::logDebug("Not locked??!!?? THis should not happen.");
 376         }
 377         return $status;
 378 }
 379 EOR