Business::PayPal - Perl extension for automating PayPal transactions

  To generate a PayPal button for use on your site
  Include something like the following in your CGI

  use Business::PayPal;
  my $paypal = Business::PayPal->new;
  my $button = $paypal->button(
      business => 'dr@dursec.com',
      item_name => 'CanSecWest Registration Example',
      return => 'http://www.cansecwest.com/return.cgi',
      cancel_return => 'http://www.cansecwest.com/cancel.cgi',
      amount => '1600.00',
      quantity => 1,
      notify_url => http://www.cansecwest.com/ipn.cgi
  );
  my $id = $paypal->id;

  #store $id somewhere so we can get it back again later
  #store current context with $id
  #Apache::Session works well for this
  #print button to the browser
  #note, button is a CGI form, enclosed in <form></form> tags







  To validate the Instant Payment Notification from PayPal for the 
  button used above include something like the following in your 
  'notify_url' CGI.

  use CGI;
  my $query = new CGI;
  my %query = $query->Vars;
  my $id = $query{custom};
  my $paypal = Business::PayPal->new(id => $id);
  my ($txnstatus, $reason) = $paypal->ipnvalidate(\%query);
  die "PayPal failed: $reason" unless $txnstatus;
  my $money = $query{payment_gross};
  my $paystatus = $query{payment_status};

  #check if paystatus eq 'Completed'
  #check if $money is the ammount you expected
  #save payment status information to store as $id




  To tell the user if their payment succeeded or not, use something like
  the following in the CGI pointed to by the 'return' parameter in your
  PayPal button.

  use CGI;
  my $query = new CGI;
  my $id = $query{custom};

  #get payment status from store for $id
  #return payment status to customer

  Creates a new Business::PayPal object, it can take the 
  following parameters:

  Returns the id for the Business::PayPal object. 

  Returns the HTML for a PayPal button.  It takes a large number of
  parameters, which control the look and function of the button, some
  of which are required and some of which have defaults.  They are
  as follows:

  Takes a reference to a hash of name value pairs, such as from a 
  CGI query object, which should contain all the name value pairs 
  which have been posted to the script by PayPal's Instant Payment 
  Notification posts that data back to PayPal, checking if the ssl 
  certificate matches, and returns success or failure, and the 
  reason.

  This method should not normally be used unless you need to test, 
  or if you are overriding the behaviour of ipnvalidate.  It takes a 
  reference to a hash containing the query, posts to PayPal with 
  the data, and returns success or failure, as well as PayPal's 
  response.

package Business::PayPal;

use 5.6.1;
use strict;
use warnings;

our $VERSION = '0.04';

use Net::SSLeay 1.14;
use Digest::MD5 qw(md5_hex);
use CGI;

our $Cert = <<CERT;
-----BEGIN CERTIFICATE-----
MIIFxzCCBK+gAwIBAgIQa1UJlCErojlUgeB4Mkr3yDANBgkqhkiG9w0BAQUFADCB
ujELMAkGA1UEBhMCVVMxFzAVBgNVBAoTDlZlcmlTaWduLCBJbmMuMR8wHQYDVQQL
ExZWZXJpU2lnbiBUcnVzdCBOZXR3b3JrMTswOQYDVQQLEzJUZXJtcyBvZiB1c2Ug
YXQgaHR0cHM6Ly93d3cudmVyaXNpZ24uY29tL3JwYSAoYykwNjE0MDIGA1UEAxMr
VmVyaVNpZ24gQ2xhc3MgMyBFeHRlbmRlZCBWYWxpZGF0aW9uIFNTTCBDQTAeFw0w
OTA0MjgwMDAwMDBaFw0xMDEwMzEyMzU5NTlaMIIBDzETMBEGCysGAQQBgjc8AgED
EwJVUzEZMBcGCysGAQQBgjc8AgECEwhEZWxhd2FyZTEbMBkGA1UEDxMSVjEuMCwg
Q2xhdXNlIDUuKGIpMRAwDgYDVQQFEwczMDE0MjY3MQswCQYDVQQGEwJVUzETMBEG
A1UEERQKOTUxMzEtMjAyMTETMBEGA1UECBMKQ2FsaWZvcm5pYTERMA8GA1UEBxQI
U2FuIEpvc2UxFjAUBgNVBAkUDTIyMTEgTiAxc3QgU3QxFTATBgNVBAoUDFBheVBh
bCwgSW5jLjEcMBoGA1UECxQTSW5mb3JtYXRpb24gU3lzdGVtczEXMBUGA1UEAxQO
d3d3LnBheXBhbC5jb20wgZ8wDQYJKoZIhvcNAQEBBQADgY0AMIGJAoGBAOToN9bo
3xHnLlGXNIM8UY+H9Kef36HIvrPKzpZEyzM/W8olqDIFnx1Y5veAPiri4gy0vViz
x7NOI7A0UFJb8TMJWfWHODj6UL4vb61SyMKb70N+QcN7VIZBUcnR2cH5SFoVY2Pl
AXafyci9t8eMaZIu633X6f3giUrZeJJ1zcJrAgMBAAGjggHzMIIB7zAJBgNVHRME
AjAAMB0GA1UdDgQWBBS5q3ty06dVj98AICEVjN/y2+anPDALBgNVHQ8EBAMCBaAw
QgYDVR0fBDswOTA3oDWgM4YxaHR0cDovL0VWU2VjdXJlLWNybC52ZXJpc2lnbi5j
b20vRVZTZWN1cmUyMDA2LmNybDBEBgNVHSAEPTA7MDkGC2CGSAGG+EUBBxcGMCow
KAYIKwYBBQUHAgEWHGh0dHBzOi8vd3d3LnZlcmlzaWduLmNvbS9ycGEwHQYDVR0l
BBYwFAYIKwYBBQUHAwEGCCsGAQUFBwMCMB8GA1UdIwQYMBaAFPyKULqeuSVae1WF
T5UAY4/pWGtDMHwGCCsGAQUFBwEBBHAwbjAtBggrBgEFBQcwAYYhaHR0cDovL0VW
U2VjdXJlLW9jc3AudmVyaXNpZ24uY29tMD0GCCsGAQUFBzAChjFodHRwOi8vRVZT
ZWN1cmUtYWlhLnZlcmlzaWduLmNvbS9FVlNlY3VyZTIwMDYuY2VyMG4GCCsGAQUF
BwEMBGIwYKFeoFwwWjBYMFYWCWltYWdlL2dpZjAhMB8wBwYFKw4DAhoEFEtruSiW
Bgy70FI4mymsSweLIQUYMCYWJGh0dHA6Ly9sb2dvLnZlcmlzaWduLmNvbS92c2xv
Z28xLmdpZjANBgkqhkiG9w0BAQUFAAOCAQEAelhvEIp1VFp6KYp0GyDC8RKCDUAD
lRXIoILBtZUo3yp8hyjr5yCD0GyEER8vyGgOOi36m7myBoVqETmwrGVqaIMGTwJH
AfjYhZkai2HQpkQTg1IUvIQr92P0+NwdWx2+zTLmJKLh8WEThtiehFm/SRUELSLi
N2c6kajnuXhVPf3vAClnLi7/4as1ZaXWx0Q1YtRcXWWtaCjisiVuzR7mR3p0bIWT
/gCb0NFZXDHZn7S2WWf6kDoKXkSElwW2uwwpAL7rE46NIePB1qRPyZV4Q70LYb9i
STuh/fJHwostpLYwphYeXObI1TpZV47asnQ7k+u6s4Rp9ui3ItQs/+1P4w==
-----END CERTIFICATE-----
CERT
chomp($Cert);

our $Certcontent = <<CERTCONTENT;
Subject Name: /1.3.6.1.4.1.311.60.2.1.3=US/1.3.6.1.4.1.311.60.2.1.2=Delaware/2.5.4.15=V1.0, Clause 5.(b)/serialNumber=3014267/C=US/postalCode=95131-2021/ST=California/L=San Jose/streetAddress=2211 N 1st St/O=PayPal, Inc./OU=Information Systems/CN=www.paypal.com
Issuer  Name: /C=US/O=VeriSign, Inc./OU=VeriSign Trust Network/OU=Terms of use at https://www.verisign.com/rpa (c)06/CN=VeriSign Class 3 Extended Validation SSL CA
CERTCONTENT
chomp($Certcontent);


# creates new PayPal object.  Assigns an id if none is provided.
sub new {
    my $invocant = shift;
    my $class = ref($invocant) || $invocant;
    my $self = {
        id => undef,
        address => 'https://www.paypal.com/cgi-bin/webscr',
        @_,
    };
    bless $self, $class;
    $self->{id} = md5_hex(rand()) unless $self->{id};
    return $self;
}

# returns current PayPal id
sub id {
    my $self = shift;
    return $self->{id};
}

#creates a PayPal button
sub button {
    my $self = shift;
    my %buttonparam = (
        cmd                 => '_ext-enter',
        redirect_cmd        => '_xclick',
        button_image        => CGI::image_button(
            -name => 'submit',
            -src => 'http://images.paypal.com/images/x-click-but01.gif',
            -alt => 'Make payments with PayPal',
            ), 
        business            => undef,
        item_name           => undef,
        item_number         => undef,
        image_url           => undef,
        no_shipping         => 1,
        return              => undef,
        cancel_return       => undef,
        no_note             => 1,
        undefined_quantity  => 0,
        notify_url          => undef,
        first_name          => undef,
        last_name           => undef,
        shipping            => undef,
        shipping2           => undef,
        quantity            => undef,
        amount              => undef,
        address1            => undef,
        address2            => undef,
        city                => undef,
        state               => undef,
        zip                 => undef,
        night_phone_a       => undef,
        night_phone_b       => undef,
        night_phone_c       => undef,
        day_phone_a         => undef,
        day_phone_b         => undef,
        day_phone_c         => undef,
        receiver_email      => undef,
        invoice             => undef,
        currency_code       => undef,
        custom              => $self->{id},
        @_,
    );
    my $key;
    my $content = CGI::start_form( -method => 'POST',
        -action => $self->{'address'},
                                 );
    foreach (keys %buttonparam) {
        next unless defined $buttonparam{$_};
        if ($_ eq 'button_image') {
            $content .= $buttonparam{$_}; 
        }
        else {
            $content .= CGI::hidden( -name => $_,
                                     -default => $buttonparam{$_},
                                   );
        }
    }
    $content .= CGI::endform();
    return $content;
}


# takes a reference to a hash of name value pairs, such as from a CGI query
# object, which should contain all the name value pairs which have been
# posted to the script by PayPal's Instant Payment Notification
# posts that data back to PayPal, checking if the ssl certificate matches,
# and returns success or failure, and the reason.
sub ipnvalidate {
    my $self = shift;
    my $query = shift;
    $$query{cmd} = '_notify-validate';
    my $id = $self->{id};
    my ($succ, $reason) = $self->postpaypal($query); 
    return (wantarray ? ($id, $reason) : $id)
        if $succ;
    return (wantarray ? (undef, $reason) : undef);
}

# this method should not normally be used unless you need to test, or if
# you are overriding the behaviour of ipnvalidate.  It takes a reference
# to a hash containing the query, posts to PayPal with the data, and returns
# success or failure, as well as PayPal's response.
sub postpaypal {
    my $self = shift;
    my $address = $self->{address};
    my $query = shift; # reference to hash containing name value pairs
    my ($site, $port, $path);

    #following code splits an url into site, port and path components
    my @address = split /:\/\//, $address, 2;
    @address = split /(?=\/)/, $address[1], 2;
    if ($address[0] =~ /:/) {
        ($site, $port) = split /:/, $address[0];
    }
    else {
        ($site, $port) = ($address[0], '443');
    }
    $path = $address[1];
    my ($page, 
        $response, 
        $headers, 
        $ppcert, 
        ) = Net::SSLeay::post_https3($site, 
                                         $port, 
                                         $path, 
                                         '', 
                                         Net::SSLeay::make_form(%$query));


    my $ppx509 = Net::SSLeay::PEM_get_string_X509($ppcert);
    my $ppcertcontent =
    'Subject Name: '
        . Net::SSLeay::X509_NAME_oneline(
               Net::SSLeay::X509_get_subject_name($ppcert))
            . "\nIssuer  Name: "
                . Net::SSLeay::X509_NAME_oneline(
                       Net::SSLeay::X509_get_issuer_name($ppcert))
                    . "\n";

    chomp $ppx509;
    chomp $ppcertcontent;
    return (wantarray ? (undef, "PayPal cert failed to match: $ppx509\n$Cert") : undef)  
        unless $Cert eq $ppx509;
    return (wantarray ? (undef, "PayPal cert contents failed to match $ppcertcontent") : undef)        unless $ppcertcontent eq "$Certcontent";
    return (wantarray ? (undef, 'PayPal says transaction INVALID') : undef)
        if $page eq 'INVALID';
    return (wantarray ? (1, 'PayPal says transaction VERIFIED') : 1)
        if $page eq 'VERIFIED';
    warn "Bad stuff happened\n$page";
    return (wantarray ? (undef, "Bad stuff happened") :undef);
}

 

1;