$req->content("\n\n");
my $res = $ua->request($req);
debug "First response: " $res;
$req->content($return_query);
$res = $ua->request($req);
debug "Second response: " . Dumper $res;
I think it should be like this.
my $return_query = request->body;
debug 'First response: ' request;
# a way to see if you need to decode is check the param payment_date
# if it has % and + its encoded.
$return_query =~ tr/+/ /;
$return_query =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$return_query = 'cmd=_notify-validate&' . $return_query;
# post back to PayPal system to validate
my $ua = LWP::UserAgent->new( ssl_opts => { verify_hostname => 1 } );
+#ssl_opts => { verify_hostname => 1 }
my $req = HTTP::Request->new('POST', 'https://www.sandbox.paypal.com/c
+gi-bin/webscr');
$req->content_type('application/x-www-form-urlencoded; charset=UTF-
+8');
# maybe Host => 'www.sandbox.paypal.com' when using sandbox?
$req->header(Host => 'www.paypal.com');
$req->content($return_query);
my $res = $ua->request($req);
debug "Second response: " . Dumper $res;
# make the variable hash
my %variable =
map { split(m'='x, $_, 2) }
grep { m'='x }
split(m'&'x, $return_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) {
debug "It's an error";
# HTTP error
}
elsif ($res->content eq 'VERIFIED') {
debug "$payment_status";
# 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') {
debug "It's invalid";
# log for manual investigation
}
else {
debug "It's an error";
# error
}
print "Content-type: text/plain\n\n";
exit(0);
This code still has the die issues that perlfan mentioned. I don't use Dancer2 to know how or if it handles die errors. |