File Coverage

blib/lib/Business/CPI/Gateway/PayPal/IPN.pm

Criterion	Covered	Total	%
statement	6	6	100.0
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	8	8	100.0

package Business::CPI::Gateway::PayPal::IPN;
# ABSTRACT: Instant Payment Notifications
use Moo;
use LWP::UserAgent ();

our $VERSION = '0.903'; # TRIAL VERSION

has is_valid => (
    is      => 'lazy',
    default => sub {
        my $self = shift;

        for ($self->response->decoded_content) {
            return 0 if /^INVALID$/;
            return 1 if /^VERIFIED$/;

            die "Vague response: " . $_;
        }
    }
);

has vars => (
    is      => 'lazy',
    default => sub {
        my $self = shift;
        return { map { $_ => $self->query->param($_) } $self->query->param };
    },
);

has gateway_url => (
    is => 'ro',
    default => sub { 'https://www.paypal.com/cgi-bin/webscr' },
);

has query => (
    is      => 'ro',
    default => sub { require CGI; CGI->new() },
);

has user_agent_name => (
    is => 'ro',
    default => sub {
        my $base    = 'Business::CPI::Gateway::PayPal';
        my $version = __PACKAGE__->VERSION;

        return $version ? "$base/$version" : $base;
    }
);

has user_agent => (
    is      => 'lazy',
    default => sub {
        my $self = shift;

        my $ua = LWP::UserAgent->new();
        $ua->agent( $self->user_agent_name );

        return $ua;
    },
);

has response => (
    is      => 'lazy',
    default => sub {
        my $self = shift;

        my $ua   = $self->user_agent;
        my %vars = %{ $self->vars };
        my $gtw  = $self->gateway_url;

        $vars{cmd} = "_notify-validate";

        my $r = $ua->post( $gtw, \%vars );

        die "Couldn't connect to '$gtw': " . $r->status_line
            if $r->is_error;

        return $r;
    },
);

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Business::CPI::Gateway::PayPal::IPN - Instant Payment Notifications

=head1 VERSION

version 0.903

=head1 SYNOPSIS

    my $ipn = Business::CPI::Gateway::PayPal::IPN->new(
        # this could be $ctx->req if in Catalyst, for example
        query => $req,

        # defaults to the main server, but could be changed to sandbox or
        # something else
        gateway_url => 'https://www.sandbox.paypal.com/cgi-bin/webscr',
    );

    if ($ipn->is_valid) {
        my %vars = %{ $ipn->vars };

        if ($vars{payment_status} eq 'Canceled_Reversal') {
            # ...
        }
    }

=head1 DESCRIPTION

This is a rewrite of L<Business::PayPal::IPN>. It works somewhat similar to it,
and shares almost none of the same code.

=head2 But why? Software rewriting is bad!

Well, yes, it is usually a bad idea to rewrite software. But the old module had
no updates for about 10 years, and, while it worked fine and was well written,
Perl has grown a lot in the last 10 years. As I improved my PayPal interface
for CPI, I decided I might want to add new features to the IPN module in a near
future. As the code was reasonably small, I rewrote it using Moo. This means
it's still pretty fast, and much more readable and extensible. Also, the
original module had no tests.  (Even though it was proven to work due to being
used in production.)

=head2 How is it different from the original module?

It has only attributes, no methods. This gives free caching, and lazy loading.
It has less than one third the size (counting blank lines, but not pod). It
uses Moo, and has a much more readable code. It has real tests, and the small
code makes it easier to find mistakes. I removed some methods like
C<completed>, so now you have to check: $ipn->vars->{payment_status} eq
'Completed'. There are many more possible payment status in PayPal than what
the old module expected (it implemented version 1.5, while at the time of this
writing, PayPal's IPN is in version 3.7; so a lot has changed). So I think
those auxiliary methods like C<completed>, C<pending>, etc, are not too useful.

It's also lazy. Instantiating the object won't try to parse the request.
Instead, it waits for you to ask for the variables, or ask if the request is
valid. See the L</SYNOPSIS> for more information.

=head1 ATTRIBUTES

=head2 gateway_url

Set this attribute in the constructor in case you want a different server than
PayPal's default, such as a test server, or even PayPal's sandbox.

=head2 query

A CGI-compatible object (e.g. Catalyst::Request).

=head2 vars

The variables provided by PayPal. Contrary to Business::PayPal::IPN, this
returns a HashRef.

=head2 is_valid

Checks with PayPal that the request was really generated by them. Returns true
if PayPal validates, otherwise false.

=head2 user_agent_name

The name of the user agent to post to PayPal.

=head2 user_agent

Defaults to a LWP::UserAgent object, but can be a custom object provided for
testing purposes, or by the users preference. Could be L<Mojo::UserAgent>, for
example.

=head2 response

The response from PayPal when validating.

=head1 SEE ALSO

L<Business::PayPal::IPN>

=head1 CREDITS

Sherzod B. Ruzmetov E<lt>[e-mail]<gt> for creating Business::PayPal::IPN.

=head1 AUTHOR

André Walker <[e-mail]>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2013 by André Walker.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut