First pass at adding key files
This commit is contained in:
		@@ -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;
 | 
			
		||||
@@ -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;
 | 
			
		||||
@@ -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;
 | 
			
		||||
@@ -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;
 | 
			
		||||
		Reference in New Issue
	
	Block a user