# Copyright 2002-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: charge.coretag,v 1.5 2007-03-30 23:40:49 pajamian Exp $

UserTag charge              Order        route
UserTag charge              addAttr
UserTag charge              PosNumber    1
UserTag charge              Version      $Revision: 1.5 $
UserTag charge              MapRoutine   Vend::Payment::charge

sub charge {
my ($charge_type, $opt) = @_;

my $pay_route;

### We get the payment base information from a route with the
### same name as $charge_type if it is there
if($Vend::Cfg->{Route}) {
  $pay_route = $Vend::Cfg->{Route_repository}{$charge_type} || {};
}
else {
  $pay_route = {};
}

### Then we take any payment options set in &charge, [charge ...],
### or $Tag->charge

# $pay_opt is package-scoped but lexical
$pay_opt = { %$pay_route };
for(keys %$opt) {
  $pay_opt->{$_} = $opt->{$_};
}

# We relocate these to subroutines to standardize

### Maps the form variable names to the names needed by the routine
### Standard names are defined ala Interchange or MV4.0x, b_name, lname,
### etc. with b_varname taking precedence for these. Falls back to lname
### if the b_lname is not set
my (%actual) = map_actual();
$pay_opt->{actual} = \%actual;

# We relocate this to a subroutine to standardize. Uses the payment
# counter if there
my $orderID = gen_order_id($pay_opt);

### Set up the amounts. The {amount} key will have the currency prepended,
### e.g. "usd 19.95". {total_cost} has just the cost.

# Uses the {currency} -> MV_PAYMENT_CURRENCY options if set
my $currency =  charge_param('currency')
        || ($Vend::Cfg->{Locale} && $Vend::Cfg->{Locale}{currency_code})
        || 'usd';

# Uses the {precision} -> MV_PAYMENT_PRECISION options if set
my $precision = charge_param('precision') || 2;
my $penny     = charge_param('penny_pricing') || 0;

my $amount = $pay_opt->{amount} || Vend::Interpolate::total_cost();
$amount = round_to_frac_digits($amount, $precision);
$amount = sprintf "%.${precision}f", $amount;
$amount *= 100 if $penny;

$pay_opt->{total_cost} = $amount;
$pay_opt->{amount} = "$currency $amount";

### 
### Finish setting amounts and currency

# If we have a previous payment amount, delete it but push it on a stack
# 
my $stack = $Vend::Session->{payment_stack} || [];
delete $Vend::Session->{payment_result}; 
delete $Vend::Session->{cybercash_result}; ### Deprecated

#::logDebug("Called charge at " . scalar(localtime));
#::logDebug("Charge caller is " . join(':', caller));

#::logDebug("mode=$pay_opt->{gateway}");
#::logDebug("pay_opt=" . ::uneval($pay_opt));
# Default to the gateway same as charge type if no gateway specified,
# and set the gateway in the session for logging on completion
if(! $opt->{gateway}) {
  $pay_opt->{gateway} = charge_param('gateway') || $charge_type;
}
#$charge_type ||= $pay_opt->{gateway};
$Vend::Session->{payment_mode} = $pay_opt->{gateway};

# See if we are in test mode
$pay_opt->{test} = charge_param('test');

# just convenience
my $gw = $pay_opt->{gateway};

# See if we are calling a defined GlobalSub payment mode
my $sub = $Global::GlobalSub->{$gw};

# Try our predefined modes
if (! $sub and defined &{"Vend::Payment::$gw"} ) {
  $sub = \&{"Vend::Payment::$gw"};
}

# This is the return from all routines
my %result;

if($sub) {
#::logDebug("Charge sub");
  # Calling a defined GlobalSub payment mode
  # Arguments are the passed option hash (if any) and the route hash

      my $pid;
      my $timeout = $pay_opt->{global_timeout} || charge_param('global_timeout');

      %result = eval {
          if ($timeout > 0) {

              my $pipe = IO::Pipe->new;

              unless ($pid = fork) {
                  Vend::Server::child_process_dbi_prep();
                  $pipe->writer;
                  my %rv = $sub->($pay_opt);
                  $pipe->print( ::uneval(\%rv) );
                  exit;
              }

              $pipe->reader;

              my $to_msg = $pay_opt->{global_timeout_msg}
                  || charge_param('global_timeout_msg')
                  || 'Due to technical difficulties, your order could not be processed.';
              local $SIG{ALRM} = sub { die "$to_msg\n" };

              alarm $timeout;
              wait;
              alarm 0;

              $pid = undef;

              my $rv = eval join ('', $pipe->getlines);

              return %$rv;
          }

          return $sub->($pay_opt);
      };

  if($@) {
    my $msg = errmsg(
          "payment routine '%s' returned error: %s",
          $charge_type,
          $@,
    );
          kill (KILL => $pid)
              if $pid && kill (0 => $pid);
    ::logError($msg);
    $result{MStatus} = 'died';
    $result{MErrMsg} = $msg;
  }
}
elsif($charge_type =~ /^\s*custom\s+(\w+)(?:\s+(.*))?/si) {
#::logDebug("Charge custom");
  # MV4 and IC4.6.x methods
  my (@args);
  @args = Text::ParseWords::shellwords($2) if $2;
  if(! defined ($sub = $Global::GlobalSub->{$1}) ) {
    ::logError("bad custom payment GlobalSub: %s", $1);
    return undef;
  }
  eval {
    %result = $sub->(@args);
  };
  if($@) {
    my $msg = errmsg(
          "payment routine '%s' returned error: %s",
          $charge_type,
          $@,
    );
    ::logError($msg);
    $result{MStatus} = $msg;
  }
}
elsif (
    $actual{cyber_mode} =~ /^minivend_test(?:_(.*))?/
      or 
    $charge_type =~ /^internal_test(?:[ _]+(.*))?/
    )
{
#::logDebug("Internal test");

  # Test mode....

  my $status = $1 || charge_param('result') || undef;
  # Interchange test mode
  my %payment = ( %$pay_opt );
  &testSetServer ( %payment );
  %result = testsendmserver(
    $actual{cyber_mode},
    'Order-ID'     => $orderID,
    'Amount'       => $amount,
    'Card-Number'  => $actual{mv_credit_card_number},
    'Card-Name'    => $actual{b_name},
    'Card-Address' => $actual{b_address},
    'Card-City'    => $actual{b_city},
    'Card-State'   => $actual{b_state},
    'Card-Zip'     => $actual{b_zip},
    'Card-Country' => $actual{b_country},
    'Card-Exp'     => $actual{mv_credit_card_exp_all}, 
  );
  $result{MStatus} = $status if defined $status;
}
else {
#::logDebug("Unknown charge type");
  my $msg = errmsg("Unknown charge type: %s", $charge_type);
  ::logError($msg);
  $result{MStatus} = $msg;
}

push @$stack, \%result;
$Vend::Session->{payment_result} = \%result;
$Vend::Session->{payment_stack}  = $stack;

my $svar = charge_param('success_variable') || 'MStatus';
my $evar = charge_param('error_variable')   || 'MErrMsg';

if($result{$svar} !~ /^success/) {
  $Vend::Session->{payment_error} = $result{$evar};
  if ($result{$evar} =~ /\S/) {
    $Vend::Session->{errors}{mv_credit_card_valid} = $result{$evar};
  }
  $result{'invalid-order-id'} = delete $result{'order-id'}
    if $result{'order-id'};
}
elsif($result{$svar} =~ /success-duplicate/) {
  $Vend::Session->{payment_error} = $result{$evar};
  $result{'invalid-order-id'} = delete $result{'order-id'}
    if $result{'order-id'};
}
else {
  delete $Vend::Session->{payment_error};
}

$Vend::Session->{payment_id} = $result{'order-id'};

my $encrypt = charge_param('encrypt');

if($encrypt and $CGI::values{mv_credit_card_number} and $Vend::Cfg->{EncryptKey}) {
  my $prog = charge_param('encrypt_program') || $Vend::Cfg->{EncryptProgram};
  if($prog =~ /pgp|gpg/) {
    $CGI::values{mv_credit_card_force} = 1;
    (
      undef,
      $::Values->{mv_credit_card_info},
      $::Values->{mv_credit_card_exp_month},
      $::Values->{mv_credit_card_exp_year},
      $::Values->{mv_credit_card_exp_all},
      $::Values->{mv_credit_card_type},
      $::Values->{mv_credit_card_error}
    )  = encrypt_standard_cc(\%CGI::values);
  }
}
::logError(
      "Order id for charge type %s: %s",
      $charge_type,
      $Vend::Session->{cybercash_id},
    )
  if $pay_opt->{log_to_error};

# deprecated
for(qw/ id error result /) {
  $Vend::Session->{"cybercash_$_"} = $Vend::Session->{"payment_$_"};
}

return \%result if $pay_opt->{hash};
return $result{'order-id'};
}