#!/usr/bin/perl
BEGIN {
$| = 1; # if you need it
use strict;
use warnings;
# Catch fatal errors.
$SIG{__DIE__} = \&print_header;
}
#my $Just_Exit = 0;
# It is highly recommended that you use version 6 upwards of
# the UserAgent module since it provides for tighter server
# certificate validation
use LWP::UserAgent 6;
my $query = '';
# read post from PayPal system and add 'cmd'
# maybe add security to limit CONTENT_LENGTH
read (STDIN, $query, $ENV{'CONTENT_LENGTH'});
$query = decode_it($query);
$query .= '&cmd=_notify-validate';
# post back to PayPal system to validate
my $ua = LWP::UserAgent->new(ssl_opts => { verify_hostname => 1 });
# https://www.paypal.com/cgi-bin/webscr
# https://www.sandbox.paypal.com/cgi-bin/webscr
my $req = HTTP::Request->new('POST', 'https://www.sandbox.paypal.com/c
+gi-bin/webscr');
$req->content_type('application/x-www-form-urlencoded');
$req->header(Host => 'www.paypal.com'); # www.sandbox.paypal.com ?
$req->content($query);
my $res = $ua->request($req);
# make the variable hash
my %variable =
map { split(m'='x, $_, 2) }
grep { m'='x }
split(m'&'x, $query);
# assign posted variables to local variables
my $item_name = $variable{'item_name'};
my $item_number = $variable{'item_number'};
my $payment_status = $variable{'payment_status'};
my $payment_amount = $variable{'mc_gross'};
my $payment_currency = $variable{'mc_currency'};
my $txn_id = $variable{'txn_id'};
my $receiver_email = $variable{'receiver_email'};
my $payer_email = $variable{'payer_email'};
if ($res->is_error) {
# HTTP error
}
elsif ($res->content eq 'VERIFIED') {
# check the $payment_status=Completed
# check that $txn_id has not been previously processed
# check that $receiver_email is your Primary PayPal email
# check that $payment_amount/$payment_currency are correct
# process payment
}
elsif ($res->content eq 'INVALID') {
# log for manual investigation
}
else {
# error
}
# end with header or will die with header
print_header('Good');
sub print_header {
my $error = shift || '';
# what you do here can die like logging. That can be detected with $Ju
+st_Exit
# so we know we have been here before and not to run the thing that di
+ed
# if ( $error ne 'Good' && ! $Just_Exit ) {
# $Just_Exit = 1;
# log($error);
# }
# error will be the die info with \n
print "Content-type: text/plain\n\n";
exit(0);
}
sub decode_it {
my $value = shift || '';
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
return $value;
}
|