saint/discourse-legacysite-perl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

First pass at adding key files

Browse Source
This commit is contained in:
dsainty
2024-06-17 21:49:12 +10:00
commit aa25e9347f
1274 changed files with 392549 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

165
site/slowtwitch.com/cgi-bin/articles/admin/Links/Payment/Direct/AuthorizeDotNet.pm Normal file
View File

@@ -0,0 +1,165 @@
# ==================================================================
# Gossamer Links - enhanced directory management system
#
# Website : http://gossamer-threads.com/
# Support : http://gossamer-threads.com/scripts/support/
# CVS Info : 087,071,086,086,085
# Revision : $Id: AuthorizeDotNet.pm,v 1.3 2005/03/05 01:29:09 brewt Exp $
#
# Copyright (c) 2003 Gossamer Threads Inc. All Rights Reserved.
# Redistribution in part or in whole strictly prohibited. Please
# see LICENSE file for full details.
# ==================================================================
#
# Glue between Gossamer Links and Authorize.Net payment interface
package Links::Payment::Direct::AuthorizeDotNet;
use strict;
# Make sure the payment module is available
use GT::Payment::Direct::AuthorizeDotNet;
use Links qw/$IN $CFG $DB/;
use vars qw/%INVALID %EMPTY/;
sub required {
# -----------------------------------------------------------------------------
# Returns a list of required field names. Each field name will be looked for
# in the language file, prefixed with 'PAYMENT_DIRECT_AuthorizeDotNet_', for
# the title of the field, and 'PAYMENT_DIRECT_DESC_AuthorizeDotNet_' for a
# description of the field's contents.
# Note that these are just required SETUP fields, so things like credit card
# number, billing name, etc. are NOT included.
return
account_username => { type => 'TEXT', valid => '^\w+$' }, # FIXME - I have no idea what this can be
account_key => { type => 'TEXT', valid => '^\w+$' };
}
sub optional {
# -----------------------------------------------------------------------------
my @currencies;
for (sort {
$a eq 'USD' ? -1 : $b eq 'USD' ? 1 : $a eq 'CAD' ? -1 : $b eq 'CAD' ? 1 :
$GT::Payment::Direct::AuthorizeDotNet::CURRENCY{$a} cmp
$GT::Payment::Direct::AuthorizeDotNet::CURRENCY{$b}
} keys %GT::Payment::Direct::AuthorizeDotNet::CURRENCY) {
push @currencies, $_ => $GT::Payment::Direct::AuthorizeDotNet::CURRENCY{$_};
}
return
currency => {
type => 'SELECT',
options => \@currencies
},
account_password => { type => 'TEXT', size => 40, valid => '.' }, # An optionally-required account password
confirmation_merchant => { type => 'TEXT', size => 40, valid => '.@.' }, # A merchant confirmation e-mail address
confirmation_confirm => { type => 'YESNO' }, # Whether or not to send a customer confirmation e-mail.
test_mode => { type => 'YESNO' }
}
sub payment_info {
# -----------------------------------------------------------------------------
# Returns a hash of various parameters used to figure out how to display the
# payment form for this payment method.
return {
no_cc_brand => 1,
fields => [
grep ! /^(?:account|capture|currency|test)/, keys %GT::Payment::Direct::AuthorizeDotNet::VALID
],
billing_phone_required => 1
}
}
sub verify {
# -----------------------------------------------------------------------------
# Checks that $IN, combined with the saved admin settings, makes up all of the
# required information. Returns 1 on success, or an array ref of invalid keys
# on failure.
_collect_data();
if (keys %INVALID or keys %EMPTY) {
my ($i, %order);
for (@{$GT::Payment::Direct::AuthorizeDotNet::REQUIRED{AUTHORIZE}}) { $order{$_} = $i++ }
return [ # Error
[sort { ($order{$a} || 0x7fff_ffff) <=> ($order{$b} || 0x7fff_ffff) } keys %INVALID],
[sort { ($order{$a} || 0x7fff_ffff) <=> ($order{$b} || 0x7fff_ffff) } keys %EMPTY]
];
}
else {
return 1; # Success
}
}
sub complete {
# -----------------------------------------------------------------------------
# Checks that $IN, combined with the saved admin settings, makes up all of the
# required information. Returns (1, $message) on success, (0, $reason) on
# declined, or (-1, $errormsg) on error.
my $pay = _collect_data() or return;
# Set the admin-specified fields
while (my ($k, $v) = each %{$CFG->{payment}->{direct}->{used}->{AuthorizeDotNet}}) {
$pay->$k($v) or return (-1, "Payment configuration error (Invalid $k)");
}
$pay->check('sale') or return (-1, $pay->error);
my $ret = $pay->sale;
if (not defined $ret) { # An error occured in the module
return (-1, $pay->error);
}
else { # The request at least got through to Authorize.Net
my $response = $pay->response;
if ($ret == 1) { # Approved!
my @receipt = @{$response->{receipt}};
my $receipt = "Transaction approved\n\n";
while (@receipt) {
my ($k, $v) = splice @receipt, 0, 2;
$receipt .= "$k: $v\n";
}
return (1, $response->{reason_text}, $receipt);
}
elsif ($ret == 0) { # Declined
return (0, $response->{reason_text});
}
else { # An error was generated by Authorize.Net
return (-1, $response->{reason_text});
}
}
}
sub _collect_data {
# -----------------------------------------------------------------------------
# Collect data from the payment data saved in the admin, and any valid columns
# in $IN. Anything from $IN is checked for validity, and $INVALID{column} is
# set if invalid.
%INVALID = %EMPTY = ();
return unless $CFG->{payment}->{direct}->{used}->{AuthorizeDotNet};
my %data = %{$CFG->{payment}->{direct}->{used}->{AuthorizeDotNet}};
my $pay = GT::Payment::Direct::AuthorizeDotNet->new();
my %required = map { $_ => 1 } @{$GT::Payment::Direct::AuthorizeDotNet::REQUIRED{AUTHORIZE}};
for my $field (keys %GT::Payment::Direct::AuthorizeDotNet::VALID) {
# The account_*, capture_*, currency_*, etc. fields should not be user-settable.
next if exists $data{$field} or $field =~ /^(?:account|capture|currency|test)/;
if (my $value = $IN->param($field)) {
if ($pay->$field($value)) {
$data{$field} = $value;
}
else {
$INVALID{$field}++;
$data{$field} = undef;
}
}
elsif ($required{$field}) {
$EMPTY{$field}++;
$data{$field} = undef;
}
}
$pay->billing_ip($ENV{REMOTE_ADDR}) if $ENV{REMOTE_ADDR} and $ENV{REMOTE_ADDR} ne '127.0.0.1';
return if keys %INVALID or keys %EMPTY;
return $pay;
}
1;

152
site/slowtwitch.com/cgi-bin/articles/admin/Links/Payment/Direct/Moneris.pm Normal file
View File

@@ -0,0 +1,152 @@
# ==================================================================
# Gossamer Links - enhanced directory management system
#
# Website : http://gossamer-threads.com/
# Support : http://gossamer-threads.com/scripts/support/
# CVS Info : 087,071,086,086,085
# Revision : $Id: Moneris.pm,v 1.2 2005/03/05 01:29:09 brewt Exp $
#
# Copyright (c) 2003 Gossamer Threads Inc. All Rights Reserved.
# Redistribution in part or in whole strictly prohibited. Please
# see LICENSE file for full details.
# ==================================================================
#
# Glue between Gossamer Links and Moneris payment interface
package Links::Payment::Direct::Moneris;
use strict;
# Make sure the payment module is available
use GT::Payment::Direct::Moneris 1.007; # CVS Versions < 1.7 were for the old, defunct Moneris payment system
use Links qw/$IN $CFG $DB/;
use vars qw/%INVALID %EMPTY/;
my @FIELDS = (
keys %GT::Payment::Direct::Moneris::NAME_MAP,
qw/ credit_card_number credit_card_expiry_month credit_card_expiry_year
billing_country billing_email charge_total/
);
sub required {
# -----------------------------------------------------------------------------
# Returns a list of required field names. Each field name will be looked for
# in the language file, prefixed with 'PAYMENT_DIRECT_Moneris_', for the title
# of the field, and 'PAYMENT_DIRECT_DESC_Moneris_' for a description of the
# field's contents.
# Note that these are just required SETUP fields, so things like credit card
# number, billing name, etc. are NOT included.
return
account_token => { type => 'TEXT', valid => '^\w+$' },
account_token2 => { type => 'TEXT', valid => '^\w+$' };
}
sub optional {
return
test_mode => { type => 'YESNO' }
}
sub payment_info {
# -----------------------------------------------------------------------------
# Returns a hash of various parameters used to figure out how to display the
# payment form for this payment method.
return {
fields => [
grep ! /^(?:account|capture|currency|test)/, @FIELDS
],
no_cc_brand => 1
};
}
sub verify {
# -----------------------------------------------------------------------------
# Checks that $IN, combined with the saved admin settings, makes up all of the
# required information. Returns 1 on success, or an array ref of invalid and
# empty keys array references (i.e. [\@invalid, \@empty]) on failure.
_collect_data();
if (keys %INVALID or keys %EMPTY) {
my ($i, %order);
for (@{$GT::Payment::Direct::Moneris::REQUIRED{AUTHORIZE}}) { $order{$_} = $i++ }
return [ # Error
[sort { ($order{$a} || 0x7fff_ffff) <=> ($order{$b} || 0x7fff_ffff) } keys %INVALID],
[sort { ($order{$a} || 0x7fff_ffff) <=> ($order{$b} || 0x7fff_ffff) } keys %EMPTY]
];
}
else {
return 1; # Success
}
}
sub complete {
# -----------------------------------------------------------------------------
# Checks that $IN, combined with the saved admin settings, makes up all of the
# required information. Returns (1, $message) on success, (0, $reason) on
# declined, or (-1, $errormsg) on error.
my $pay = _collect_data() or return;
# Set the admin-specified fields
while (my ($k, $v) = each %{$CFG->{payment}->{direct}->{used}->{Moneris}}) {
$pay->$k($v) or return (-1, "Payment configuration error (Invalid $k)");
}
$pay->check('sale') or return (-1, $pay->error);
my $ret = $pay->sale;
if (not defined $ret) { # An error occured in the module
return (-1, $pay->error);
}
else { # The request at least got through to Moneris
if ($ret == 1) { # Approved!
my $resp_text;
my @receipt = $pay->receipt();
my $receipt = "Transaction approved\n\n";
while (@receipt) {
my ($k, $v) = splice @receipt, 0, 2;
$receipt .= "$k: $v\n";
$resp_text = $v if $k eq 'Status';
}
return (1, $resp_text, $receipt);
}
elsif ($ret == 0) { # Declined
return (0, $pay->error);
}
else { # An error was generated by Moneris
return (-1, $pay->error);
}
}
}
sub _collect_data {
# -----------------------------------------------------------------------------
# Collect data from the payment data saved in the admin, and any valid columns
# in $IN. Anything from $IN is checked for validity, and $INVALID{column} is
# set if invalid.
%INVALID = %EMPTY = ();
return unless $CFG->{payment}->{direct}->{used}->{Moneris};
my %data = %{$CFG->{payment}->{direct}->{used}->{Moneris}};
return unless keys %data;
my $pay = GT::Payment::Direct::Moneris->new(debug_level => $CFG->{debug});
my %required = map { $_ => 1 } @{$GT::Payment::Direct::Moneris::REQUIRED{AUTHORIZE}};
for my $field (@FIELDS) {
# The account_*, capture_*, currency_*, etc. fields should not be user-settable.
next if exists $data{$field} or $field =~ /^(?:account|capture|currency|test)/;
if (my $value = $IN->param($field)) {
if ($pay->$field($value)) {
$data{$field} = $value;
}
else {
$INVALID{$field}++;
$data{$field} = undef;
}
}
elsif ($required{$field}) {
$EMPTY{$field}++;
$data{$field} = undef;
}
}
return if keys %INVALID or keys %EMPTY;
return $pay;
}
1;

122
site/slowtwitch.com/cgi-bin/articles/admin/Links/Payment/Remote/2CheckOut.pm Normal file
View File

@@ -0,0 +1,122 @@
# ==================================================================
# Gossamer Links - enhanced directory management system
#
# Website : http://gossamer-threads.com/
# Support : http://gossamer-threads.com/scripts/support/
# CVS Info : 087,071,086,086,085
# Revision : $Id: 2CheckOut.pm,v 1.13 2006/08/22 23:07:53 brewt Exp $
#
# Copyright (c) 2003 Gossamer Threads Inc. All Rights Reserved.
# Redistribution in part or in whole strictly prohibited. Please
# see LICENSE file for full details.
# ==================================================================
#
# Glue between Gossamer Links and 2CheckOut payment interface
package Links::Payment::Remote::2CheckOut;
use strict;
# Make sure the payment module is available
use GT::Payment::Remote::2CheckOut;
use Links qw/:objects/;
use Links::Payment qw/:status :log/;
use Links::SiteHTML;
use vars qw/%INVALID %EMPTY/;
sub required {
# -----------------------------------------------------------------------------
# Returns a list of required field names. Each field name will be looked for
# in the language file, prefixed with 'PAYMENT_REMOTE_2CheckOut_', for the
# title of the field, and 'PAYMENT_REMOTE_DESC_2CheckOut_' for a description of
# the field's contents.
# Note that these are just required SETUP fields, so things like credit card
# number, billing name, etc. are NOT included.
return
seller_id => { type => 'TEXT', valid => '^\d{1,10}$' },
secret_word => { type => 'TEXT', valid => '^(?!tango$).+$' };
}
sub optional {
# -----------------------------------------------------------------------------
return
demo => { type => 'YESNO' };
}
sub payment_info {
# -----------------------------------------------------------------------------
# Returns a hashref of payment hints
#
my @fields = qw/seller_id secret_word demo/;
my $ret = {
fields => \@fields
};
if (my $info = $CFG->{payment}->{remote}->{used}->{'2CheckOut'}) {
for (@fields) {
$ret->{$_} = $info->{$_};
}
}
return $ret;
}
sub verify {
# -----------------------------------------------------------------------------
# Checks that $IN, combined with the saved admin settings, makes up all of the
# required information. Returns 1 on success, or an array ref of invalid keys
# on failure. For Remote payment methods, this has no real effect.
return 1;
}
sub postback {
# -----------------------------------------------------------------------------
my $pay = $DB->table('Payments');
my $log = $DB->table('PaymentLogs');
my $unique = $IN->param('cart_order_id');
my $payment = $pay->select({ payments_id => $unique })->fetchrow_hashref
or return; # Whatever it is, we didn't create it.
GT::Payment::Remote::2CheckOut::process(
param => $IN,
sellerid => $CFG->{payment}->{remote}->{used}->{'2CheckOut'}->{seller_id},
password => $CFG->{payment}->{remote}->{used}->{'2CheckOut'}->{secret_word},
demo => $CFG->{payment}->{remote}->{used}->{'2CheckOut'}->{demo},
on_valid => sub {
return unless $IN->param('total') >= $payment->{payments_amount};
return if $payment->{payments_status} == COMPLETED;
my $cond = GT::SQL::Condition->new();
$cond->add(paylogs_payments_id => '=' => $unique);
$cond->add(paylogs_type => '=' => LOG_ACCEPTED);
$cond->add(paylogs_text => LIKE => "%\n2CheckOut order number: " . $IN->param('order_number') . "%\n");
my $found = $log->count($cond);
return if $found;
$pay->update(
{ payments_status => COMPLETED, payments_last => time },
{ payments_id => $payment->{payments_id} }
);
$log->insert({
paylogs_payments_id => $payment->{payments_id},
paylogs_type => LOG_ACCEPTED,
paylogs_time => time,
paylogs_text => (
sprintf(Links::language('PAYMENT_REMOTE_APPROVED') => '2CheckOut') . "\n" .
"2CheckOut order number: " . $IN->param('order_number') . "\n" .
"Amount: $payment->{payments_amount}\n"
)
});
Links::Payment::process_payment($payment->{payments_linkid}, $payment->{payments_term});
}
);
print $IN->header;
print Links::SiteHTML::display('payment_success');
1;
}
1;

70
site/slowtwitch.com/cgi-bin/articles/admin/Links/Payment/Remote/Manual.pm Normal file
View File

@@ -0,0 +1,70 @@
# ==================================================================
# Gossamer Links - enhanced directory management system
#
# Website : http://gossamer-threads.com/
# Support : http://gossamer-threads.com/scripts/support/
# CVS Info : 087,071,086,086,085
# Revision : $Id: Manual.pm,v 1.3 2005/03/05 01:46:06 brewt Exp $
#
# Copyright (c) 2003 Gossamer Threads Inc. All Rights Reserved.
# Redistribution in part or in whole strictly prohibited. Please
# see LICENSE file for full details.
# ==================================================================
#
# Glue between Gossamer Links and Manual payment interface
package Links::Payment::Remote::Manual;
use strict;
# Make sure the payment module is available
use Links qw/:objects/;
use Links::Payment qw/:status :log/;
use Links::SiteHTML;
use vars qw/%INVALID %EMPTY/;
sub required {
# -----------------------------------------------------------------------------
# No required parameters available
return;
}
sub optional {
# -----------------------------------------------------------------------------
# No optional parameters available.
return;
}
sub payment_info {
# -----------------------------------------------------------------------------
# Returns a hashref of payment hints
#
return;
}
sub insert_log {
# -----------------------------------------------------------------------------
#
my $unique = shift;
my $pay = $DB->table('Payments');
my $log = $DB->table('PaymentLogs');
my $payment = $pay->select({ payments_id => $unique })->fetchrow_hashref or return; # return if the payment doesn't exist.
return if $payment->{payments_status} == COMPLETED;
my $cond = GT::SQL::Condition->new(
paylogs_payments_id => '=' => $unique,
paylogs_type => '=' => LOG_ACCEPTED
);
my $found = $log->count($cond);
return if $found;
$log->insert({
paylogs_payments_id => $payment->{payments_id},
paylogs_type => LOG_MANUAL,
paylogs_time => time,
paylogs_text => (
"This payment will be manually approved by admin.\n" .
"Amount: $payment->{payments_amount}\n"
)
});
return;
}
1;

296
site/slowtwitch.com/cgi-bin/articles/admin/Links/Payment/Remote/PayPal.pm Normal file
View File

@@ -0,0 +1,296 @@
# ==================================================================
# Gossamer Links - enhanced directory management system
#
# Website : http://gossamer-threads.com/
# Support : http://gossamer-threads.com/scripts/support/
# CVS Info : 087,071,086,086,085
# Revision : $Id: PayPal.pm,v 1.16 2006/12/01 00:31:56 brewt Exp $
#
# Copyright (c) 2003 Gossamer Threads Inc. All Rights Reserved.
# Redistribution in part or in whole strictly prohibited. Please
# see LICENSE file for full details.
# ==================================================================
#
# Glue between Gossamer Links and PayPal IPN payment interface
package Links::Payment::Remote::PayPal;
use strict;
# Make sure the payment module is available
use GT::Payment::Remote::PayPal;
use Links qw/:objects/;
use Links::Payment qw/:status :log/;
use Links::SiteHTML;
use vars qw/%INVALID %EMPTY/;
sub required {
# -----------------------------------------------------------------------------
# Returns a list of required field names. Each field name will be looked for
# in the language hash, prefixed with 'PAYMENT_REMOTE_PayPal_', for the title
# of the field, and 'PAYMENT_REMOTE_DESC_PayPal_' for a description of the
# field's contents.
# Note that these are just required SETUP fields, so things like credit card
# number, billing name, etc. are NOT included.
my @currencies;
for (qw/USD CAD AUD EUR GBP JPY NZD CHF HKD SGD SEK DKK PLN NOK HUF CZK/) {
push @currencies, $_ => Links::language('PAYMENT_CURRENCY_' . $_);
}
my @buttons;
for (qw/23 cc 02 03 01 9 5 6/) {
push @buttons, "x-click-but$_.gif" => qq|<img src="https://www.paypal.com/images/x-click-but$_.gif">|;
}
my $custom = qq|Custom image:<br><input type="text" name="button_custom" size="60"|;
if ($CFG->{payment}->{remote}->{used}->{PayPal} and $CFG->{payment}->{remote}->{used}->{PayPal}->{button_custom}) {
$custom .= qq| value="$CFG->{payment}->{remote}->{used}->{PayPal}->{button_custom}"|;
}
$custom .= '>';
push @buttons, "custom" => $custom;
return
business_email => { type => 'TEXT', valid => '.@[a-zA-Z0-9-]' },
currency => {
type => 'SELECT',
options => \@currencies
},
button => {
type => 'RADIO',
options => \@buttons,
custom => 1,
valid => '^https?://[a-zA-Z0-9-]' # Only applies to the custom value
}
}
sub optional {
# -----------------------------------------------------------------------------
return
image_url => { type => 'TEXT', size => 60, value => '^https?://[a-zA-Z0-9-]' },
notify_url => { type => 'TEXT', size => '60', value => '^https?://[a-zA-Z0-9-]' },
note => { type => 'TEXT', size => 30, value => '^.{1,30}$' },
color => {
type => 'SELECT',
options => [
white => Links::language('PAYMENT_REMOTE_PayPal_color_white'),
black => Links::language('PAYMENT_REMOTE_PayPal_color_black')
]
},
to_email => { type => 'TEXT', valid => '.@[a-zA-Z0-9-]' },
sandbox => { type => 'YESNO' };
}
sub payment_info {
# -----------------------------------------------------------------------------
# Returns a hash of payment hints
#
my @fields = qw/business_email to_email currency button button_custom image_url notify_url note color sandbox/;
my $ret = {
fields => \@fields
};
if (my $pp = $CFG->{payment}->{remote}->{used}->{PayPal}) {
for (@fields) {
$ret->{$_ eq 'image_url' ? 'pp_image_url' : $_} = $pp->{$_};
}
}
return $ret;
}
sub verify {
# -----------------------------------------------------------------------------
# Checks that $IN, combined with the saved admin settings, makes up all of the
# required information. Returns 1 on success, or an array ref of invalid keys
# on failure.
return 1;
}
sub postback {
# -----------------------------------------------------------------------------
# Handle PayPal postback
my $unique = $IN->param('invoice');
my $pay = $DB->table('Payments');
my $log = $DB->table('PaymentLogs');
my $payment = $pay->get($unique) or return;
GT::Payment::Remote::PayPal::process(
param => $IN,
sandbox => $CFG->{payment}->{remote}->{used}->{PayPal}->{sandbox},
on_valid => sub {
# If taxes or shipping was added, then mc_gross may be greater than payments_amount.
if ($IN->param('mc_gross') < $payment->{payments_amount}) {
$log->insert({
paylogs_payments_id => $payment->{payments_id},
paylogs_type => LOG_ERROR,
paylogs_time => time,
paylogs_text => "Invalid payment (payment amount is less than original charge): " .
$IN->param('mc_gross') . " < " . $payment->{payments_amount}
});
return;
}
elsif ($IN->param('mc_currency') ne $CFG->{payment}->{remote}->{used}->{PayPal}->{currency}) {
$log->insert({
paylogs_payments_id => $payment->{payments_id},
paylogs_type => LOG_ERROR,
paylogs_time => time,
paylogs_text => "Invalid payment (different currency): " .
$IN->param('mc_currency') . " != " . $CFG->{payment}->{remote}->{used}->{PayPal}->{currency}
});
return;
}
return if $payment->{payments_status} == COMPLETED;
$pay->update(
{ payments_status => COMPLETED, payments_last => time },
{ payments_id => $payment->{payments_id} }
);
$log->insert({
paylogs_payments_id => $payment->{payments_id},
paylogs_type => LOG_ACCEPTED,
paylogs_time => time,
paylogs_text => (
sprintf(Links::language('PAYMENT_REMOTE_APPROVED') => 'PayPal') . "\n" .
"Transaction ID: " . $IN->param('txn_id') . "\n" .
"Amount: " . $IN->param('mc_currency') . " " . $IN->param('mc_gross') . " (Fee: "
. $IN->param('mc_currency') . " " . $IN->param('mc_fee') . ")\n" .
"Payer Email: " . $IN->param('payer_email') . "\n"
)
});
Links::Payment::process_payment($payment->{payments_linkid}, $payment->{payments_term});
},
on_pending => sub {
$pay->update({ payments_last => time }, { payments_id => $unique });
my $match = Links::language('PAYLOG_PayPal_' . $IN->param('pending_reason'));
my $str = $match ? Links::language('PAYLOG_PayPal_' . $IN->param('pending_reason')) : '';
$log->insert({
paylogs_payments_id => $payment->{payments_id},
paylogs_type => LOG_INFO,
paylogs_time => time,
paylogs_text => (
"Transaction ID: " . $IN->param('txn_id') . "\n" .
"Pending: " . ($match ? $str : scalar $IN->param('pending_reason'))
)
});
},
on_refund => sub {
$pay->update({ payments_last => time }, { payments_id => $unique });
$log->insert({
paylogs_payments_id => $payment->{payments_id},
paylogs_type => LOG_INFO,
paylogs_time => time,
paylogs_text => (
sprintf(Links::language('PAYMENT_REMOTE_REFUND') => 'PayPal') . "\n" .
"Transaction ID: " . $IN->param('txn_id') . "\n"
)
});
},
on_failed => sub {
$pay->update(
{ payments_status => DECLINED, payments_last => time },
{ payments_id => $payment->{payments_id} }
);
$log->insert({
paylogs_payments_id => $payment->{payments_id},
paylogs_type => LOG_DECLINED,
paylogs_time => time,
paylogs_text => "Transaction ID: " . $IN->param('txn_id')
});
},
on_denied => sub {
$pay->update(
{ payments_status => DECLINED, payments_last => time },
{ payments_id => $payment->{payments_id} }
);
$log->insert({
paylogs_payments_id => $payment->{payments_id},
paylogs_type => LOG_DECLINED,
paylogs_time => time,
paylogs_text => "Transaction ID: " . $IN->param('txn_id')
});
},
duplicate => sub {
my $id = $IN->param('txn_id');
my $cond = GT::SQL::Condition->new();
$cond->add(paylogs_payments_id => '=' => $unique);
$cond->add(paylogs_type => '=' => LOG_ACCEPTED);
$cond->add(paylogs_text => LIKE => "%\nTransaction ID: $id\n%");
my $found = $log->count($cond);
return $found ? undef : 1; # True if everything checks out; undef if a duplicate was found
},
email => sub {
my $email = shift;
return lc $email eq lc $CFG->{payment}->{remote}->{used}->{PayPal}->{business_email}
},
on_error => sub {
my $errmsg = shift;
$pay->update(
{ payments_status => ERROR, payments_last => time },
{ payments_id => $payment->{payments_id} }
);
$log->insert({
paylogs_payments_id => $payment->{payments_id},
paylogs_type => LOG_ERROR,
paylogs_time => time,
paylogs_text => $errmsg
});
},
on_recurring => sub {
if ($IN->param('mc_gross') < $payment->{payments_amount}) {
$log->insert({
paylogs_payments_id => $payment->{payments_id},
paylogs_type => LOG_ERROR,
paylogs_time => time,
paylogs_text => "Invalid payment (payment amount is less than original charge): " .
$IN->param('mc_gross') . " < " . $payment->{payments_amount}
});
return;
}
elsif ($IN->param('mc_currency') ne $CFG->{payment}->{remote}->{used}->{PayPal}->{currency}) {
$log->insert({
paylogs_payments_id => $payment->{payments_id},
paylogs_type => LOG_ERROR,
paylogs_time => time,
paylogs_text => "Invalid payment (different currency): " .
$IN->param('mc_currency') . " != " . $CFG->{payment}->{remote}->{used}->{PayPal}->{currency}
});
return;
}
$pay->update(
{ payments_status => COMPLETED, payments_last => time },
{ payments_id => $payment->{payments_id} }
);
$log->insert({
paylogs_payments_id => $payment->{payments_id},
paylogs_type => LOG_ACCEPTED,
paylogs_time => time,
paylogs_text => (
sprintf(Links::language('PAYMENT_REMOTE_APPROVED') => 'PayPal') . "\n" .
"Transaction ID: " . $IN->param('txn_id') . "\n" .
"Amount: " . $IN->param('mc_currency') . " " . $IN->param('mc_gross') . " (Fee: "
. $IN->param('mc_currency') . " " . $IN->param('mc_fee') . ")\n" .
"Payer Email: " . $IN->param('payer_email') . "\n" .
"Subscription ID: " . $IN->param('subscr_id') . "\n"
)
});
Links::Payment::process_payment($payment->{payments_linkid}, $payment->{payments_term}, 1);
}
);
# There is no way to distinguish between PayPal sending the user back, and
# PayPal posting the IPN, so we print a payment confirmation page.
print $IN->header;
print Links::SiteHTML::display('payment_success');
1;
}
1;

207
site/slowtwitch.com/cgi-bin/articles/admin/Links/Payment/Remote/WorldPay.pm Normal file
View File

@@ -0,0 +1,207 @@
# ==================================================================
# Gossamer Links - enhanced directory management system
#
# Website : http://gossamer-threads.com/
# Support : http://gossamer-threads.com/scripts/support/
# CVS Info : 087,071,086,086,085
# Revision : $Id: WorldPay.pm,v 1.13 2006/08/22 23:05:13 brewt Exp $
#
# Copyright (c) 2003 Gossamer Threads Inc. All Rights Reserved.
# Redistribution in part or in whole strictly prohibited. Please
# see LICENSE file for full details.
# ==================================================================
#
# Glue between Links and WorldPay payment interface
package Links::Payment::Remote::WorldPay;
use strict;
# Make sure the payment module is available
use GT::Payment::Remote::WorldPay;
use Links qw/:objects/;
use Links::Payment qw/:status :log/;
use Links::SiteHTML;
use vars qw/%INVALID %EMPTY/;
sub required {
# -----------------------------------------------------------------------------
# Returns a list of required field names. Each field name will be looked for
# in the language file, prefixed with 'PAYMENT_REMOTE_WorldPay_', for the title
# of the field, and 'PAYMENT_REMOTE_DESC_WorldPay_' for a description of the
# field's contents.
# Note that these are just required SETUP fields, so things like credit card
# number, billing name, etc. are NOT included.
my @currencies;
for (qw/USD CAD EUR GBP AFA ALL DZD AON ARS AWG AUD BSD BHD BDT BBD BZD BMD BOB BAD BWP BRL BND BGL XOF BIF KHR
XAF CVE KYD CLP CNY COP KMF CRC HRK CUP CYP CZK DKK DJF XCD DOP TPE ECS EGP SVC EEK ETB FKP FJD XPF GMD GHC
GIP GTQ GNF GWP GYD HTG HNL HKD HUF ISK INR IDR IRR IQD ILS JMD JPY JOD KZT KES KRW KPW KWD KGS LAK LVL LBP
LSL LRD LYD LTL MOP MKD MGF MWK MYR MVR MTL MRO MUR MXN MNT MAD MZM MMK NAD NPR ANG NZD NIO NGN NOK OMR PKR
PAB PGK PYG PEN PHP PLN QAR ROL RUR RWF WST STD SAR SCR SLL SGD SKK SIT SBD SOS ZAR LKR SHP SDP SRG SZL SEK
CHF SYP TWD TJR TZS THB TOP TTD TND TRL UGX UAH AED UYU VUV VEB VND YER YUM ZRN ZMK ZWD/) {
push @currencies, $_ => Links::language('PAYMENT_CURRENCY_' . $_);
}
return
installation_id => { type => 'TEXT', valid => '^\d{1,16}$' },
callback_password => { type => 'TEXT' },
md5_password => { type => 'TEXT' },
currency => {
type => 'SELECT',
options => \@currencies
}
}
sub optional {
# -----------------------------------------------------------------------------
return
test_mode => { type => 'SELECT', options => [100 => 'Test mode: Always approved', 101 => 'Test mode: Always declined'] }
}
sub payment_info {
# -----------------------------------------------------------------------------
# Returns a hashref of payment hints
#
my @fields = qw/currency installation_id md5_password test_mode/;
my $ret = {
fields => \@fields
};
if (my $pp = $CFG->{payment}->{remote}->{used}->{WorldPay}) {
for (@fields) {
$ret->{$_ eq 'image_url' ? 'pp_image_url' : $_} = $pp->{$_};
}
}
return $ret;
}
sub verify {
# -----------------------------------------------------------------------------
# Checks that $IN, combined with the saved admin settings, makes up all of the
# required information. Returns 1 on success, or an array ref of invalid keys
# on failure. For Remote payment methods, this has no real effect.
return 1;
}
sub postback {
# -----------------------------------------------------------------------------
my $pay = $DB->table('Payments');
my $log = $DB->table('PaymentLogs');
my $unique = $IN->param('cartId');
my $payment = $pay->select({ payments_id => $unique })->fetchrow_hashref
or return; # Whatever it is, we didn't create it.
my $end = 1; # Returned after processing - if true, a blank page will be displayed,
# if false, a worldpay receipt page.
GT::Payment::Remote::WorldPay::process(
param => $IN,
password => $CFG->{payment}->{remote}->{used}->{WorldPay}->{callback_password},
test_mode => $CFG->{payment}->{remote}->{used}->{WorldPay}->{test_mode},
on_valid => sub {
# A one-time payment (or the initial payment, in the case of recurring payments)
return unless $IN->param('amount') >= $payment->{payments_amount};
return if $payment->{payments_status} == COMPLETED;
$pay->update(
{ payments_status => COMPLETED, payments_last => time },
{ payments_id => $payment->{payments_id} }
);
$log->insert({
paylogs_payments_id => $payment->{payments_id},
paylogs_type => LOG_ACCEPTED,
paylogs_time => time,
paylogs_text => (
sprintf(Links::language('PAYMENT_REMOTE_APPROVED') => 'WorldPay') . "\n" .
"Transaction ID: " . $IN->param('transId') . "\n" .
"Amount: " . $IN->param('amountString') . " (" . $IN->param('authAmountString') . ")\n" .
($IN->param('futurePayId') ? "FuturePay ID: " . $IN->param('futurePayId') . "\n" : '') .
"Authorization Message: " . $IN->param('rawAuthMessage') . "\n"
)
});
Links::Payment::process_payment($payment->{payments_linkid}, $payment->{payments_term});
$end = 0;
},
on_cancel => sub {
# The user clicked "cancel payment"
$pay->update(
{ payments_status => DECLINED, payments_last => time },
{ payments_id => $payment->{payments_id} }
);
$log->insert({
paylogs_payments_id => $payment->{payments_id},
paylogs_type => LOG_DECLINED,
paylogs_time => time,
paylogs_text => (
sprintf(Links::language('PAYMENT_REMOTE_CANCELLED') => 'WorldPay') . "\n" .
"Amount: " . $IN->param('amountString') . " (" . $IN->param('authAmountString') . ")\n"
)
});
},
on_invalid_password => sub {
$pay->update(
{ payments_status => ERROR, payments_last => time },
{ payments_id => $payment->{payments_id} }
);
$log->insert({
paylogs_payments_id => $payment->{payments_id},
paylogs_type => LOG_ERROR,
paylogs_time => time,
paylogs_text => sprintf(Links::language('PAYMENT_REMOTE_INVALIDPW') => 'WorldPay') . "\n"
});
},
on_recurring => sub {
# A recurring payment, NOT counting the original payment
$pay->update(
{ payments_status => COMPLETED, payments_last => time },
{ payments_id => $payment->{payments_id} }
);
$log->insert({
paylogs_payments_id => $payment->{payments_id},
paylogs_type => LOG_ACCEPTED,
paylogs_time => time,
paylogs_text => (
sprintf(Links::language('PAYMENT_REMOTE_RECURRING_ACCEPTED') => 'WorldPay') . "\n" .
"Transaction ID: " . $IN->param('transId') . "\n" .
"Amount: " . $IN->param('amountString') . " (" . $IN->param('authAmountString') . ")\n" .
"FuturePay ID: " . $IN->param('futurePayId') . "\n" .
"Authorization Message: " . $IN->param('rawAuthMessage') . "\n"
)
});
# The "1" gives them an extra day for recurring payments.
Links::Payment::process_payment($payment->{payments_linkid}, $payment->{payments_term}, 1);
},
on_recurring_failed => sub {
$pay->update(
{ payments_status => DECLINED, payments_last => time },
{ payments_id => $payment->{payments_id} }
);
$log->insert({
paylogs_payments_id => $payment->{payments_id},
paylogs_type => LOG_DECLINED,
paylogs_time => time,
paylogs_text => (
sprintf(Links::language('PAYMENT_REMOTE_RECURRING_DECLINED') => 'WorldPay') . "\n" .
"Amount: " . $IN->param('amountString') . " (" . $IN->param('authAmountString') . ")\n"
)
});
}
);
print $IN->header;
unless ($end) {
print Links::SiteHTML::display('payment_success');
}
1;
}
1;