in reply to Re^3: How do you use Paypal IPN with Dancer2?
in thread How do you use Paypal IPN with Dancer2?

You can catch the errors. This needs to be tested, but i bet it will work.

#!/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; }