# ================================================================== # 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||; } my $custom = qq|Custom image:
{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;