Description:
This box is called on K5 by paypal's Instant Payment Notification service. It takes the contents of an IPN request, checks it out, and if valid, creates the ad_payments row and marks the ad paid. If all you're interested in is the Paypal IPN stuff, it's at the top.
Box Code:
my $DEBUG = 0;
my $state;
# Get all the form variables.
my $vars = $S->cgi->Vars();
# Get all the args and validate them
my $content;
foreach my $key (keys %{$vars}) {
next if ($key eq 'op' or $key eq 'page');
$content .= "&$key=$vars->{$key}";
}
warn "IPN: Have content <<$content>>\n" if $DEBUG;
return '' unless ($content);
$content .= '&cmd=_notify-validate';
$content =~ s/^\&//;
warn "Replying to IPN: <<$content>>\n" if $DEBUG;
my $ua = new LWP::UserAgent;
$ua->agent("K5 Paybot 0.1 " . $ua->agent);
my $req = new HTTP::Request POST => 'https://www.paypal.com/cgi-bin/webscr';
$req->content_type('application/x-www-form-urlencoded');
$req->content($content);
my $res = $ua->request($req);
if ($res->is_error()) {
my $code = $res->code();
my $message = $res->message();
warn "IPN verify request failed! Code: <<$code>>, Message: <<$message>>\n" if $DEBUG;
return '';
}
my $answer = $res->content();
warn "IPN verify answer is <<$answer>>\n" if $DEBUG;
if ($answer ne 'VERIFIED') {
my $subject = 'Invalid Paypal Instant Confirm';
my $message = qq{
Warning! Paypal sent an ICN that came back invalid. Below are the
contents of the POST.
};
foreach my $key (keys %{$vars}) {
$message .= qq{
<$key> = <$vars->{$key}>};
}
my $to = $S->{UI}->{BLOCKS}->{admin_alert};
my @send_to = split /,/, $to;
foreach my $address (@send_to) {
$S->mail($address, $subject, $message);
}
return;
}
# Check that it's an ad. Add in subscription notify later
return unless ($vars->{item_name} eq 'Advertisement');
# Check payment status
my $stat = $vars->{'payment_status'};
return unless ($stat =~ /completed/i);
# Check trans id
my $oid = $vars->{'txn_id'};
my $q_oid = $S->dbh->quote($oid);
my ($rv, $sth) = $S->db_select({
WHAT => 'COUNT(*)',
FROM => 'ad_payments',
WHERE => "order_id = $q_oid"
});
my $count = $sth->fetchrow();
$sth->finish();
# If count is not zero, this is a dupe
warn "IPN: Checked for old oid, found <<$count>>\n" if $DEBUG;
return if ($count);
# Ok, this seems to all be good! Let the system know about it then
my $ad_id = $vars->{item_number};
warn "IPN: Ad ID is <<$ad_id>>\n" if $DEBUG;
return unless ($ad_id);
#populate the payment table.
($rv, $sth) = $S->db_insert({
INTO => 'ad_payments',
COLS => 'ad_id, order_id, cost, pay_type, auth_date',
VALUES => qq{$ad_id, $q_oid, "$vars->{payment_gross}", 'paypal', NOW()}
});
$sth->finish();
# Cool. Now we mark the ad rec paid.
($rv, $sth) = $S->db_update({
WHAT => 'ad_info',
SET => 'paid = 1',
WHERE => qq{ad_id = $ad_id}
});
$sth->finish();
return;
|