Interchange Reference Pages: Global and catalog variables

my ($name, $opt) = @_;
my $joiner = $opt->{joiner} || ' ';
return "Cannot dump or find sessions with session type $Vend::Cfg->{SessionType}."
  if ($Vend::Cfg->{SessionType} ne 'File' && $Vend::Cfg->{SessionType} ne 'DBI');


if ($Vend::Cfg->{SessionType} eq 'File') {
  if($opt->{find}) {
    require File::Find;
    my $expire = $Vend::Cfg->{SessionExpire};
    if( int($::Variable->{ACTIVE_SESSION_MINUTES}) ) {
      $expire = $::Variable->{ACTIVE_SESSION_MINUTES} * 60;
    }
    my $now = time();
    $expire = $now - $expire;

      $out = Vend::Util::uneval($ref);
    };
    return uneval($ref) if $@;
    return $out;
  }
}

if ($Vend::Cfg->{SessionType} eq 'DBI') {
  if($opt->{find}) {
    my $expire = $Vend::Cfg->{SessionExpire};
    if( int($::Variable->{ACTIVE_SESSION_MINUTES}) ) {
      $expire = $::Variable->{ACTIVE_SESSION_MINUTES} * 60;
    }
    my $now = time();
    $expire = $now - $expire;

# (at your option) any later version.  See the LICENSE file for details.

UserTag backup-database Order    tables
UserTag backup-database AddAttr
UserTag backup-database Version  1.11
UserTag backup-database Routine  <<EOR
sub {
my ($tables, $opt) = @_;
my (@tables) = grep /\S/, split /['\s\0]+/, $tables;
my $backup_dir =  $opt->{dir}
          || $::Variable->{BACKUP_DIRECTORY}
          || "$Vend::Cfg->{VendRoot}/backup";
my $gnum   = $opt->{gnumeric};
my $agg = "$backup_dir/DBDOWNLOAD.all";

my $ordersdir   = charge_param('ordersdir') || 'orders';
my $currency    = $::Values->{currency} || charge_param('currency') || 'GBP';  
my $editbasketurl = charge_param('edit_basket_url') || $::Variable->{EDIT_BASKET_URL};
$editbasketurl =~ s/\.html$//i;
$editbasketurl .= ".html?id=$::Session->{id}";
my $continueshoppingurl = charge_param('continue_shopping_url') || $::Variable->{CONTINUE_SHOPPING_URL};
my $receipturl  = charge_param('receipt_url') || $::Variable->{RECEIPT_URL};
my $gcoipn_url  = charge_param('gcoipn_url') || $::Variable->{GCOIPN_URL};
my $gcocmd_url  = charge_param('gcocmd_url') || $::Variable->{GCOCMD_URL}; \
 \
 \
 \
 \
 # from IC admin panel, not from GCO
my $chargecard  = $::Values->{charge_card} || charge_param('charge_card') || '1';
my $basket_expiry = charge_param('basket_expiry') || $::Variable->{BASKET_EXPIRY} || '1 month';
my $default_taxrate = $::Values->{default_taxrate} || charge_param('default_taxrate') || '0.00';
my $reduced_taxrate = $::Values->{reduced_taxrate} || charge_param('reduced_taxrate') || '0.00';
 my $taxratefield     = charge_param('taxrate_field') || 'taxrate';
 my $reduced_taxfield = charge_param('reduced_tax_field') || 'reduced';

# $Id: breadcrumbs.tag,v 1.5 2007-08-09 13:40:53 pajamian Exp $

UserTag breadcrumbs Order number
UserTag breadcrumbs addAttr
UserTag breadcrumbs Routine <<EOR
sub {
my ($number, $opt) = @_;

use vars qw/$Tag $Scratch $CGI $Session $Variable/;
my $only_last = $::Variable->{BREADCRUMB_ONLY_LAST} || 'ord/basket login';
my $exclude   = $::Variable->{BREADCRUMB_EXCLUDE};
my $max   = $number || $::Variable->{BREADCRUMB_MAX} || 6;

my %exclude;
my %only_last;

UserTag breadcrumbs Order number
UserTag breadcrumbs addAttr
UserTag breadcrumbs Routine <<EOR
sub {
my ($number, $opt) = @_;

use vars qw/$Tag $Scratch $CGI $Session $Variable/;
my $only_last = $::Variable->{BREADCRUMB_ONLY_LAST} || 'ord/basket login';
my $exclude   = $::Variable->{BREADCRUMB_EXCLUDE};
my $max   = $number || $::Variable->{BREADCRUMB_MAX} || 6;

my %exclude;
my %only_last;

# 
# $Id: breadcrumbs.tag,v 1.5 2007-08-09 13:40:53 pajamian Exp $

UserTag breadcrumbs Order number
UserTag breadcrumbs addAttr
UserTag breadcrumbs Routine <<EOR
sub {
my ($number, $opt) = @_;

use vars qw/$Tag $Scratch $CGI $Session $Variable/;
my $only_last = $::Variable->{BREADCRUMB_ONLY_LAST} || 'ord/basket login';
my $exclude   = $::Variable->{BREADCRUMB_EXCLUDE};
my $max   = $number || $::Variable->{BREADCRUMB_MAX} || 6;

my %exclude;

$opt->{length} ||= 4;
my $en = $opt->{error_name} || 'captcha';

my $subdir = $opt->{image_subdir}
     || $::Variable->{CAPTCHA_IMAGE_SUBDIR}
     || 'captcha';
my $tmpdir = "$Vend::Cfg->{ScratchDir}/$subdir";

mkdir($tmpdir) unless -d $tmpdir;

my $imgdir = $opt->{image_location} || $::Variable->{CAPTCHA_IMAGE_LOCATION};

unless ($imgdir ) {
  if(! $Global::NoAbsolute and $::Variable->{DOCROOT}) {
     $imgdir = "$::Variable->{DOCROOT}$::Variable->{IMAGE_DIR}/$subdir";

unless ($imgdir ) {
if(! $Global::NoAbsolute and $::Variable->{DOCROOT}) {
$imgdir = "$::Variable->{DOCROOT}$::Variable->{IMAGE_DIR}/$subdir";
}
else {
  $imgdir = "images/$subdir";
 }
 }

 my $imgpath = $opt->{image_path}
        || $::Variable->{CAPTCHA_IMAGE_PATH}
        || "$::Variable->{IMAGE_DIR}/$subdir";

 
 my $captcha = Authen::Captcha->new(

$func =~ s/[^a-z]+//g;
my $result = '';
if($func eq 'code') {
  $result = $Vend::Session->{captcha};
}

$opt->{length} ||= 4;
my $en = $opt->{error_name} || 'captcha';

my $subdir = $opt->{image_subdir}
       || $::Variable->{CAPTCHA_IMAGE_SUBDIR}
       || 'captcha';
my $tmpdir = "$Vend::Cfg->{ScratchDir}/$subdir";

mkdir($tmpdir) unless -d $tmpdir;

  }
  elsif($status == -3) {
    $Tag->error( { name => $en, set => "Code doesn't match" });
    return 0;
  }
}
else {
  # Used for [captcha-refresh] if requested
  $::Instance->{last_captcha_build_opt} = { %$opt };

    my $save_u = umask($::Variable->{CAPTCHA_UMASK} || 2);

  if($opt->{reset}) {
    undef $Vend::Captcha;
    delete $Vend::Session->{captcha};

}

package Vend::Payment;
use strict;
my ($gcourl,$merchantid,$merchantkey,$gcoserver,$xmlOut, $taxrate, $state, \
 \
 $header, $gcorequest, $actual, $orderID);

sub googlecheckout {
my ($opt, $purchaseID, $mv_order_number, $msg, $cart, %result);
$gcoserver   = charge_param('googlehost')  || $::Variable->{MV_PAYMENT_HOST} \
 \
 || 'https://checkout.google.com/api/checkout/v2'; # live
my $catroot     = charge_param('cat_root') || $::Variable->{CAT_ROOT};
my $ordersdir   = charge_param('ordersdir') || 'orders';
my $currency    = $::Values->{currency} || charge_param('currency') || 'GBP';  
my $editbasketurl = charge_param('edit_basket_url') || $::Variable->{EDIT_BASKET_URL};
$editbasketurl =~ s/\.html$//i;

  $host = $Global::IpQuad == 0 ? 'nobody' : '';
  my @ip;
  @ip = split /\./, $CGI::ip;
  $CGI::ip = '';
  $CGI::ip = join ".", @ip[0 .. ($Global::IpQuad - 1)] if $Global::IpQuad;
}
#
# end AOL fix

# Fix Cobalt/CGIwrap problem
  if($Global::Variable->{CGIWRAP_WORKAROUND}) {
      $CGI::path_info =~ s!^$CGI::script_name!!;
  }

  $CGI::host = $host || $CGI::ip;

  if(-f "$dir/.autoload") {
    my $status = ::interpolate_html( readfile("$dir/.autoload") );
    $status =~ s/\s+//g;
    undef $level if $status;
  }
  $gate = check_gate($file,$dir)
    if defined $level;
}

if( defined $level and ! check_security($file, $level, $gate) ){
  my $realm = $::Variable->{COMPANY} || $Vend::Cat;
  if(-f "$try/violation$suffix") {
    $fn = "$try/violation$suffix";
  }
  else {

     $sth = $dbh->prepare("UPDATE transactions SET txtype='GCO - $gco_financial_state', \
 gco_fulfillment_state='$gco_fulfillment_state',gco_timestamp='$gco_timestamp' \
 WHERE gco_order_number='$gco_order_number'");
         }
     $sth->execute() or die errmsg("Cannot update transactions tbl for \
 gco '$gco_order_number'") unless defined $::Values->{mv_order_number};
#::logDebug(":GCO:".__LINE__.": gco_finstate=$gco_financial_state; txtype=$txtype; \
 neworderno=$new_order_no; pID=$purchaseID");     
     }

my ($mailout, $finstatus);

if ($gco_financial_state =~ /PAYMENT_DECLINED/i) {
      $mailout = <<EOM;
Card payment for Google Order number $gco_order_number from $::Variable->{COMPANY}, \
 $order_total, was
declined by your bank. Please use an alternative means of payment if you \
 wish to proceed with this order.
EOM
  $finstatus = "declined by your bank";
  }

if ($gco_financial_state =~ /PAYMENT_DECLINED/i) {
    $mailout = <<EOM;
Card payment for Google Order number $gco_order_number from $::Variable->{COMPANY}, \
 \
 $order_total, was
declined by your bank. Please use an alternative means of payment if you \
 \
 wish to proceed with this order.
EOM
$finstatus = "declined by your bank";
}
elsif ($gco_financial_state =~ /CANCELLED/i) {
    $mailout = <<EOM;
Google Order number $gco_order_number from $::Variable->{COMPANY} has been cancelled.
EOM
  $finstatus = "cancelled";
  }

}

package Vend::Payment;

sub itransact {
my ($opt, $amount) = @_;

my $user = $opt->{id} || charge_param('id');

my $company = $opt->{company} || "$::Variable->{COMPANY} Order";

my %actual;
if($opt->{actual}) {
  %actual = %{$opt->{actual}};

    ::logError("%s: using logdir %s instead of disallowed %s", __PACKAGE__, \
 $default_logdir, $logdir);
    $logdir = $default_logdir;
}
$logdir = Vend::File::make_absolute_file($logdir);

my $logzero    = charge_param('logzero')    || 'no';
my $available  = charge_param('available')  || 'no';
my $logempty   = $::Values->{logempty} || charge_param('logempty') || 'no';
my $double_pay = $::Values->{double_pay} || charge_param('double_pay') || 'no';
my $findcard   = charge_param('find_card_type') || 'no'; # yes for \
 auto, page for input, no for IC
my $description = charge_param('description') || $::Variable->{COMPANY};
$description = substr($description,0,99);
my $applyAVSCV2 = $::Values->{applyavscv2} || charge_param('applyavscv2') || '0';

# if payment is logged as made, raise an error message and exit

for my $line (split /\r\n/, $page) {
    $result{VPSTxID}    = $1 if ($line =~ /VPSTxId=(.*)/i);
    $result{Authorised} = $1 if ($line =~ /^Authorised=(.*)/i);
    $result{TxAuthNo}   = $1 if ($line =~ /VPSAuthCode=(.*)/i);
      }
#::logDebug("SP".__LINE__.": checkstatus,result=$result{Authorised}; authcode=$result{VPSAuthCode}; \
 vtxcode=$vendorTxCode"); 

   unless ($result{Authorised} =~ /YES/i) {
my $unknown = <<EOF;
ATTENTION: our payment processor has met an unexpected problem and we do not know if payment has
been taken or not. Please check back with $::Variable->{COMPANY} on $::Variable->{PHONE}, \
 quoting this 
important reference point:
<p>
VendorTxCode:  $::Session->{sagepay}{vendorTxCode}
<p>

      key => $record->{category},
      title => $record->{category},
      description => undef,
      url => $Tag->area({ search => join "\n", @parms }),
    };
  }
}

if(! $ptitle) {
  $ptitle = $Scratch->{page_title};
  $ptitle =~ s/(\s*\W+\s*)?$Variable->{COMPANY}(\s*\W+\s*)?//;
}

$ptitle =~ s/^\s+//;
$ptitle =~ s/\s+$//;

sub googlecheckout {
my ($opt, $purchaseID, $mv_order_number, $msg, $cart, %result);
$gcoserver   = charge_param('googlehost')  || $::Variable->{MV_PAYMENT_HOST} \
 \
 \
 \
 || 'https://checkout.google.com/api/checkout/v2'; # live
my $catroot     = charge_param('cat_root') || $::Variable->{CAT_ROOT};
my $ordersdir   = charge_param('ordersdir') || 'orders';
my $currency    = $::Values->{currency} || charge_param('currency') || 'GBP';  
my $editbasketurl = charge_param('edit_basket_url') || $::Variable->{EDIT_BASKET_URL};
$editbasketurl =~ s/\.html$//i;
   $editbasketurl .= ".html?id=$::Session->{id}";
my $continueshoppingurl = charge_param('continue_shopping_url') || $::Variable->{CONTINUE_SHOPPING_URL};
my $receipturl  = charge_param('receipt_url') || $::Variable->{RECEIPT_URL};
my $gcoipn_url  = charge_param('gcoipn_url') || $::Variable->{GCOIPN_URL};
my $gcocmd_url  = charge_param('gcocmd_url') || $::Variable->{GCOCMD_URL}; \
 # from IC admin panel, not from GCO
my $chargecard  = $::Values->{charge_card} || charge_param('charge_card') || '1';

return '';
[/perl]
[/if]


<form action="[area @@MV_PAGE@@]" method="post">
[if scratch ui_failure]
<p>
<blockquote>
<font color="__CONTRAST__">[scratch ui_failure][set ui_failure][/set]</font>
</blockquote>
<p>
&nbsp;
[/if]

<p>
<blockquote>
<font color="__CONTRAST__">[scratch ui_failure][set ui_failure][/set]</font>
</blockquote>
<p>
&nbsp;
[/if]
[if scratch ui_message]
<p>
<blockquote>
<font color="__CONTRAST__">[scratch ui_message][set ui_message][/set]</font>
</blockquote>
<p>
&nbsp;
[/if]

<input type="hidden" name="TermUrl" value="[scratch termurl]" />
<input type="hidden" name="MD" value="[scratch md]" />
</form>
</body>
along with whatever <noscript> equivalent you want. This will retrieve \
 the bank's page within the iframe.

Add a page in pages/ord/, tdsreturn.html, consisting of this:
[charge route="sagepay" sagepayrequest="3dsreturn"]
<p>
   <blockquote>
      <font color="__CONTRAST__">
              [error all=1 keep=1 show_error=1 show_label=1 joiner="<br>"]
      </font>
     </blockquote>

 $::Scratch->{'token'} = $result{'Token'};
 
if (!$result{'Token'}) {
 if ($result{'Ack'} eq 'Failure') {
   $::Session->{'errors'}{'PaypalExpress'} = $result{'Errors'}{'LongMessage'} \
  if ($result{'Errors'} !~ /ARRAY/);
   for my $i (0 .. 3) {
     $::Session->{'errors'}{'PaypalExpress'} .= " $result{'Errors'}[$i]{'LongMessage'}" \
  if ($result{'Errors'} =~ /ARRAY/);
       }
    }
 else {
    my $accepted = uc($::Variable->{CREDIT_CARDS_ACCEPTED});
    $::Session->{'errors'}{'PaypalExpress'} = errmsg("Paypal is currently \
 unavailable - please use our secure payment system instead. We accept $accepted cards");
          }
  return $Tag->deliver({ location => $checkouturl }) 
   }

}
else {
  $error = $Tag->error({name => $checkfor, keep => $keep});
}

if ($error) {
  if ($opt->{signal}) {
    sprintf($opt->{signal}, $label);
  }
  else {
    my $contrast = $::Variable->{CSS_CONTRAST} || 'mv_contrast';
    qq{<span class="$contrast">$label</span>};
  }  
}
else {      

# store the error label in user's session for later
# possible use in [error show_label=1] calls
$Vend::Session->{errorlabels}{$var} = $opt->{std_label};
if($text) {
# do nothing
}
elsif(defined $::Variable->{MV_ERROR_STD_LABEL}) {
$text = $::Variable->{MV_ERROR_STD_LABEL};
}
else {
my $contrast = $::Variable->{CSS_CONTRAST} || 'mv_contrast';
  $text = <<EOF;
<span class="$contrast">{LABEL} <small><i>(%s)</i></small></span>
[else]{REQUIRED <b>}{LABEL}{REQUIRED </b>}[/else]
EOF

my (%actual) = map_actual();

my @errMsgs = ();
# Required for validation
if (! $user) {
$user      = $opt->{id} || 
           charge_param('id') ||  
           $::Variable->{ECHO_PAYMENT_ID} ||
           $::Variable->{MV_PAYMENT_ID} ||
            $::Variable->{CYBER_ID}
            or push @errMsgs, "No payment ID found.";
}

# Required for validation

   charge_param('server') ||
$::Variable->{ECHO_PAYMENT_SERVER} ||
$::Variable->{MV_PAYMENT_SERVER} ||
   $::Variable->{CYBER_SERVER} ||
   'https://wwws.echo-inc.com/scripts/INR200.EXE';

my $precision  =  $opt->{precision} ||
      charge_param('precision') ||
$::Variable->{ECHO_PAYMENT_PRECISION} ||
$::Variable->{MV_PAYMENT_PRECISION} ||
       $::Variable->{CYBER_PRECISION} ||
       2;

##### ECHO SPECIFIC VARIABLES #####

      $::Variable->{CYBER_ID}
      or push @errMsgs, "No payment ID found.";
}

# Required for validation
if (! $secret) {
$secret    = $opt->{secret} ||
           charge_param('secret') ||
       $::Variable->{ECHO_PAYMENT_SECRET} ||
       $::Variable->{MV_PAYMENT_SECRET} ||
           $::Variable->{CYBER_SECRET}
           or push @errMsgs, "No payment secret found.";
}

if (scalar @errMsgs) {

  ::logError($_);
}
return 0;
}
@errMsgs = ();

my $server     = $opt->{server} ||
                 charge_param('server') ||
          $::Variable->{ECHO_PAYMENT_SERVER} ||
          $::Variable->{MV_PAYMENT_SERVER} ||
                 $::Variable->{CYBER_SERVER} ||
                 'https://wwws.echo-inc.com/scripts/INR200.EXE';

my $precision  =  $opt->{precision} ||
                    charge_param('precision') ||

last SMTP unless $none and $mhost;
eval {
require Net::SMTP;
};
last SMTP if $@;
$ok = 0;
$using = "Net::SMTP (mail server $mhost)";
#::logDebug("using $using");
undef $none;

my $smtp = Net::SMTP->new($mhost, Debug => $Global::Variable->{DEBUG}, \
 Hello => $helo) or last SMTP;
#::logDebug("smtp object $smtp");

my $from = $::Variable->{MV_MAILFROM}
    || $Global::Variable->{MV_MAILFROM}

last SMTP unless $none and $mhost;
eval {
require Net::SMTP;
};
last SMTP if $@;
$ok = 0;
$using = "Net::SMTP (mail server $mhost)";
#::logDebug("using $using");
undef $none;

my $smtp = Net::SMTP->new($mhost, Debug => $Global::Variable->{DEBUG}, Hello => $helo);
#::logDebug("smtp object $smtp");

my $from = $::Variable->{MV_MAILFROM}
    || $Global::Variable->{MV_MAILFROM}

UserTag image AttrAlias resize makesize
UserTag image AddAttr
UserTag image Version   1.25
UserTag image Routine   <<EOR
sub {
my ($src, $opt) = @_;
my ($image, $path, $secure, $sku);
my ($imagedircurrent, $imagedir, $imagedirsecure);

my @descriptionfields = grep /\S/, split /\s+/,
  $opt->{descriptionfields} || $::Variable->{DESCRIPTIONFIELDS} || $Vend::Cfg->{DescriptionField};
@descriptionfields = qw( description ) if ! @descriptionfields;

my @imagefields = grep /\S/, split /\s+/,
  $opt->{imagefields} || $::Variable->{IMAGEFIELDS};

my @js;
my $image;

my @from_html = qw/class id style/;

if($src) {
  if( $opt->{srcliteral} || $src =~ m{^https?://}i ) {
    $image = $src;
  }
  else {
    my $dr = $::Variable->{DOCROOT};
    my $id = $Tag->image( { dir_only => 1 } );
    $id =~ s:/+$::;
    $id =~ s:/~[^/]+::;

      }
    }
  }
}
push @srclist, $sku if $sku;
push @srclist, $opt->{default} if $opt->{default};

if ($opt->{imagesubdir}) {
  $opt->{imagesubdir} .= '/' unless $opt->{imagesubdir} =~ m:/$:;
}
my $dr = $::Variable->{DOCROOT};
my $id = $imagedircurrent;
$id =~ s:/+$::;
$id =~ s:/~[^/]+::;

my $subdir = $opt->{image_subdir}
   || $::Variable->{CAPTCHA_IMAGE_SUBDIR}
   || 'captcha';
my $tmpdir = "$Vend::Cfg->{ScratchDir}/$subdir";

mkdir($tmpdir) unless -d $tmpdir;

my $imgdir = $opt->{image_location} || $::Variable->{CAPTCHA_IMAGE_LOCATION};

unless ($imgdir ) {
if(! $Global::NoAbsolute and $::Variable->{DOCROOT}) {
   $imgdir = "$::Variable->{DOCROOT}$::Variable->{IMAGE_DIR}/$subdir";
  }
  else {
     $imgdir = "images/$subdir";

##### ECHO SPECIFIC VARIABLES #####

my $order_type = $::Variable->{ECHO_PAYMENT_ORDER_TYPE} || 'S';
my $isp_echo_id = $::Variable->{ECHO_PAYMENT_ISP_ECHO_ID};
my $isp_pin = $::Variable->{ECHO_PAYMENT_ISP_PIN};
my $merchant_email = $::Variable->{ECHO_PAYMENT_MERCHANT_EMAIL};

# Set to 'C' for Certify mode to check compliance with the ECHO spec on a
# transaction-by-transaction basis.  'T' or 'TRUE' for full ECHO debugging.
my $debug = $::Variable->{ECHO_PAYMENT_DEBUG};

 ##########################

 $actual{mv_credit_card_exp_month} =~ s/\D//g;

#::logDebug("echo called, args=" . ::uneval(\@_));

my (%actual) = map_actual();

my @errMsgs = ();
# Required for validation
if (! $user) {
  $user      = $opt->{id} || 
               charge_param('id') ||  
               $::Variable->{ECHO_PAYMENT_ID} ||
               $::Variable->{MV_PAYMENT_ID} ||
                $::Variable->{CYBER_ID}
                or push @errMsgs, "No payment ID found.";
}

my $precision  =  $opt->{precision} ||
  charge_param('precision') ||
$::Variable->{ECHO_PAYMENT_PRECISION} ||
$::Variable->{MV_PAYMENT_PRECISION} ||
   $::Variable->{CYBER_PRECISION} ||
   2;

##### ECHO SPECIFIC VARIABLES #####

my $order_type = $::Variable->{ECHO_PAYMENT_ORDER_TYPE} || 'S';
my $isp_echo_id = $::Variable->{ECHO_PAYMENT_ISP_ECHO_ID};
my $isp_pin = $::Variable->{ECHO_PAYMENT_ISP_PIN};
my $merchant_email = $::Variable->{ECHO_PAYMENT_MERCHANT_EMAIL};

# Set to 'C' for Certify mode to check compliance with the ECHO spec on a

charge_param('precision') ||
$::Variable->{ECHO_PAYMENT_PRECISION} ||
$::Variable->{MV_PAYMENT_PRECISION} ||
 $::Variable->{CYBER_PRECISION} ||
 2;

##### ECHO SPECIFIC VARIABLES #####

my $order_type = $::Variable->{ECHO_PAYMENT_ORDER_TYPE} || 'S';
my $isp_echo_id = $::Variable->{ECHO_PAYMENT_ISP_ECHO_ID};
my $isp_pin = $::Variable->{ECHO_PAYMENT_ISP_PIN};
my $merchant_email = $::Variable->{ECHO_PAYMENT_MERCHANT_EMAIL};

# Set to 'C' for Certify mode to check compliance with the ECHO spec on a
# transaction-by-transaction basis.  'T' or 'TRUE' for full ECHO debugging.

$::Variable->{ECHO_PAYMENT_PRECISION} ||
$::Variable->{MV_PAYMENT_PRECISION} ||
$::Variable->{CYBER_PRECISION} ||
2;

##### ECHO SPECIFIC VARIABLES #####

my $order_type = $::Variable->{ECHO_PAYMENT_ORDER_TYPE} || 'S';
my $isp_echo_id = $::Variable->{ECHO_PAYMENT_ISP_ECHO_ID};
my $isp_pin = $::Variable->{ECHO_PAYMENT_ISP_PIN};
my $merchant_email = $::Variable->{ECHO_PAYMENT_MERCHANT_EMAIL};

# Set to 'C' for Certify mode to check compliance with the ECHO spec on a
# transaction-by-transaction basis.  'T' or 'TRUE' for full ECHO debugging.
 my $debug = $::Variable->{ECHO_PAYMENT_DEBUG};

my $precision  =  $opt->{precision} ||
    charge_param('precision') ||
$::Variable->{ECHO_PAYMENT_PRECISION} ||
$::Variable->{MV_PAYMENT_PRECISION} ||
     $::Variable->{CYBER_PRECISION} ||
     2;

##### ECHO SPECIFIC VARIABLES #####

my $order_type = $::Variable->{ECHO_PAYMENT_ORDER_TYPE} || 'S';
my $isp_echo_id = $::Variable->{ECHO_PAYMENT_ISP_ECHO_ID};
my $isp_pin = $::Variable->{ECHO_PAYMENT_ISP_PIN};
my $merchant_email = $::Variable->{ECHO_PAYMENT_MERCHANT_EMAIL};

my $server     = $opt->{server} ||
       charge_param('server') ||
$::Variable->{ECHO_PAYMENT_SERVER} ||
$::Variable->{MV_PAYMENT_SERVER} ||
       $::Variable->{CYBER_SERVER} ||
       'https://wwws.echo-inc.com/scripts/INR200.EXE';

my $precision  =  $opt->{precision} ||
          charge_param('precision') ||
    $::Variable->{ECHO_PAYMENT_PRECISION} ||
    $::Variable->{MV_PAYMENT_PRECISION} ||
           $::Variable->{CYBER_PRECISION} ||
           2;

         $::Variable->{ECHO_PAYMENT_ID} ||
         $::Variable->{MV_PAYMENT_ID} ||
          $::Variable->{CYBER_ID}
          or push @errMsgs, "No payment ID found.";
}

# Required for validation
if (! $secret) {
  $secret    = $opt->{secret} ||
               charge_param('secret') ||
           $::Variable->{ECHO_PAYMENT_SECRET} ||
           $::Variable->{MV_PAYMENT_SECRET} ||
               $::Variable->{CYBER_SECRET}
               or push @errMsgs, "No payment secret found.";
}

if (scalar @errMsgs) {
  for (@errMsgs) {
    ::logError($_);
  }
  return 0;
}
@errMsgs = ();

 my $server     = $opt->{server} ||
                   charge_param('server') ||
            $::Variable->{ECHO_PAYMENT_SERVER} ||
            $::Variable->{MV_PAYMENT_SERVER} ||
                   $::Variable->{CYBER_SERVER} ||
                   'https://wwws.echo-inc.com/scripts/INR200.EXE';

package Vend::Payment;
use strict;
my ($gcourl,$merchantid,$merchantkey,$gcoserver,$xmlOut, $taxrate, $state, \
 \
 \
 $header, $gcorequest, $actual, $orderID);

sub googlecheckout {
my ($opt, $purchaseID, $mv_order_number, $msg, $cart, %result);
$gcoserver   = charge_param('googlehost')  || $::Variable->{MV_PAYMENT_HOST} \
 \
 \
 || 'https://checkout.google.com/api/checkout/v2'; # live
my $catroot     = charge_param('cat_root') || $::Variable->{CAT_ROOT};
my $ordersdir   = charge_param('ordersdir') || 'orders';
my $currency    = $::Values->{currency} || charge_param('currency') || 'GBP';  
my $editbasketurl = charge_param('edit_basket_url') || $::Variable->{EDIT_BASKET_URL};
$editbasketurl =~ s/\.html$//i;
     $editbasketurl .= ".html?id=$::Session->{id}";
my $continueshoppingurl = charge_param('continue_shopping_url') || $::Variable->{CONTINUE_SHOPPING_URL};
my $receipturl  = charge_param('receipt_url') || $::Variable->{RECEIPT_URL};

# 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.

UserTag forum-userlink PosNumber 0
UserTag forum-userlink addAttr
UserTag forum-userlink Version   1.7
UserTag forum-userlink Routine   <<EOR
sub {
my ($row) = @_;
return $row->{name} || $Variable->{FORUM_ANON_NAME} || 'Anonymous Coward'
  if $row->{anon} or ! $row->{username};
my $realname = tag_data('userdb', 'handle', $row->{username})
       || tag_data('userdb', 'fname', $row->{username});
return $realname || $row->{username};

$gcoserver   = charge_param('googlehost')  || $::Variable->{MV_PAYMENT_HOST} \
 \
 \
 \
 \
 \
 \
 || 'https://checkout.google.com/api/checkout/v2'; # live
my $catroot     = charge_param('cat_root') || $::Variable->{CAT_ROOT};
my $ordersdir   = charge_param('ordersdir') || 'orders';
my $currency    = $::Values->{currency} || charge_param('currency') || 'GBP';  
my $editbasketurl = charge_param('edit_basket_url') || $::Variable->{EDIT_BASKET_URL};
$editbasketurl =~ s/\.html$//i;
$editbasketurl .= ".html?id=$::Session->{id}";
my $continueshoppingurl = charge_param('continue_shopping_url') || $::Variable->{CONTINUE_SHOPPING_URL};
my $receipturl  = charge_param('receipt_url') || $::Variable->{RECEIPT_URL};
my $gcoipn_url  = charge_param('gcoipn_url') || $::Variable->{GCOIPN_URL};
my $gcocmd_url  = charge_param('gcocmd_url') || $::Variable->{GCOCMD_URL}; \
 \
 \
 \
 # from IC admin panel, not from GCO
my $chargecard  = $::Values->{charge_card} || charge_param('charge_card') || '1';
my $basket_expiry = charge_param('basket_expiry') || $::Variable->{BASKET_EXPIRY} || '1 month';
my $default_taxrate = $::Values->{default_taxrate} || charge_param('default_taxrate') || '0.00';
 my $reduced_taxrate = $::Values->{reduced_taxrate} || charge_param('reduced_taxrate') || '0.00';

my ($opt, $purchaseID, $mv_order_number, $msg, $cart, %result);
$gcoserver   = charge_param('googlehost')  || $::Variable->{MV_PAYMENT_HOST} \
 \
 \
 \
 \
 \
 || 'https://checkout.google.com/api/checkout/v2'; # live
my $catroot     = charge_param('cat_root') || $::Variable->{CAT_ROOT};
my $ordersdir   = charge_param('ordersdir') || 'orders';
my $currency    = $::Values->{currency} || charge_param('currency') || 'GBP';  
my $editbasketurl = charge_param('edit_basket_url') || $::Variable->{EDIT_BASKET_URL};
$editbasketurl =~ s/\.html$//i;
$editbasketurl .= ".html?id=$::Session->{id}";
my $continueshoppingurl = charge_param('continue_shopping_url') || $::Variable->{CONTINUE_SHOPPING_URL};
my $receipturl  = charge_param('receipt_url') || $::Variable->{RECEIPT_URL};
my $gcoipn_url  = charge_param('gcoipn_url') || $::Variable->{GCOIPN_URL};
my $gcocmd_url  = charge_param('gcocmd_url') || $::Variable->{GCOCMD_URL}; \
 \
 \
 # from IC admin panel, not from GCO
my $chargecard  = $::Values->{charge_card} || charge_param('charge_card') || '1';
my $basket_expiry = charge_param('basket_expiry') || $::Variable->{BASKET_EXPIRY} || '1 month';
 my $default_taxrate = $::Values->{default_taxrate} || charge_param('default_taxrate') || '0.00';

# 
# $Id: pay_cert.tag,v 1.4 2009-05-01 13:50:00 pajamian Exp $

UserTag pay-cert Order code
UserTag pay-cert addAttr
UserTag pay-cert Routine <<EOR
sub {
my ($code, $opt) = @_;

use vars qw/$Tag/;
my $counter_file = $::Variable->{GIFT_CERT_COUNTER} || 'etc/pay_cert.number';
my $cert_table   = $::Variable->{GIFT_CERT_TABLE}     || 'pay_certs';
my $redeem_table = $::Variable->{GIFT_CERT_REDEEM_TABLE} || 'pay_cert_redeem';
my $lock_table   = $::Variable->{GIFT_CERT_LOCK_TABLE}   || 'pay_cert_lock';

UserTag pay-cert Order code
UserTag pay-cert addAttr
UserTag pay-cert Routine <<EOR
sub {
my ($code, $opt) = @_;

use vars qw/$Tag/;
my $counter_file = $::Variable->{GIFT_CERT_COUNTER} || 'etc/pay_cert.number';
my $cert_table   = $::Variable->{GIFT_CERT_TABLE}     || 'pay_certs';
my $redeem_table = $::Variable->{GIFT_CERT_REDEEM_TABLE} || 'pay_cert_redeem';
my $lock_table   = $::Variable->{GIFT_CERT_LOCK_TABLE}   || 'pay_cert_lock';

my $ldb = dbref($lock_table) 
or die errmsg("cannot open payment certs lock table '%s'", $lock_table);

UserTag pay-cert Order code
UserTag pay-cert addAttr
UserTag pay-cert Routine <<EOR
sub {
my ($code, $opt) = @_;

use vars qw/$Tag/;
my $counter_file = $::Variable->{GIFT_CERT_COUNTER} || 'etc/pay_cert.number';
my $cert_table   = $::Variable->{GIFT_CERT_TABLE}     || 'pay_certs';
my $redeem_table = $::Variable->{GIFT_CERT_REDEEM_TABLE} || 'pay_cert_redeem';
my $lock_table   = $::Variable->{GIFT_CERT_LOCK_TABLE}   || 'pay_cert_lock';

my $ldb = dbref($lock_table) 
or die errmsg("cannot open payment certs lock table '%s'", $lock_table);

# $Id: pay_cert.tag,v 1.4 2009-05-01 13:50:00 pajamian Exp $

UserTag pay-cert Order code
UserTag pay-cert addAttr
UserTag pay-cert Routine <<EOR
sub {
my ($code, $opt) = @_;

use vars qw/$Tag/;
my $counter_file = $::Variable->{GIFT_CERT_COUNTER} || 'etc/pay_cert.number';
my $cert_table   = $::Variable->{GIFT_CERT_TABLE}     || 'pay_certs';
my $redeem_table = $::Variable->{GIFT_CERT_REDEEM_TABLE} || 'pay_cert_redeem';
my $lock_table   = $::Variable->{GIFT_CERT_LOCK_TABLE}   || 'pay_cert_lock';

my $ldb = dbref($lock_table) 

# (at your option) any later version.  See the LICENSE file for details.
# 
# $Id: get_gpg_keys.coretag,v 1.5 2007-03-30 23:40:54 pajamian Exp $

UserTag get-gpg-keys Order    dir
UserTag get-gpg-keys addAttr
UserTag get-gpg-keys Version  $Revision: 1.5 $
UserTag get-gpg-keys Routine  <<EOR
sub {
my ($dir, $opt) = @_;
my $gpgexe = $Global::Variable->{GPG_PATH} || 'gpg';

my $flags = "--list-keys";
if($dir) {
  $dir = filter_value('filesafe', $dir);

# (at your option) any later version.  See the LICENSE file for details.
# 
# $Id: add_gpg_key.coretag,v 1.6 2007-03-30 23:40:54 pajamian Exp $

UserTag add-gpg-key Order   name
UserTag add-gpg-key addAttr
UserTag add-gpg-key Version $Revision: 1.6 $
UserTag add-gpg-key Routine <<EOR
sub {
my ($name, $opt) = @_;
my $gpgexe = $Global::Variable->{GPG_PATH} || 'gpg';

my $outfile = "$Vend::Cfg->{ScratchDir}/$Vend::Session->{id}.gpg_results";

my $flags = "--import --batch 2> $outfile";

UserTag title-bar Order        width size color
UserTag title-bar PosNumber    3
UserTag title-bar Interpolate  1
UserTag title-bar HasEndTag    1
UserTag title-bar Version      $Revision: 1.4 $
UserTag title-bar Routine      <<EOR
sub {
my ($width, $size, $color, $text) = @_;
$width = 500 unless defined $width;
$size = 6 unless defined $size;
$color = ($::Variable->{HEADERBG} || '#444444') unless defined $color;
$color = qq{BGCOLOR="$color"} unless $color =~ /^\s*bgcolor=/i;
my $tcolor = $::Variable->{HEADERTEXT} || 'WHITE';
$text = qq{<FONT COLOR="$tcolor" SIZE="$size">$text</FONT>};
return <<EOF;

UserTag title-bar Interpolate  1
UserTag title-bar HasEndTag    1
UserTag title-bar Version      $Revision: 1.4 $
UserTag title-bar Routine      <<EOR
sub {
my ($width, $size, $color, $text) = @_;
$width = 500 unless defined $width;
$size = 6 unless defined $size;
$color = ($::Variable->{HEADERBG} || '#444444') unless defined $color;
$color = qq{BGCOLOR="$color"} unless $color =~ /^\s*bgcolor=/i;
my $tcolor = $::Variable->{HEADERTEXT} || 'WHITE';
$text = qq{<FONT COLOR="$tcolor" SIZE="$size">$text</FONT>};
return <<EOF;
<TABLE CELLSPACING=0 CELLPADDING=6 WIDTH="$width"><TR><TD VALIGN=CENTER \
 $color>$text</TD></TR></TABLE>
EOF

{CONFIG?}{CONFIG}({NAME}FCKeditor);{/CONFIG?}
  {NAME}FCKeditor.ReplaceTextarea() ;
});

</script>
|,
        area => qq|<textarea id="{NAME}" rows="{HEIGHT}" cols="{WIDTH}" \
 name="{NAME}">{VALUE}</textarea>|,
        post => ''
});

my $flavour = $opt->{flavour} || $::Variable->{HTMLAREA_FLAVOUR} || 'htmlarea';

my $fname = $opt->{form_name} || 'editor';

my $callpage = $opt->{append} || 'special/kupu';

$pname =~ s/\W/_/g;

unless(defined $opt->{close_window}) {
$opt->{close_window} = 1;
}

if(! $::Scratch->{htmlarea_added}) {
$Tag->tmp({ name => 'htmlarea_added', body => 1 });
$::Scratch->{meta_header} ||= '';
my $path = $::Variable->{HTMLAREA_PATH} || $flavours{$flavour}->{path};
my $lang = $::Variable->{HTMLAREA_LANG} || $::Scratch->{mv_locale} || 'en';
$lang = substr($lang, 0, 2);
$path =~ s:/*$:/:;
$::Scratch->{meta_header} .= $Tag->uc_attr_list({hash => {path => $path, \
 \
 lang => $lang}}, $flavours{$flavour}->{header});
}

$pname =~ s/\W/_/g;

unless(defined $opt->{close_window}) {
  $opt->{close_window} = 1;
}

if(! $::Scratch->{htmlarea_added}) {
  $Tag->tmp({ name => 'htmlarea_added', body => 1 });
  $::Scratch->{meta_header} ||= '';
  my $path = $::Variable->{HTMLAREA_PATH} || $flavours{$flavour}->{path};
  my $lang = $::Variable->{HTMLAREA_LANG} || $::Scratch->{mv_locale} || 'en';
  $lang = substr($lang, 0, 2);
  $path =~ s:/*$:/:;
  $::Scratch->{meta_header} .= $Tag->uc_attr_list({hash => {path => $path, \
 lang => $lang}}, $flavours{$flavour}->{header});

sub {
my ($src, $opt) = @_;
my ($image, $path, $secure, $sku);
my ($imagedircurrent, $imagedir, $imagedirsecure);

my @descriptionfields = grep /\S/, split /\s+/,
$opt->{descriptionfields} || $::Variable->{DESCRIPTIONFIELDS} || $Vend::Cfg->{DescriptionField};
@descriptionfields = qw( description ) if ! @descriptionfields;

my @imagefields = grep /\S/, split /\s+/,
$opt->{imagefields} || $::Variable->{IMAGEFIELDS};
@imagefields = qw( image ) if ! @imagefields;

my @imagesuffixes = qw( jpg gif png jpeg );
my $filere = qr/\.\w{2,4}$/;

if(! $Global::NoAbsolute and $::Variable->{DOCROOT}) {
$imgdir = "$::Variable->{DOCROOT}$::Variable->{IMAGE_DIR}/$subdir";
}
else {
 $imgdir = "images/$subdir";
}
}

my $imgpath = $opt->{image_path}
       || $::Variable->{CAPTCHA_IMAGE_PATH}
       || "$::Variable->{IMAGE_DIR}/$subdir";


my $captcha = Authen::Captcha->new(
         data_folder => $tmpdir,

my $mgkpath = $newpath;
my $ext;
$mgkpath =~ s/\.(\w+)$/.mgk/
  and $ext = $1;

File::Copy::copy($path, $newpath)
  or do {
    logError("%s: Unable to create image '%s'", 'image tag', $newpath);
    last MOGIT;
  };
my $exec = $Global::Variable->{IMAGE_MOGRIFY};
if(! $exec) {
  my @dirs = split /:/, "/usr/X11R6/bin:$ENV{PATH}";
  for(@dirs) {
    next unless -x "$_/mogrify";

or do {
  logError("%s: Unable to create image '%s'", 'image tag', $newpath);
  last MOGIT;
};
my $exec = $Global::Variable->{IMAGE_MOGRIFY};
if(! $exec) {
my @dirs = split /:/, "/usr/X11R6/bin:$ENV{PATH}";
for(@dirs) {
  next unless -x "$_/mogrify";
           $exec = "$_/mogrify";
           $Global::Variable->{IMAGE_MOGRIFY} = $exec;
          last;
        }
      }
      last MOGIT unless $exec;

# LEGACY
ROUTINES: {
  last ROUTINES unless index($Vend::FinalPath, "/$Vend::Cfg->{ProcessPage}/") == 0;
  while ($Vend::FinalPath =~ s{/$Vend::Cfg->{ProcessPage}/(locale|language \
|currency)/([^/]*)/}{/$Vend::Cfg->{ProcessPage}/}) {
    $::Scratch->{"mv_$1"} = $2;
  }
  $Vend::FinalPath =~ s{/$Vend::Cfg->{ProcessPage}/page/}{/};
}

if(my $locale = $::Scratch->{mv_language}) {
  $Global::Variable->{LANG}
    = $::Variable->{LANG} = $locale;
}
# END LEGACY

  }
},

  Locale => sub {
#::logDebug("Doing Locale dispatch...");
      my $locale = $::Scratch->{mv_locale};
      my $curr = $::Scratch->{mv_currency};
      $locale || $curr    or return;

      if($locale and ! $::Scratch->{mv_language}) {
          $Global::Variable->{LANG}
                  = $::Variable->{LANG}
                  = $::Scratch->{mv_language}
                  = $locale;
      }

return unless $Vend::Cfg->{FileDatabase};
my ($tab, $col) = split /:+/, $Vend::Cfg->{FileDatabase};
my $db = $Vend::Interpolate::Db{$tab} || ::database_exists_ref($tab)
  or return undef;
#::logDebug("tab=$tab exists, db=$db");

# I guess this is the best test
if($col) {
  return undef unless $db->column_exists($col);
}
elsif ( $col = $Global::Variable->{LANG} and $db->column_exists($col) ) {
  #do nothing
}
else {
  $col = 'default';

if ($gcorequest eq 'post') {
 undef $gcorequest;
my $salestax = $::Values->{tax} || Vend::Interpolate::salestax() || '0.00';
my $shipmode = $::Values->{mv_shipmode} || charge_param('default_shipmode') || 'upsg';
my $shipping = $::Session->{final_shipping} || Vend::Ship::shipping($shipmode) \
 || charge_param('default_shipping') || '0.00';
my $handling = $::Values->{handlingtotal} || Vend::Ship::tag_handling() || '';
     $shipping += $handling;
my $shipmsg  = $::Session->{ship_message};
my $subtotal = $::Values->{amount} || Vend::Interpolate::subtotal();
my $ordertotal = charge_param('amount') || Vend::Interpolate::total_cost();
print "GCO".__LINE__.": tax=$salestax; shipping=$shipping, $::Values->{mv_shipping}; \
 shipmode=$shipmode\n";
my $defaultcountry = charge_param('defaultcountry');
my $defaultstate = charge_param('defaultstate');
my $country  = uc($actual->{country});
            $country  = $defaultcountry unless $country; 

        $country  = $defaultcountry unless $country; 
my $state    = uc($actual->{state});
          $state    = $defaultstate unless $state;
my $zip_pattern = $actual->{zip} || $::Values->{zip};
          $zip_pattern =~ /(\S\S\S).*/;
          $zip_pattern = "$1"."*";
my $taxshipping = 'false';
          $taxshipping = 'true' if (($country =~ /$::Variable->{TAXSHIPPING}/) \
 \
 \
 or ($state =~ /$::Variable->{TAXSHIPPING}/) or ($alwaystaxshipping == '1'));
::logDebug(":GCO:".__LINE__.": shipping=$::Session->{final_shipping}, $shipping; \
 \
 \
 handling=$handling; taxshipping=$::Variable->{TAXSHIPPING}; \
 \
 \
 country=$country; tx=$taxshipping");
my $stax = Vend::Interpolate::salestax();
print "GCO:".__LINE__.": stax=$stax; mvst=$::Values->{mv_salestax}, $::Values->{salestax}\n";
if ($salestax == '0') { 
      $taxrate = '0.00';
        }
elsif ($taxshipping eq 'true') { 

      }
elsif ($taxshipping eq 'true') { 
       $taxrate = ($salestax / ($subtotal + $shipping) || '0');
        }
elsif ($calculate_included_tax == '1') {
       $taxrate = $default_taxrate;
        } 
else { 
       $taxrate =  ($salestax / $subtotal || '0');
}
::logDebug(":GCO:".__LINE__.": subtotal=$subtotal; taxrate=$taxrate");

### Check that the currency sent to GCO is the one registered with them, or return to the checkout
my $user_currency = $::Scratch->{iso_currency_code} || $::Values->{iso_currency_code} || $currency;
#::logDebug(" ".__LINE__.": user currency = $user_currency, $::Scratch->{iso_currency_code}, \
 $::Values->{iso_currency_code}; currency=$currency"); 

     $cart = eval ($cart);
  my $dbi = dbref('inventory') or die errmsg("cannot open inventory table");
  my $dbhi = $dbi->dbh() or die errmsg("cannot get handle for tbl 'inventory'");
  my ($sthi, $itm, $qty);

foreach my $items (@{$cart}) { 
        $itm = $items->{'code'};
        $qty = $items->{'quantity'};
        $sthi = $dbh->prepare("UPDATE inventory SET quantity = quantity \
 -'$qty' WHERE sku = '$itm'");
        $sthi->execute() or die errmsg("Cannot update table inventory");
::logDebug(":GCO:".__LINE__.": Decremented inventory for $itm by $qty");
        }
        }  
         }
     else {

my $xmlOut = shift;
my $agent  = LWP::UserAgent->new;
my $data   = "$merchantid:$merchantkey";
my $signature = encode_base64($data, "");
   $header  = HTTP::Headers->new;
   $header->header('Authorization' => "Basic " . $signature);
   $header->header('Content-Type'  => "application/xml; charset=UTF-8");
   $header->header('Accept'        => "application/xml");
my $request = HTTP::Request->new(POST => $gcourl, $header, $xmlOut);
my $response = $agent->request($request);
::logDebug(":GCO:".__LINE__.": sendxml: gcourl=$gcourl\nxmlOut=$xmlOut");
return $response->content;
}

1;

my $customerEmail      = $actual->{email};
   $customerEmail      =~ s/[^a-zA-Z0-9.\@\-_]//gi;
my $contactFax         = $::Values->{fax} || '';
   $contactFax         =~ s/[\(\)]/ /g;
   $contactFax         =~ s/[^0-9-+ ]//gi;
my $giftAidPayment     = $::Values->{giftaidpayment} || charge_param('giftaidpayment') || '0';
my $authCode           = $::Values->{authcode} || '';
my $clientIPAddress    = $CGI::remote_addr if $CGI::remote_addr;
    $::Values->{authcode} = '';

::logDebug("SP".__LINE__.": bCity=$billingCity; mvccType=$cardType; start=$mvccStartDate; \
 issue=$issue;");
  
# ISO currency code sent to SagePay, from the page or fall back to config files.
my $currency = $::Values->{iso_currency_code} || $::Values->{currency_code} \
 || $Vend::Cfg->{Locale}{iso_currency_code} ||
           charge_param('currency') || $::Variable->{MV_PAYMENT_CURRENCY} || 'GBP';

       push @query, "$key=$query{$key}";
    }

my $string = join '&', @query; # replicates the string as actually sent: \
 useful to quote this for debugging
#::logDebug("SP".__LINE__.": string to SagePay: $string");
  
  $post     = post_data($opt, \%query);
  $response = $post->{status_line};
  $page     = $post->{result_page};

::logDebug("SP".__LINE__.": response page:\n-------------------------\n$page \
 \n---------------------------\nend of SagePay results page\n\n");
  
  $result{TxType}         = $txtype;
  $result{Currency}       = $currency;
  $result{CardRef}        = $::Session->{sagepay}{CardRef};

$result{'Status'} = 'OK';
  $::Scratch->{mstatus} = 'success';
  $::Scratch->{order_id} = $result{'order-id'};
  $::Values->{mv_payment} = "Real-time card $result{CardInfo}";
   $::Values->{psp} = charge_param('psp') || 'SagePay';
   $::CGI::values{mv_todo} = 'submit';
     if ($result{SecureStatus} =~ /OK|ATTEMPTONLY/i) {
      $::Scratch->{tds} = 'yes' ;
      $Vend::Session->{payment_result} = \%result;

::logDebug("SP".__LINE__.": secureStatus=$result{SecureStatus} so now to \
 run routes; result hash=".::uneval(\%result));

      Vend::Dispatch::do_process();
      }
    }

      $::Values->{mv_payment} = "Processing card $result{CardInfo}";
       $CGI::values{mv_todo} = 'submit';

#::logDebug("SP".__LINE__.": request=$request; tds=$::Scratch->{tds}");
         
         }

   undef $request;
   $::Values->{request} = '';

::logDebug("SP".__LINE__.":result=".::uneval(\%result));

# Now extra logging for backup order and/or log of events
if ($logorder =~ /y|1/) {
#--- write the full basket and address to failsafe file 

   $::Scratch->{orderID} = $orderID;

# Disable order number creation in log_transaction and create it here instead, unless IC is old
if ($::Values->{inv_no}) {
  $purchaseID = $::Values->{inv_no};
    }
else{
# Use temporary number as the initial order number, and only replace upon \
 successful order completion
  $purchaseID = "$tmpPrefix".Vend::Interpolate::tag_counter("$wpcounter");
  $Vend::Session->{mv_order_number} = $::Values->{mv_order_number} = \
 $purchaseID if ($oldic == 1);# prevents early ICs setting order number prior to log_transaction
::logDebug("WP:".__LINE__.": purchaseID=$purchaseID; $Vend::Session->{mv_order_number}");
}
  
  my $cartId = $desc = $::Scratch->{purchaseID} = $purchaseID;

$basket .= <<EOB;
Item = $itm->{code}, "$itm->{rpDescription}"; Price = $itm->{price}; \
 Qty = $itm->{quantity}; Subtotal = $itm->{subtotal} 
EOB

 my ($dorecurringbilling, $cntr);
 my $rpamount = $itm->{'rpamount_field'} || $itm->{'rpamount'};
  $nonrp = '1' if (! $rpamount); # only run Do request if have standard purchase as well
 if ($rpamount) {
#    $cntr++;
print "PP".__LINE__.": cntr=$cntr; initamount=$itm->{initAmount}; rpAmount=$itm->{rpAmount}; \
 trialAmount=$itm->{trialAmount}\n";  
         $dorecurringbilling = (
          SOAP::Data->name("BillingAgreementDetails" =>
          \SOAP::Data->value(
           SOAP::Data->name("BillingType" => 'RecurringPayments')->type(""),

return undef if ! defined($html);
return undef if $Vend::NoInterpolate;
my ($name, @post);
my ($bit, %post);

local($^W);

my $toplevel;
if(defined $Vend::PageInit and ! $Vend::PageInit) {
  defined $::Variable->{MV_AUTOLOAD}
    and $html =~ s/^/$::Variable->{MV_AUTOLOAD}/;
  $toplevel = 1;
}
#::logDebug("opt=" . uneval($opt));

sub server_start_message {
my ($fmt, $reverse) = @_;
$fmt = 'START server (%s) (%s)' unless $fmt; 
my @types;
push (@types, 'INET') if $Global::Inet_Mode;
push (@types, 'UNIX') if $Global::Unix_Mode;
push (@types, 'SOAP') if $Global::SOAP;
push (@types, 'mod_perl') if $Global::mod_perl;
my $server_type = join(" and ", @types);
my $pid = ( $Global::PreFork || $Global::Variable->{MV_BAD_LOCK} )
      ? $$
      : read_pidfile();
my @args = $reverse ? ($server_type, $pid) : ($pid, $server_type);
return ::errmsg ($fmt , @args );

$name ||= $control->{component};
$name ||= $opt->{default};

if (! $name or $name eq 'none') {
# Increment control_index so empty component has no side effect
$::Scratch->{control_index}++;
return;
}

my $t = $opt->{comp_table} || $::Variable->{MV_COMPONENT_TABLE} || 'component';
my $ctab = $::Variable->{MV_COMPONENT_CACHE} || 'component_cache';

my $record;
my $db = database_exists_ref($t);
my $nocache;

  }
  $record = $db->row_hash($name);
}

$record ||= $opt;

my $body = $record->{comptext};

if(! length($body)) {
  my $dir = $opt->{comp_dir}
      || $::Variable->{MV_COMPONENT_DIR}
      || 'templates/components';
  $body = readfile("$dir/$name",undef,1);
}

$name ||= $control->{component};
$name ||= $opt->{default};

if (! $name or $name eq 'none') {
  # Increment control_index so empty component has no side effect
  $::Scratch->{control_index}++;
  return;
}

my $t = $opt->{comp_table} || $::Variable->{MV_COMPONENT_TABLE} || 'component';
my $ctab = $::Variable->{MV_COMPONENT_CACHE} || 'component_cache';

my $record;
my $db = database_exists_ref($t);

  guess_cc_type($cardinfo->{MV_CREDIT_CARD_NUMBER});

return Vend::Interpolate::tag_attr_list($template, $cardinfo);
}


sub guess_cc_type {
my ($ccnum) = @_;
$ccnum =~ s/\D+//g;

my $country = uc($::Values->{$::Variable->{MV_COUNTRY_FIELD} || 'country'} || '');

if(my $subname = $Vend::Cfg->{SpecialSub}{guess_cc_type}) {
  my $sub = $Vend::Cfg->{Sub}{$subname} || $Global::GlobalSub->{$subname};
  my $guess;

}
else {
  return (undef, $var,
    errmsg( $state_error{CA}, $val )
  );
}
}

sub _get_cval {
my ($ref, $var) = @_;
my $cfield = $::Variable->{MV_COUNTRY_FIELD} || 'country';
my $cval = $ref->{$cfield} || $::Values->{$cfield};

if($var =~ /^b_/ and $ref->{"b_$cfield"} || $::Values->{"b_$cfield"}) {
  $cval = $ref->{"b_$cfield"} || $::Values->{"b_$cfield"};

}

sub tax_vat {
my($type, $opt) = @_;
#::logDebug("entering VAT, opts=" . uneval($opt));
my $cfield = $::Variable->{MV_COUNTRY_TAX_VAR} || 'country';
my $country = $opt->{country} || $::Values->{$cfield};

return 0 if ! $country;
my $ctable   = $opt->{country_table}
      || $::Variable->{MV_COUNTRY_TABLE}
      || 'country';
my $c_taxfield   = $opt->{country_tax_field}
      || $::Variable->{MV_COUNTRY_TAX_FIELD}
      || 'tax';

my($type, $opt) = @_;
#::logDebug("entering VAT, opts=" . uneval($opt));
my $cfield = $::Variable->{MV_COUNTRY_TAX_VAR} || 'country';
my $country = $opt->{country} || $::Values->{$cfield};

return 0 if ! $country;
my $ctable   = $opt->{country_table}
    || $::Variable->{MV_COUNTRY_TABLE}
    || 'country';
my $c_taxfield   = $opt->{country_tax_field}
    || $::Variable->{MV_COUNTRY_TAX_FIELD}
    || 'tax';
#::logDebug("ctable=$ctable c_taxfield=$c_taxfield country=$country");
$type ||= tag_data($ctable, $c_taxfield, $country)
  or return 0;

sub percent_rate {
my $rate = shift;
$rate =~ s/\s*%\s*$// and $rate /= 100;
return $rate;
}

sub tax_vat {
my($type, $opt) = @_;
#::logDebug("entering VAT, opts=" . uneval($opt));
my $cfield = $::Variable->{MV_COUNTRY_TAX_VAR} || 'country';
my $country = $opt->{country} || $::Values->{$cfield};

return 0 if ! $country;
my $ctable   = $opt->{country_table}

}

if(my $num = $cardinfo->{MV_CREDIT_CARD_NUMBER}) {
  my @quads;
  $num =~ s/\D//g;
  @quads = $num =~ m{(\d\d\d\d)(\d\d\d\d)(\d\d\d\d)(\d+)};
  $cardinfo->{MV_CREDIT_CARD_QUADS} = join "-", @quads;
}

$template = $template ||
  $::Variable->{MV_CREDIT_CARD_INFO_TEMPLATE} ||
  join("\t", qw(
    {MV_CREDIT_CARD_TYPE}
    {MV_CREDIT_CARD_NUMBER}
    {MV_CREDIT_CARD_EXP_MONTH}/{MV_CREDIT_CARD_EXP_YEAR}

      $opt->{file} = "$dir/default.txt";
    }
  }
}

$opt->{dhtml_browser} = dhtml_browser()
  unless defined $opt->{dhtml_browser};
$opt->{menu_type} ||= 'simple';

my $prefix = $opt->{prefix} || 'menu';
$opt->{link_class} ||= $::Variable->{MV_DEFAULT_LINK_CLASS};

$opt->{parse_header_footer} = 1 unless defined $opt->{parse_header_footer};

if($opt->{parse_header_footer}) {

$limit = -1 if $limit =~ /^[^-0-9]/;
$ref->{mv_dict_end} = $ref->{mv_dict_look};
substr($ref->{mv_dict_end},$limit,1) =~ s/(.)/chr(ord($1) + 1)/e;
return $_[1];
}

sub _matchlimit {
shift;
my $val = lc(shift);
return -1 if $val eq 'none' or $val eq 'all';
return int($val) || $::Variable->{MV_DEFAULT_MATCHLIMIT} || 50;
}

1;
__END__

SEARCH: {
  $options{mv_return_all} = 1
    if $options{mv_dict_look} and ! $options{mv_searchspec};

  if (defined $pre_made) {
    $q = $pre_made;
    @{$q}{keys %options} = (values %options);
  }
  elsif (
      ! $options{mv_searchtype} && $::Variable->{MV_DEFAULT_SEARCH_DB}
      or $options{mv_searchtype} =~ /db|sql/i
    )
  {
    $q = new Vend::DbSearch %options;

sub _file_security {
my ($junk, $param, $passed) = @_;
$passed = [] unless $passed;
my(@files) = grep /\S/, split /\s*[,\0]\s*/, $param, -1;
for(@files) {
my $ok = allowed_file($_);
if(!$ok) {
  $ok = 1 if $_ eq $::Variable->{MV_SEARCH_FILE};
  $ok = 1 if $::Scratch->{$_};
}
if(/^\w+$/ and ! $::Variable->{MV_DEFAULT_SEARCH_DB}) {
  $_ = $Vend::Cfg->{Database}{$_}{file}
      if defined $Vend::Cfg->{Database}{$_};
  }
  if ($ok and $Vend::Cfg->{NoSearch} and /$Vend::Cfg->{NoSearch}/) {

$s->{mv_begin_string}       = [];
$s->{mv_all_chars}          = [1];
$s->{mv_case}               = [];
$s->{mv_column_op}          = [];
$s->{mv_negate}             = [];
$s->{mv_numeric}            = [];
$s->{mv_orsearch}           = [];
$s->{mv_searchspec}          = [];
$s->{mv_search_group}       = [];
$s->{mv_search_field}       = [];
$s->{mv_search_file}        = $::Variable->{MV_DEFAULT_SEARCH_FILE}
                || ['products.asc'];
$s->{mv_searchspec}         = [];
$s->{mv_sort_option}        = [];
$s->{mv_substring_match}    = [];

my($dict_limit,$f,$key,$val);
my($searchfile, @searchfiles);
my(@specs);
my(@pats);

while (($key,$val) = each %options) {
  $s->{$key} = $val;
}

unless (@searchfiles = @{$s->{mv_search_file}}) {
  @searchfiles = @{$::Variable->{MV_DEFAULT_SEARCH_FILE}};
}
#::logDebug("searchfiles=@searchfiles");
for(@searchfiles) {
  $_ = Vend::Util::catfile($s->{mv_base_directory}, $_)

$s->{mv_negate}             = [];
$s->{mv_numeric}            = [];
$s->{mv_orsearch}           = [];
$s->{mv_searchspec}          = [];
$s->{mv_search_group}       = [];
$s->{mv_search_field}       = [];
$s->{mv_search_file}        = [];
$s->{mv_searchspec}         = [];
$s->{mv_sort_option}        = [];
$s->{mv_substring_match}    = [];
$s->{mv_field_file}         = $::Variable->{MV_DEFAULT_SEARCH_FILE}[0];
$s->{glimpse_cmd} = $Vend::Cfg->{Glimpse} || 'glimpse';

for(keys %$options) {
  $s->{$_} = $options->{$_};

mv_min_string           => 1,
verbatim_columns        => 1,
);

sub init {
my ($s, $options) = @_;

# autovivify references of nested data structures we use below, since they
# don't yet exist at daemon startup time before configuration is done
$Vend::Cfg->{ProductFiles}[0] or 1;
$::Variable->{MV_DEFAULT_SEARCH_TABLE} or 1;

@{$s}{keys %Default} = (values %Default);
$s->{mv_all_chars}          = [1];

### that we will use if no base=table param is specified
$s->{mv_base_directory}     = $Vend::Cfg->{ProductFiles}[0];
$s->{mv_begin_string}       = [];
$s->{mv_case}               = [];
$s->{mv_column_op}          = [];
$s->{mv_negate}             = [];
$s->{mv_numeric}            = [];
$s->{mv_orsearch}           = [];
$s->{mv_search_field}       = [];
$s->{mv_search_file}        =  [ @{
                  $::Variable->{MV_DEFAULT_SEARCH_TABLE}
                  ||  $Vend::Cfg->{ProductFiles}
                  } ];
$s->{mv_search_group}       = [];
$s->{mv_searchspec}         = [];

mv_min_string           => 1,
verbatim_columns        => 1,
);

sub init {
my ($s, $options) = @_;

# autovivify references of nested data structures we use below, since they
# don't yet exist at daemon startup time before configuration is done
$Vend::Cfg->{ProductFiles}[0] or 1;
$::Variable->{MV_DEFAULT_SEARCH_TABLE} or 1;

@{$s}{keys %Default} = (values %Default);
$s->{mv_all_chars}          = [1];

$s->{mv_search_field}       = [];
$s->{mv_search_group}       = [];
$s->{mv_searchspec}         = [];
$s->{mv_sort_option}        = [];
$s->{mv_substring_match}    = [];

for(keys %$options) {
  $s->{$_} = $options->{$_};
}
$s->{mv_search_file}        =  [ @{
                  $::Variable->{MV_DEFAULT_SEARCH_TABLE}
                  ||  $Vend::Cfg->{ProductFiles}
                  } ]
  unless ref($s->{mv_search_file}) and scalar(@{$s->{mv_search_file}});

my %menu_default_img = (
  clear  => 'bg.gif',
  closed => 'fc.gif',
  open   => 'fo.gif',
);

sub dhtml_browser {
my $regex;
eval {
  $regex = $::Variable->{MV_DHTML_BROWSER}
    and $regex = qr/$regex/;
};
$regex ||= qr/MSIE [5-9].*Windows|Mozilla.*Gecko|Opera.*[7-9]/;
return $Vend::Session->{browser} =~ $regex;

    unlink $Global::PIDfile;
            exit 0;
        }
    }
}
}

# Set the process name ($0) according to MV_DOLLAR_ZERO and a status indicator.
sub set_process_name {
my $status = shift;
my $base = $Global::Variable->{MV_DOLLAR_ZERO};

# Setting MV_DOLLAR_ZERO to 1 should do the same thing as not setting it for
# backwards compatibility.
$base = 'interchange' if !$base or $base eq '1';

# Data (msg body), encoding and type
($data, $encoding, $type, $charset) = (
  delete $opt->{data},
  delete $opt->{encoding},
  delete $opt->{type},
  delete $opt->{charset},
);
$data     ||= $opt->{body} || $body;    delete $opt->{body};
$encoding ||= 'quoted-printable';
$type     ||= 'text/plain';
$charset  ||= $::Variable->{MV_EMAIL_CHARSET} || $Global::Variable->{MV_EMAIL_CHARSET};

if ($charset) {
  $type .= "; charset=$charset";
}

UserTag email-raw Version     $Revision: 1.8 $
UserTag email-raw Routine     <<EOR
sub {
my($opt, $body) = @_;
my($ok);
$body =~ s/^\s+//;

# If configured, intercept all outgoing email and re-route
if (
my $intercept = $::Variable->{MV_EMAIL_INTERCEPT}
                || $Global::Variable->{MV_EMAIL_INTERCEPT}
) {
$body =~ s/\A(.*?)\r?\n\r?\n//s;
my $header_block = $1;
  # unfold valid RFC 2822 "2.2.3. Long Header Fields"

  }
  elsif($_) {
    push @extra_headers, $_;
  }
}
}

# If configured, intercept all outgoing email and re-route
if (
my $intercept = $::Variable->{MV_EMAIL_INTERCEPT}
                || $Global::Variable->{MV_EMAIL_INTERCEPT}
) {
my @info_headers;
$to = "To: $to";
  for ($to, @extra_headers) {

  ::logError("Header injection attempted in tag_mime_lite_email: %s", $1);
  return;
};
}

#
# Support e-mail interception (re-writing to/cc/bcc to specified
# address(es)).
#
$intercept ||= $::Variable->{MV_EMAIL_INTERCEPT} ||
$Global::Variable->{MV_EMAIL_INTERCEPT};

if ( $intercept && $Have_MIME_Lite) {
for my $field (qw/to cc bcc/) {
    if ( $opt->{$field} ) {

  }
  elsif($_) {
    push @extra_headers, $_;
  }
}
}

# If configured, intercept all outgoing email and re-route
if (
my $intercept = $::Variable->{MV_EMAIL_INTERCEPT}
                || $Global::Variable->{MV_EMAIL_INTERCEPT}
) {
my @info_headers;
$to = "To: $to";
  for ($to, @extra_headers) {

  unless $opt->{std_label} || $text || $opt->{show_error};
$err = filter_value($opt->{filter}, $err)
  if $opt->{filter};
if($opt->{std_label}) {
  # store the error label in user's session for later
  # possible use in [error show_label=1] calls
  $Vend::Session->{errorlabels}{$var} = $opt->{std_label};
  if($text) {
    # do nothing
  }
  elsif(defined $::Variable->{MV_ERROR_STD_LABEL}) {
    $text = $::Variable->{MV_ERROR_STD_LABEL};
  }
  else {
    my $contrast = $::Variable->{CSS_CONTRAST} || 'mv_contrast';

<span class="$contrast">{LABEL} <small><i>(%s)</i></small></span>
[else]{REQUIRED <b>}{LABEL}{REQUIRED </b>}[/else]
EOF
  }
  $text =~ s/{LABEL}/$opt->{std_label}/g;
  $text =~ s/{REQUIRED\s+([^}]*)}/$opt->{required} ? $1 : ''/ge;
  $err =~ s/\s+$//;
}
$text = '' unless defined $text;
$text .= '%s' unless ($text =~ /\%s/ ||
                              length $::Variable->{MV_ERROR_STD_LABEL});

$text = pull_else($text, $found_error);
$text =~ s/\%s/$err/;
return $text;

  }
}

if(! $file) {

  $contents = readfile_db($ifile);
  return undef unless defined $contents;
}
else {
  return undef unless open(READIN, "< $file");
  $Global::Variable->{MV_FILE} = $file;

  binmode(READIN) if $Global::Windows;

      if ($encoding) {

# (at your option) any later version.  See the LICENSE file for details.
# 
# $Id: fortune.tag,v 1.7 2007-03-30 23:40:57 pajamian Exp $

UserTag fortune Order   short
UserTag fortune addAttr
UserTag fortune Version $Revision: 1.7 $
UserTag fortune Routine <<EOR
sub {
my ($short, $opt) = @_;
my $cmd = $Global::Variable->{MV_FORTUNE_COMMAND} || '/usr/games/fortune';
my @flags;
push @flags, '-s' if is_yes($short);
for(grep length($_) == 1, keys %$opt) {
  push @flags, "-$_" if $opt->{$_};

return $pid;
}

sub run_server {
  my $next;
#::logDebug("trying to run server");

@$Global::SocketFile = "$Global::VendRoot/etc/socket"
  unless @$Global::SocketFile and $Global::SocketFile->[0];

if($Global::Variable->{MV_GETPPID_BROKEN}) {
#::logDebug("setting getppid broken");
  my $num = $Global::Variable->{MV_GETPPID_BROKEN} > 1
      ? $Global::Variable->{MV_GETPPID_BROKEN}
      : 64;

  or last SEND;
print MVMAIL Vend::Interpolate::do_tag('mime boundary') . '--'
if $use_mime;
print MVMAIL "\r\n\cZ" if $Global::Windows;
close MVMAIL or last SEND;
$ok = ($? == 0);
}

SMTP: {
my $mhost = $::Variable->{MV_SMTPHOST} || $Global::Variable->{MV_SMTPHOST};
my $helo =  $Global::Variable->{MV_HELO} || $::Variable->{SERVER_NAME};
last SMTP unless $none and $mhost;
eval {
require Net::SMTP;
  };

  or last SEND;
print MVMAIL Vend::Interpolate::do_tag('mime boundary') . '--'
if $use_mime;
print MVMAIL "\r\n\cZ" if $Global::Windows;
close MVMAIL or last SEND;
$ok = ($? == 0);
}

SMTP: {
my $mhost = $::Variable->{MV_SMTPHOST} || $Global::Variable->{MV_SMTPHOST};
my $helo =  $Global::Variable->{MV_HELO} || $::Variable->{SERVER_NAME};
last SMTP unless $none and $mhost;
eval {
require Net::SMTP;
  };

    $C->{ExternalExport} = external_cat($C->{ExternalExport});
    $Global::ExternalStructure->{Catalogs}{ $C->{CatalogName} }{external_config}
      = $C->{ExternalExport};
    Vend::Util::uneval_file($Global::ExternalStructure, $Global::ExternalFile);
    chmod 0644, $Global::ExternalFile;
  },
);

sub global_directive_postprocess {
if ($Global::UrlSepChar eq '&') {
  if ($Global::Variable->{MV_HTML4_COMPLIANT}) {
    $Global::UrlJoiner = '&';
    $Global::UrlSplittor = qr/\&|\&/;
  }
  else {

}

sub respond {
# $body is now a reference
my ($s, $body) = @_;
#show_times("begin response send") if $Global::ShowTimes;

# Safe kludge: duplicate Vend::CharSet::default_charset method here
# so that $Document->send() will work from within Safe
my $c = $Global::Selector{$CGI::script_name};
my $response_charset = $c->{Variable}{MV_HTTP_CHARSET} || $Global::Variable->{MV_HTTP_CHARSET};

my $status;
return if $Vend::Sent;
if($Vend::StatusLine) {

# this can/will come in handy.
sub mime_name {
  my $encoding_name = shift;

  $encoding_name =~ s/-strict//i;
  return lc $encoding_name;
}

sub default_charset {
my $c = $Global::Selector{$CGI::script_name};
return $c->{Variable}{MV_HTTP_CHARSET} || $Global::Variable->{MV_HTTP_CHARSET};
}

# this sub taken from the perluniintro man page, for diagnostic purposes
sub display_chars {

last SMTP if $@;
$ok = 0;
$using = "Net::SMTP (mail server $mhost)";
#::logDebug("using $using");
undef $none;

my $smtp = Net::SMTP->new($mhost, Debug => $Global::Variable->{DEBUG}, \
 \
 \
 Hello => $helo) or last SMTP;
#::logDebug("smtp object $smtp");

my $from = $::Variable->{MV_MAILFROM}
|| $Global::Variable->{MV_MAILFROM}
|| $Vend::Cfg->{MailOrderTo};

for(@extra_headers) {
  s/\s*$/\n/;

# TO
if (!( $opt->{to} and @{ $opt->{to} } )) {
::logError('mime_lite_email called without the required to= option.');
return;
}

# FROM
if (! $opt->{from} ) {
$opt->{from} =
  $::Variable->{MV_MAILFROM}       ||
  $Global::Variable->{MV_MAILFROM} ||
  $Vend::Cfg->{MailOrderTo};
}
$opt->{from} or do {
  ::logError('Cannot find value for From: header. Make sure ' .

last SMTP if $@;
$ok = 0;
$using = "Net::SMTP (mail server $mhost)";
#::logDebug("using $using");
undef $none;

my $smtp = Net::SMTP->new($mhost, Debug => $Global::Variable->{DEBUG}, Hello => $helo);
#::logDebug("smtp object $smtp");

my $from = $::Variable->{MV_MAILFROM}
|| $Global::Variable->{MV_MAILFROM}
|| $Vend::Cfg->{MailOrderTo};

for(@extra_headers) {
  s/\s*$/\n/;

  $opt->{toggle_anchor_clear} = Vend::Tags->image( {
          src => $opt->{img_clear} || $menu_default_img{clear},
          getsize => 0,
          border => 0,
          extra => $opt->{img_clear_extra},
          });
#::logDebug("toggle_anchor_clear=$opt->{toggle_anchor_clear}");
}

if($opt->{use_file}) {
  $opt->{file} = $::Variable->{MV_MENU_DIRECTORY} || 'include/menus';
  if(! $opt->{name}) {
    logError("No file or name specified for menu.");
  }
  my $nm = escape_chars($opt->{name});

    $opt->{img_clear_extra} ||= qq{height="1" width="$1"};
  }
  $opt->{toggle_anchor_clear} = Vend::Tags->image( {
          src => $opt->{img_clear} || $menu_default_img{clear},
          getsize => 0,
          border => 0,
          extra => $opt->{img_clear_extra},
          });
}
if($opt->{use_file}) {
  $opt->{file} = $::Variable->{MV_MENU_DIRECTORY} || 'include/menus';
  if(! $opt->{name}) {
    logError("No file or name specified for menu.");
  }
  my $nm = escape_chars($opt->{name});

  }

  return old_flyout($name,$opt,$template) unless $opt->{dhtml_browser};
  return dhtml_flyout($name,$opt,$template);
}
elsif($opt->{menu_type} eq 'simple') {
  if($opt->{search} || $opt->{list}) {
    ## Do nothing
  }
  elsif(! $opt->{file}) {
    $opt->{file} = $::Variable->{MV_MENU_DIRECTORY} || 'include/menus';
    if(! $opt->{name}) {
      logError("No file or name specified for menu.");
    }
    my $nm = escape_chars($opt->{name});

PASSWORD    => $options{password}  || $CGI::values{mv_password} || '',
VERIFY    => $options{verify}    || $CGI::values{mv_verify}   || '',
NICKNAME     => $options{nickname}  || '',
PROFILE     => $options{profile}  || '',
LAST       => '',
USERMINLEN  => $options{userminlen}  || 2,
PASSMINLEN  => $options{passminlen}  || 4,
VALIDCHARS  => $options{validchars} ? ('[' . $options{validchars} \
 . ']') : $USERNAME_GOOD_CHARS,
CRYPT      => defined $options{'crypt'}
        ? $options{'crypt'}
        : ! $::Variable->{MV_NO_CRYPT},
CGI      =>  ( defined $options{cgi} ? is_yes($options{cgi}) : 1),
PRESENT    =>  { },
DB_ID    =>  $options{database} || 'userdb',
OPTIONS    =>  \%options,

          ":",
          MIME::Base64::decode_base64($auth),
          2,
          );
my $cmp_pw;
my $use_crypt = 1;
if(  $user eq $Vend::Cfg->{RemoteUser}  and
    $Vend::Cfg->{Password}          )
{
  $cmp_pw = $Vend::Cfg->{Password};
  undef $use_crypt if $::Variable->{MV_NO_CRYPT};
}
else {
  $pwinfo = $Vend::Cfg->{UserDatabase} unless $pwinfo;
  undef $use_crypt if $::Variable->{MV_NO_CRYPT};

my $cmp_pw;
my $use_crypt = 1;
if(  $user eq $Vend::Cfg->{RemoteUser}  and
  $Vend::Cfg->{Password}          )
{
$cmp_pw = $Vend::Cfg->{Password};
undef $use_crypt if $::Variable->{MV_NO_CRYPT};
}
else {
$pwinfo = $Vend::Cfg->{UserDatabase} unless $pwinfo;
undef $use_crypt if $::Variable->{MV_NO_CRYPT};
  $cmp_pw = Vend::Interpolate::tag_data($pwinfo, 'password', $user)
    if defined $Vend::Cfg->{Database}{$pwinfo};
}

$item_text = $opt->{text} || '';
}
else {
$item_text = $opt;
$opt = {};
}

#  return create_onfly() if $opt->{create};

my $joiner    = $::Variable->{MV_ONFLY_JOINER} || '|';
my $split_fields= $::Variable->{MV_ONFLY_FIELDS} || undef;

$item_text =~ s/\s+$//;
$item_text =~ s/^\s+//;
my @parms;

if (ref $opt) {
  $item_text = $opt->{text} || '';
}
else {
  $item_text = $opt;
  $opt = {};
}

#  return create_onfly() if $opt->{create};

my $joiner    = $::Variable->{MV_ONFLY_JOINER} || '|';
my $split_fields= $::Variable->{MV_ONFLY_FIELDS} || undef;

$item_text =~ s/\s+$//;
$item_text =~ s/^\s+//;

        };
    $item->{$attrib} = tag_data($tab, $field, $sku);
  }
  $module = $item->{$attrib} || '';
}
else {
  ## Old style options
  my $loc = $Vend::Cfg->{Options_repository}{Old48} || {};
  my $table = $opt->{table}
        ||= (
            $loc->{table} || $::Variable->{MV_OPTION_TABLE} || 'options'
        );
  my $db = $Vend::Interpolate::Db{$table} || database_exists_ref($table)
      or return;
  $db->record_exists($sku)

$loc ||= $Vend::Cfg->{Options_repository}{Simple} || {};
my $map = $loc->{map} || {};

my $sku = $item->{code};

my $db;
my $tab;
if(not $db = $opt->{options_db}) {
  $tab = $opt->{table} ||= $loc->{table} 
             ||= $::Variable->{MV_OPTION_TABLE}
             ||= 'options';
  $db = database_exists_ref($tab)
    or do {
      logOnce(

sub display_options_matrix {
my ($item, $opt, $loc) = @_;

$loc ||= $Vend::Cfg->{Options_repository}{Old48} || \%Default;
#::logDebug("Matrix options by module, old");
my $sku = $item->{mv_sku} || $item->{code};
my $db;
my $tab;

if(not $db = $opt->{options_db}) {
  $tab = $opt->{table} || $::Variable->{MV_OPTION_TABLE} || 'options';
  $db = database_exists_ref($tab)
    or do {
      logOnce(
          "Matrix options: unable to find table %s for item %s",

my ($item, $opt) = @_;
#::logDebug("Simple options, item=" . ::uneval($item) . "\nopt=" . ::uneval($opt));
my $map = $opt->{options_map} ||= {};
#::logDebug("Simple options by module, old");

my $sku = $item->{code};
my $db;
my $tab;
if(not $db = $opt->{options_db}) {
$tab = $opt->{table} ||= $::Variable->{MV_OPTION_TABLE_SIMPLE}
           ||= $::Variable->{MV_OPTION_TABLE}
           ||= 'options';
$db = database_exists_ref($tab)
  or do {
      logOnce(

  my @del;
  my ($k, $v);
  while (($k, $v) = each %opt_map) {
    next unless defined $record->{$v};
    $rec{$k} = $record->{$v};
    push @del, $v;
  }
  delete @{$record}{@del};
  @{$record}{keys %rec} = (values %rec);
}
elsif($::Variable->{MV_OPTION_TABLE_MAP}) {
  $opt_remap = $::Variable->{MV_OPTION_TABLE_MAP};
  $opt_remap =~ s/^\s+//;
  $opt_remap =~ s/\s+$//;
  map { m{(.*?)=(.*)} and $opt_map{$2} = $1} split /[\0,\s]+/, $opt_remap;

if(not $opt->{display_type} ||= $record->{display_type}) {
  $opt->{display_type} = $record->{o_matrix} == 2 ? 'separate' : 'single';
}

$opt->{display_type} = lc $opt->{display_type};

my $map;
if(not $map = $opt->{options_map}) {
  $map = $opt->{options_map} = {};
  if(my $remap = $opt->{remap} || $::Variable->{MV_OPTION_TABLE_MAP}) {
    remap_option_record($record, $map, $remap);
  }
}

sub display_options_simple {
my ($item, $opt) = @_;
#::logDebug("Simple options, item=" . ::uneval($item) . "\nopt=" . ::uneval($opt));
my $map = $opt->{options_map} ||= {};
#::logDebug("Simple options by module, old");

my $sku = $item->{code};
my $db;
my $tab;
if(not $db = $opt->{options_db}) {
  $tab = $opt->{table} ||= $::Variable->{MV_OPTION_TABLE_SIMPLE}
             ||= $::Variable->{MV_OPTION_TABLE}
             ||= 'options';
  $db = database_exists_ref($tab)
    or do {

=item regkey

PRI will supply you with both a test regkey and production regkey.  Enter \
 both of these numbers into the the variables above.  You do not \
 need your production regkey to test. 

=item refid

The PRI interface allows (requires) a field called REFID.  This field is \
 stored along with the transaction on the PRI server and allows your \
 to do quick searches for transactions if this number has meaning. \
  There are three possible values for the PRI_REFID_MODE variable. \
  1,2 or any other character or null.  

1.  A "1" in the pri_refid_mode instructs interchange to read the current
order number in $Variable->{MV_ORDER_COUNTER_FILE} or "etc/order.number",
increment it by one and use that. Do not use this mode if you have a \
 busy catalog.  PRI might reject orders as duplicates if two people \
 try to checkout at the same time.

2. A "2" in the pri_refid_mode instructs interchange to use the users
session_id as the value.  This is the recommended mode.

  $transtype = $type_map{$transtype};
}

if ( ! $amount ) {
  $amount = Vend::Interpolate::total_cost();
  $amount = Vend::Util::round_to_frac_digits($amount,$precision);
}

# figure out what refid should be
if ( $opt->{refid_mode} == 1 ) {
  my $cfn = $Variable->{MV_ORDER_COUNTER_FILE} || 'etc/order.number';
  $new_order_number = $Tag->file($cfn);
  $new_order_number =~ s/.*\n([A-Za-z0-9]+).*$/$1/s;
  ++$new_order_number;
  $refid = $new_order_number;

my $id = "";

if (! $opt->{no_imagedir} ) {
  $id = $opt->{imagedir} || $Vend::Cfg->{ImageDir};
  $id =~ s:/*$:/:;
}

$dir =~ s:/+$::;

if($opt->{relative}) {
  my @dirs = split m{/}, $Global::Variable->{MV_PAGE};
  pop @dirs;
  if(@dirs) {
    $id .= join "/", @dirs, '';
    $dir = join "/", $dir, @dirs;

# $Id: bar_button.tag,v 1.5 2007-03-30 23:40:56 pajamian Exp $

UserTag bar-button Order     page current
UserTag bar-button PosNumber 2
UserTag bar-button HasEndTag 1
UserTag bar-button Version   $Revision: 1.5 $
UserTag bar-button Routine   <<EOR
sub {
use strict;
my ($page, $current, $html) = @_;
$current = $Global::Variable->{MV_PAGE}
  if ! $current;
$html =~ s!\[selected\]((?s:.)*)\[/selected]!!i;
my $alt = $1;
return $html if $page ne $current;

EOF

my $lastlevel = 0;
my @uls;

my $Tag = new Vend::Tags;
my $row = shift;

$opt->{reply_page} ||= 'forum/reply';
$opt->{submit_page} ||= 'forum/submit';
$opt->{display_page} ||= $Global::Variable->{MV_PAGE};
$opt->{date_format} ||= '%B %e, %Y @%H:%M';
my $menu_row = sub {
  shift;
  my $row = shift;

# (at your option) any later version.  See the LICENSE file for details.
# 
# $Id: page_meta.tag,v 1.4 2007-03-30 23:40:57 pajamian Exp $

UserTag page-meta Order   page
UserTag page-meta addAttr
UserTag page-meta Version $Revision: 1.4 $
UserTag page-meta Routine <<EOR
sub {
my ($page, $opt) = @_;
$page ||= $Global::Variable->{MV_PAGE};
$page = "pages/$page";
my $meta = Vend::Table::Editor::meta_record($page)
  or return;
while (my ($k, $v) = each %$meta) {

  if($opt->{stack} or $CGI::values{ui_return_stack}) {
    $type = 'formlink';
  }
  else {
    $type = 'done';
    $out .= "ui_return_to=\n";
  }
}

if($type eq 'formlink') {
  $page = $Global::Variable->{MV_PAGE} if ! $page;
  $out .= qq{ui_return_to=$page\n};
  for(@args) {
    tr/\n/\r/;
    $out .= qq{ui_return_to=$_\n}

if($type eq 'formlink') {
$page = $Global::Variable->{MV_PAGE} if ! $page;
$out .= qq{ui_return_to=$page\n};
for(@args) {
  tr/\n/\r/;
  $out .= qq{ui_return_to=$_\n}
  }
}
elsif($type eq 'url') {
  $page = $Global::Variable->{MV_PAGE} if ! $page;
  $out .= $Tag->area( {
              href => $page,
              form => join("\n", @args),
            });

}
}
elsif($type eq 'url') {
$page = $Global::Variable->{MV_PAGE} if ! $page;
$out .= $Tag->area( {
            href => $page,
            form => join("\n", @args),
          });
}
elsif ($type eq 'form') {
  $page = $Global::Variable->{MV_PAGE} if ! $page;
  $out .= qq{<INPUT TYPE=hidden NAME=ui_return_to VALUE="$page">\n};
  for(@args) {
    s/"/&quot;/g;
    $out .= qq{<INPUT TYPE=hidden NAME=ui_return_to VALUE="$_">\n}

}
elsif ($type eq 'form') {
$page = $Global::Variable->{MV_PAGE} if ! $page;
$out .= qq{<INPUT TYPE=hidden NAME=ui_return_to VALUE="$page">\n};
for(@args) {
  s/"/&quot;/g;
  $out .= qq{<INPUT TYPE=hidden NAME=ui_return_to VALUE="$_">\n}
  }
}
elsif ($type eq 'regen') {
  $page = $Global::Variable->{MV_PAGE} if ! $page;
  $out .= qq{<INPUT TYPE=hidden NAME=ui_return_to VALUE="ui_return_to=$page">\n};
  for(@args) {
    s/"/&quot;/g;
    $out .= qq{<INPUT TYPE=hidden NAME=ui_return_to VALUE="ui_return_to=$_">\n}

my ($file, $locale, $opt) = @_;
my $pn;
if($opt and $opt->{name}) {
  $pn = $opt->{name};
}
else {
  $pn = $file;
  $pn =~ s/\.\w+$//;
  $pn =~ s:^pages/::;
}
$Global::Variable->{MV_PAGE} = $pn;
$locale = 1 unless defined $locale;
return Vend::Interpolate::interpolate_html(
  Vend::Util::readfile($file, undef, $locale)
);

    $meta_anchor = 'M';
  }
}

$opt->{form_name} ||= "fs_$table";

$output{TOP_OF_TABLE} = <<EOF;
<table width="$opt->{table_width}" border="$opt->{table_border}" cellpadding="$opt->{table_padding}" \
 cellspacing="$opt->{table_spacing}" class="$opt->{table_class}">
EOF

my $cwp = $Global::Variable->{MV_PAGE};
$opt->{form_href} ||= $CGI->{ui_searchpage} || $cwp;
$opt->{form_extra} ||= '';
$opt->{form_extra} .= qq{ name="$opt->{form_name}"} if $opt->{form_name};
$opt->{form_extra} =~ s/^\s*/ /;

<td$td_extra>
<table align="left" class="$opt->{group_class}" cellspacing=$opt->{group_spacing} \
 cellpadding=$opt->{group_padding} width="$opt->{group_width}">
<tr>
EOF
unless($opt->{no_group} || $m->{fs_no_group}) {
  my $u = $Tag->area({
            href => 'admin/flex_group',
            form => qq(
                  mv_data_table=$table
                  ui_meta_view=$mview
                  from_page=$Global::Variable->{MV_PAGE}
                  mv_arg=$col
                ),
          });
  my $msg = errmsg('Select group by %s', $col);

    @files = grep $_ ne 'CVS', glob('*');
  }
  else {
    @files = split /\s+/, $dir_mask;
  }
}
else {
  @files = grep $_ !~ m{/CVS$}, glob("$curdir/*");
}

my $this_page = $Global::Variable->{MV_PAGE};
my $this = Vend::Interpolate::tag_area($this_page);
$this =~ s/\?(.*)//;

my $up_img = qq{<img src="up.gif" align=center border=0 height=22 width=20 title="upload ~FN~">};

  $opt->{table} = $field;
}

$table = $opt->{table} || $table;

my $acl;
my $check;
$status = 0, last CHECKIT if $func eq 'super';
if($check = $file_func{$func}) {
  $status = 1, last CHECKIT unless $record->{$check};
  my $file = $field || $Global::Variable->{MV_PAGE};
  # strip trailing slashes for checks on directories
  $file =~ s%/+$%%;                     
#::logDebug("check=$check file=$file record=$record->{$check} prefix=$opt->{prefix}");
  my @files =  UI::Primitive::list_glob($record->{$check}, $opt->{prefix});

  </td>
  <td class=cdata width=500> 
          $WIDGET$
  </td>
</tr>
<tr class=rspacer>
  <td colspan=2><img src="bg.gif" height=1 width=1></td>
EOF

 $opts{ui_wizard_fields} = join " ", @$name;
 $opts{mv_nextpage} = $Global::Variable->{MV_PAGE};
 $opts{mv_prevpage} = $Global::Variable->{MV_PAGE} if $current_page != 1;
 $opts{bottom_buttons} = 1;

#::logDebug("walking optref");

$session = $q->{mv_cache_key};
my $first = $q->{mv_first_match} || 0;
$chunk = $q->{mv_matchlimit};
$perm = $q->{mv_more_permanent} ? ':1' : '';
$total = $q->{matches};
my $next = defined $q->{mv_next_pointer}
      ? $q->{mv_next_pointer}
      : $first + $chunk;
$page = $q->{mv_search_page} || $Global::Variable->{MV_PAGE};
$prefix = $q->{prefix} || '';
my $form_arg = "mv_more_ip=1\nmv_nextpage=$page";
$form_arg .= "\npf=$q->{prefix}" if $q->{prefix};
$form_arg .= "\n$opt->{form}" if $opt->{form};

  return $page;
}

sub tag_loop_list {
my ($list, $opt, $text) = @_;

my $fn;
my @rows;

$opt->{prefix} ||= 'loop';
$opt->{label}  ||= "loop" . ++$::Instance->{List_it} . $Global::Variable->{MV_PAGE};

#::logDebug("list is: " . uneval($list) );

## Thanks to Kaare Rasmussen for this suggestion

my $secs;
CHECKDIR: {
  last CHECKDIR if Vend::File::file_name_is_absolute($file);
  last CHECKDIR if $file and $file !~ m:/:;
  my $dir;
  if ($file) {
    $dir = '.';
  }
  else {
    $dir = 'timed';
    $file = $saved_file || $Vend::Flypart || $Global::Variable->{MV_PAGE};
#::logDebug("static=$file");
    if($saved_file) {
      $file = $saved_file;
      $file =~ s:^scan/::;

$dir = 'timed';
$file = $saved_file || $Vend::Flypart || $Global::Variable->{MV_PAGE};
#::logDebug("static=$file");
if($saved_file) {
  $file = $saved_file;
  $file =~ s:^scan/::;
    $file = generate_key($file);
    $file = "scan/$file";
  }
  else {
    $saved_file = $file = ($Vend::Flypart || $Global::Variable->{MV_PAGE});
  }
  $file .= $Vend::Cfg->{HTMLsuffix};
}
$dir .= "/$1" 

$opt->{extra} = " $opt->{extra}" if $opt->{extra};

my $template = $opt->{template} || <<EOF;
<a href="{URL}"{EXTRA}>{SELECTED <b>}{LABEL}{SELECTED </b>}</a>
EOF

my $o_template = $opt->{o_template} || <<EOF;
<b>{TVALUE}</b>
EOF

my $href = $opt->{href} || $Global::Variable->{MV_PAGE};
$opt->{form} = "mv_action=return" unless $opt->{form};

my $no_encode = $opt->{pre_filter} eq 'decode_entities' ? 1 : 0;

my($fn, $contents, $gate, $pathdir, $dir, $level);
local($/);

if($file =~ m{[\[<]}) {
::logGlobal("Possible code/SQL injection attempt with file name '%s'", $file);
$file = escape_chars($file);
::logGlobal("Suspect file changed to '%s'", $file);
}

$Global::Variable->{MV_PREV_PAGE} = $Global::Variable->{MV_PAGE}
if defined $Global::Variable->{MV_PAGE};
$Global::Variable->{MV_PAGE} = $file;

$file =~ s#^\s+##;
$file =~ s#\s+$##;

or     ($Vend::Cookie and $::Scratch->{mv_no_session_id});
$ct = ++$Vend::Session->{pageCount}
unless $opt->{no_count};

if($opt->{no_session} or $::Pragma->{url_no_session_id}) {
undef $id;
undef $ct;
}

if($opt->{link_relative}) {
  my $cur = $Global::Variable->{MV_PAGE};
  $cur =~ s{/[^/]+$}{}
    and $path = "$cur/$path";
}

        /;

my @billing_ind = qw/
          b_address1
          b_city
        /;

if(my $str = $::Variable->{MV_PAYMENT_BILLING_SET}) {
@billing_set = grep $_ !~ /\W/, split /[\s,\0]+/, $str;
}
if(my $str = $::Variable->{MV_PAYMENT_BILLING_INDICATOR}) {
@billing_ind = grep $_ !~ /\W/, split /[\s,\0]+/, $str;
}

@billing_set{@billing_set} = @billing_set;

            b_state
            b_zip
            b_country
          /;

my @billing_ind = qw/
            b_address1
            b_city
          /;

if(my $str = $::Variable->{MV_PAYMENT_BILLING_SET}) {
  @billing_set = grep $_ !~ /\W/, split /[\s,\0]+/, $str;
}
if(my $str = $::Variable->{MV_PAYMENT_BILLING_INDICATOR}) {
  @billing_ind = grep $_ !~ /\W/, split /[\s,\0]+/, $str;

my $order_id = gen_order_id($opt);
if ($txtype =~ /RELEASE|VOID|ABORT/i) {
    $vendorTxCode = $::Values->{OrigVendorTxCode};
}
else {
    $vendorTxCode = $order_id;
}

# ISO currency code sent to Protx, from the page or fall back to config files.
my $currency = $::Values->{iso_currency_code} || $::Values->{currency_code} \
 || $Vend::Cfg->{Locale}{iso_currency_code}
    || charge_param('currency') || $::Variable->{MV_PAYMENT_CURRENCY} || 'GBP';

my $psp_host = $opt->{host};

# The string sent to Protx.

 $contactFax         =~ s/[^0-9-+ ]//gi;
my $giftAidPayment     = $::Values->{giftaidpayment} || charge_param('giftaidpayment') || '0';
my $authCode           = $::Values->{authcode} || '';
my $clientIPAddress    = $CGI::remote_addr if $CGI::remote_addr;
  $::Values->{authcode} = '';

::logDebug("SP".__LINE__.": bCity=$billingCity; mvccType=$cardType; start=$mvccStartDate; \
 \
 issue=$issue;");

# ISO currency code sent to SagePay, from the page or fall back to config files.
my $currency = $::Values->{iso_currency_code} || $::Values->{currency_code} \
 \
 || $Vend::Cfg->{Locale}{iso_currency_code} ||
         charge_param('currency') || $::Variable->{MV_PAYMENT_CURRENCY} || 'GBP';

my $psp_host = $opt->{host};
my $convertoffline = charge_param('convertoffline');

#::logDebug("PP".__LINE__.": sandbox=$::Values->{ppsandbox} ". charge_param \
('sandbox'). "req=".charge_param('pprequest'));
my $pprequest   = charge_param('pprequest') || $::Values->{'pprequest'} \
 || $in->{'pprequest'} || 'setrequest'; # 'setrequest' must be the default for standard Paypal. 
my $sandbox     = charge_param('sandbox') || $::Values->{'sandbox'}  \
|| $::Values->{'ppsandbox'} || ''; # 1 or true to use for testing
   $sandbox     = '' unless $sandbox =~ /sandbox|1/;
   $sandbox     = "sandbox." if $sandbox =~ /sandbox|1/;
   $::Values->{'ppsandbox'} = $::Values->{'sandbox'} = '';
   $::Scratch->{'mstatus'} = '';
#::logDebug("PP".__LINE__.": sandbox=$sandbox passwd=".charge_param('password')." \
 sig=".charge_param('signature'));

   $currency = $::Values->{'iso_currency_code'} || $::Values->{'currency_code'} \
 || $::Scratch->{'iso_currency_code'}  || 
         $Vend::Cfg->{'Locale'}{'iso_currency_code'} || charge_param \
('currency')  || $::Variable->{MV_PAYMENT_CURRENCY} || 'USD';
   $::Scratch->{'iso_currency_code'} ||= $currency;

# Credentials, prefixed with lower-cased account name if using 'getbalance' \
 for more than one account
my $account     = lc($pprequest) if $pprequest =~ /getbalance_/ || '';

::logGlobal("%s v0.7.3 payment module initialised, using %s", __PACKAGE__, \
 $selected) unless $Vend::Quiet;

}

package Vend::Payment;
use strict;
my ($gcourl,$merchantid,$merchantkey,$gcoserver,$xmlOut, $taxrate, $state, \
 $header, $gcorequest, $actual, $orderID);

sub googlecheckout {
my ($opt, $purchaseID, $mv_order_number, $msg, $cart, %result);
     $gcoserver   = charge_param('googlehost')  || $::Variable->{MV_PAYMENT_HOST} \
 || 'https://checkout.google.com/api/checkout/v2'; # live
my $catroot     = charge_param('cat_root') || $::Variable->{CAT_ROOT};
my $ordersdir   = charge_param('ordersdir') || 'orders';
my $currency    = $::Values->{currency} || charge_param('currency') || 'GBP';  
my $editbasketurl = charge_param('edit_basket_url') || $::Variable->{EDIT_BASKET_URL};

}
}
# wrap around everything to bottom
else {
my %actual = map_actual();
$actual  = \%actual;
$opt     = {};

#::logDebug("actual map result: " . ::uneval($actual));
$vendor   = $opt->{id} || charge_param('id') || $::Variable->{MV_PAYMENT_ID};
$opt->{host}   = charge_param('host') || $::Variable->{MV_PAYMENT_HOST} \
 \
 || 'ukvpstest.protx.com';
$opt->{use_wget} = charge_param('use_wget') || '1';
$opt->{port}   = '443';

    if ($txtype =~ /DEFERRED|PAYMENT|AUTHENTICATE|PREAUTH/i) {

my $deliveryState;

my %result;
my %query;

my (%actual) = map_actual();
$actual  = \%actual;
$opt     = {};

$vendor   = $opt->{id} || charge_param('id') || $::Variable->{MV_PAYMENT_ID};
$opt->{host} = charge_param('host') || $::Variable->{MV_PAYMENT_HOST} || 'live.sagepay.com';
$sagepayrequest = $opt->{sagepayrequest} = charge_param('sagepayrequest') || 'post';
$opt->{use_wget} = charge_param('use_wget') || '1';
$opt->{port}   = '443';
#::logDebug("SP".__LINE__.": host=$opt->{host}; spreq=$sagepayrequest");

my $diagnose     = $::Values->{gco_diagnose} || charge_param('gco_diagnose') \
 \
 \
 || ''; # set to '1' to have GCO return the XML it receives for diagnostics
my $analytics_data = $::Values->{analyticsdata} || '';
      $analytics_data = encode('UTF-8', $analytics_data);
my $tracking       = charge_param('tracking_script') || ''; 
my $without_address = charge_param('without_address') || ''; 
my $reporttitle = charge_param('reporttitle') || ''; 
my $dec_inventory = charge_param('decrement_inventory') || ''; # set \
 to 1 to decrement inventory upon successful 'charge'
my $alwaystaxshipping = charge_param('alwaystaxshipping') || ''; # set \
 to 1 to always tax shipping despite other config options

#----------------------------------------------------------------------------------------
     $merchantid  = charge_param('merchantid')  || $::Variable->{MV_PAYMENT_ID};
     $merchantkey = charge_param('merchantkey') || $::Variable->{MV_PAYMENT_SECRET};
     $gcorequest  = charge_param('gcorequest')  || $::Values->{gcorequest} || 'post';
   $::Values->{gcorequest} = '';
    

#::logDebug("echo called, args=" . ::uneval(\@_));

my (%actual) = map_actual();

my @errMsgs = ();
# Required for validation
if (! $user) {
$user      = $opt->{id} || 
             charge_param('id') ||  
             $::Variable->{ECHO_PAYMENT_ID} ||
             $::Variable->{MV_PAYMENT_ID} ||
              $::Variable->{CYBER_ID}
              or push @errMsgs, "No payment ID found.";
}

        return %result;
    }
}
# wrap around everything to bottom
else {
    my %actual = map_actual();
    $actual  = \%actual;
    $opt     = {};

#::logDebug("actual map result: " . ::uneval($actual));
    $vendor   = $opt->{id} || charge_param('id') || $::Variable->{MV_PAYMENT_ID};
    $opt->{host}   = charge_param('host') || $::Variable->{MV_PAYMENT_HOST} \
 || 'ukvpstest.protx.com';
    $opt->{use_wget} = charge_param('use_wget') || '1';
    $opt->{port}   = '443';

  my $billingState;
  my $deliveryState;

my %result;
my %query;

my (%actual) = map_actual();
  $actual  = \%actual;
  $opt     = {};

  $vendor   = $opt->{id} || charge_param('id') || $::Variable->{MV_PAYMENT_ID};
  $opt->{host} = charge_param('host') || $::Variable->{MV_PAYMENT_HOST} || 'live.sagepay.com';
  $sagepayrequest = $opt->{sagepayrequest} = charge_param('sagepayrequest') || 'post';
  $opt->{use_wget} = charge_param('use_wget') || '1';
  $opt->{port}   = '443';

elsif($oid =~ /\*$/) {
  Vend::Tags->error( {
          name => 'settle_transaction',
          set => "Order ID $oid already settled!",
        });
  return undef;
}
else {
#::logDebug("auth-code: $trec->{auth_code} oid=$oid");
  my $settled  = Vend::Tags->charge( {
            route => $::Variable->{MV_PAYMENT_MODE},
            order_id => $oid,
            amount => $amount,
            auth_code => $trec->{auth_code},
            transaction => 'settle_prior',

elsif($oid =~ /-$/) {
  Vend::Tags->error( {
          name => 'void_transaction',
          set => "Order ID $oid already voided!",
        });
  return undef;
}
else {
#::logDebug("auth-code: $trec->{auth_code} oid=$oid");
  my $voided  = Vend::Tags->charge( {
            route => $::Variable->{MV_PAYMENT_MODE},
            order_id => $oid,
            amount => $amount,
            auth_code => $trec->{auth_code},
            transaction => 'void',

In etc/log_transction, immediately after the
[elsif variable MV_PAYMENT_MODE]
[calc]
insert this line:
undef $Session->{payment_result}{MStatus};

and leave
[elsif variable MV_PAYMENT_MODE]
as set (contrary to earlier revisions of this document), but within the \
 same section change the following 
two instances of
[var MV_PAYMENT_MODE] to [value mv_payment_route]

Also add these five lines to the end of the section that starts "[import table=transactions ":
lead_source: [data session source]
referring_url: [data session referer]

8. When running a card through 3DSecure, the route is run twice: firstly \
 to Sagepay who check whether or
not the card is part of 3DSecure - if it is they send the customer to the bank's authentication page
and upon returning from that the route must be run a second time to send \
 the authentication results to
Sagepay. The second run is initiated from the 'ord/tdsreturn' page, not \
 from etc/log_transaction as it normally
would be. To handle this change to the normal system flow you need to alter \
 log_transaction to make the 
call to the payment module conditional,ie, wrap the following code around \
 the "[charge route...]" call 
found in ln 172 (or nearby):
[if scratchd mstatus eq success]
[tmp name="charge_succeed"][scratch order_id][/tmp]
[else]
[tmp name="charge_succeed"][charge route="[var MV_PAYMENT_MODE]" amount="[scratch \
 tmp_remaining]" order_id="[value mv_transaction_id]"][/tmp]
[/else]
[/if]
If the first call to Sagepay returns a request to send the customer to \
 the 3DSecure server, then IC will 
write a payment route error to the error log prior to sending the customer \
 there. This error stops the

[elsif variable MV_PAYMENT_MODE]
to
[elsif value mv_order_profile =~ /worldpay/] add an OR if required
eg [elsif value mv_order_profile =~ /googlecheckout|worldpay/]

Then in the [calc] block immediately below insert this line: 

undef $Session->{payment_result}{MStatus};

Within the same section change the following two instances of
[var MV_PAYMENT_MODE] to [value mv_payment_route]

10. Create a callback page in /pages called wpcallback.html or any name you prefer, set this page in
the Worldpay admin panel, the module also supports dynamic callback pages \
 where different catalogs can
have different callback pages, if using this the callpage URL must be set \
 in the route in catalog.cfg as

or

Route PRI id YourPRIID

or with only PRI as a payment provider

Variable MV_PAYMENT_ID      YourPRIID

A fully valid catalog.cfg entry to work with the standard demo would be:

Variable MV_PAYMENT_MODE    "__MV_PAYMENT_MODE__"
Route  PRI      id          "__PRI_ID__"
Route  PRI      regkey      "__PRI_REGKEY__"
Route  PRI      test_id     "__PRI_TEST_ID__"
Route  PRI      test_regkey "__PRI_TEST_REGKEY__"

In etc/log_transction, immediately after the 
[elsif variable MV_PAYMENT_MODE]
[calc]
insert this line: 
undef $Session->{payment_result}{MStatus};

and leave
[elsif variable MV_PAYMENT_MODE] 
as set (contrary to previous revisions of this document) but within the \
 same section change the following 
two instances of [var MV_PAYMENT_MODE] to [value mv_payment_route]. In \
 particular, the setting inside the
[charge route="..] line will specify which payment processor is used for \
 each particular case, and you
need to further modify this line so that it ends up like this:
[tmp name="charge_succeed"][charge route="[value mv_payment_route]" pprequest="dorequest" \
 amount="[scratch tmp_remaining]" order_id="[value mv_transaction_id]"][/tmp]
If the value of 'mv_payment_route' is set to 'paypalexpress', then this \
 is the one that is run. It is only

elsif ($ccnum =~ /^6(?:3(?:34[5-9][0-9])|767[0-9]{2})\d{10}(?:\d{2,3})?$/)
{ return 'solo' }

elsif ($ccnum =~ /^62[24-68]\d{13}$/)
{ return 'chinaunionpay' }

elsif ($ccnum =~ /^6(?:304|7(?:06|09|71))\d{12,15}$/)
{ return 'laser' }

else
{ return $::Variable->{MV_PAYMENT_OTHER_CARD} || 'other' }
}


# Takes a reference to a hash (usually %CGI::values) that contains

my $server     = $opt->{server} ||
     charge_param('server') ||
$::Variable->{ECHO_PAYMENT_SERVER} ||
$::Variable->{MV_PAYMENT_SERVER} ||
     $::Variable->{CYBER_SERVER} ||
     'https://wwws.echo-inc.com/scripts/INR200.EXE';

my $precision  =  $opt->{precision} ||
        charge_param('precision') ||
  $::Variable->{ECHO_PAYMENT_PRECISION} ||
  $::Variable->{MV_PAYMENT_PRECISION} ||
         $::Variable->{CYBER_PRECISION} ||
         2;

##### ECHO SPECIFIC VARIABLES #####

you not taking your customer's details, so you have the option of complying with Google or complying
with your own policy.

You must have MV_PAYMENT_MODE set in products/variable.txt to either your standard payment processor
or to 'googlecheckout'; though you may instead set this in catalog.cfg rather than variable txt as:
Variable MV_PAYMENT_MODE googlecheckout

Within the 'credit_card' section of etc/profiles.order leave
"MV_PAYMENT_MODE" 
as set and add
&set=psp __MV_PAYMENT_PSP__
&set=mv_payment_route authorizenet
(or your preferred gateway) as the last entries in the section.

and then add

&set=psp Paypal
&set=mv_payment_route paypalexpress
&final = yes
&setcheck = payment_method paypalexpress
__END__
or, if you want to use Paypal as a 'Buy now' button without taking any \
 customer details, then omit the
__COMMON_ORDER_PROFILE__ and the two 'email=...' lines above. 

Within the 'credit_card' section of etc/profiles.order leave "MV_PAYMENT_MODE" as set,
and add
&set=psp __MV_PAYMENT_PSP__
&set=mv_payment_route authorizenet
(or your preferred gateway instead of authorizenet) as the last entries in the section.
NB: if you are taking offline payments then do not set mv_payment_route \
 here, but instead set in the body
of the 'Buy now' button "mv_payment_route=offlinepayment

my $analytics_data = $::Values->{analyticsdata} || '';
    $analytics_data = encode('UTF-8', $analytics_data);
my $tracking       = charge_param('tracking_script') || ''; 
my $without_address = charge_param('without_address') || ''; 
my $reporttitle = charge_param('reporttitle') || ''; 
my $dec_inventory = charge_param('decrement_inventory') || ''; # set \ \

 to 1 to decrement inventory upon successful 'charge'
my $alwaystaxshipping = charge_param('alwaystaxshipping') || ''; # set \
 \
 to 1 to always tax shipping despite other config options

#----------------------------------------------------------------------------------------
   $merchantid  = charge_param('merchantid')  || $::Variable->{MV_PAYMENT_ID};
   $merchantkey = charge_param('merchantkey') || $::Variable->{MV_PAYMENT_SECRET};
   $gcorequest  = charge_param('gcorequest')  || $::Values->{gcorequest} || 'post';
 $::Values->{gcorequest} = '';
  
if ($gcorequest eq 'post') {

       $::Variable->{MV_PAYMENT_ID} ||
        $::Variable->{CYBER_ID}
        or push @errMsgs, "No payment ID found.";
}

# Required for validation
if (! $secret) {
$secret    = $opt->{secret} ||
             charge_param('secret') ||
         $::Variable->{ECHO_PAYMENT_SECRET} ||
         $::Variable->{MV_PAYMENT_SECRET} ||
             $::Variable->{CYBER_SECRET}
             or push @errMsgs, "No payment secret found.";
}

 for (@errMsgs) {
   ::logError($_);
 }
 return 0;
}
@errMsgs = ();

my $server     = $opt->{server} ||
                  charge_param('server') ||
           $::Variable->{ECHO_PAYMENT_SERVER} ||
           $::Variable->{MV_PAYMENT_SERVER} ||
                  $::Variable->{CYBER_SERVER} ||
                  'https://wwws.echo-inc.com/scripts/INR200.EXE';

 my $precision  =  $opt->{precision} ||

my ($vendor, $amount, $actual, $opt);

# Amount sent to Protx, in 2 decimal places with any cruft removed.
# Defaults to 'amount' from the Accounts IPM or an invoicing system, falling back to IC input
$amount =  $::Values->{amount} || Vend::Interpolate::total_cost();
$amount =~ s/^\D+//g;
$amount =~ s/,//g;
$amount =  sprintf '%.2f', $amount;

# Transaction type sent to Protx.
my $txtype = $::Values->{transtype} || charge_param('txtype') || $::Variable->{MV_PAYMENT_TRANSACTION} \
 || 'PAYMENT';
my $accountType = $::Values->{account_type} || charge_param('account_type') || 'E';
my $payID  = $::Values->{inv_no} || $::Session->{mv_transaction_id} || $::Session->{id}.$amount;

my $logdir;

my ($vendor, $amount, $actual, $opt, $sagepayrequest, $page, $vendorTxCode, $pan, $cardType);

# Amount sent to SagePay, in 2 decimal places with cruft removed.
# Defaults to 'amount' from log_transaction or an invoicing system, falling back to IC input
   $amount =  $::Values->{amount} || charge_param('amount') || Vend::Interpolate::total_cost();
   $amount =~ s/^\D*//g;
   $amount =~ s/\,//g;
   $amount =  sprintf '%.2f', $amount;

# Transaction type sent to SagePay.
my $txtype      = $::Values->{transtype} || charge_param('txtype') | \
| $::Variable->{MV_PAYMENT_TRANSACTION} ||'PAYMENT';
my $vpsprotocol = '2.23';
my $accountType = $::Values->{account_type} || charge_param('account_type') || 'E';
my $payID       = $::Values->{inv_no} || $::Session->{mv_transaction_id} \
 || $::Session->{id}.$amount;
my $logorder    = charge_param('logorder') || 'no'; # Set to 'yes' or \
 '1' to log basket plus data useful when arguing with SagePay over empty responses

  my($fn, $contents, $gate, $pathdir, $dir, $level);
  local($/);

if($file =~ m{[\[<]}) {
  ::logGlobal("Possible code/SQL injection attempt with file name '%s'", $file);
  $file = escape_chars($file);
  ::logGlobal("Suspect file changed to '%s'", $file);
}

$Global::Variable->{MV_PREV_PAGE} = $Global::Variable->{MV_PAGE}
  if defined $Global::Variable->{MV_PAGE};
$Global::Variable->{MV_PAGE} = $file;

$file =~ s#^\s+##;

defined $_[1] ? $_[1] : '';
}

sub _file_security {
my ($junk, $param, $passed) = @_;
$passed = [] unless $passed;
my(@files) = grep /\S/, split /\s*[,\0]\s*/, $param, -1;
for(@files) {
  my $ok = allowed_file($_);
  if(!$ok) {
    $ok = 1 if $_ eq $::Variable->{MV_SEARCH_FILE};
    $ok = 1 if $::Scratch->{$_};
  }
  if(/^\w+$/ and ! $::Variable->{MV_DEFAULT_SEARCH_DB}) {
    $_ = $Vend::Cfg->{Database}{$_}{file}