refactor most of the B:OP:HTTPS code out to Net:HTTPS::Any. Add card_token documenta...

diff --git a/Changes b/Changes
index f916a36..d438c3b 100644 (file)
--- a/Changes
+++ b/Changes
@@ -10,6 +10,9 @@ Revision history for Perl extension Business::OnlinePayment.
         - Add clarification to notes_for_module_writers_v3 on authorization vs.
           order_number
         - (3.01_03) Add ECHECK_void_requires_account to introspection
         - Add clarification to notes_for_module_writers_v3 on authorization vs.
           order_number
         - (3.01_03) Add ECHECK_void_requires_account to introspection

+        - (3.01_04) Refactor most of the B:OP:HTTPS code out to Net:HTTPS::Any
+        - (3.01_04) Add card_token documentation.  Add token_support to
+          introspection.

 
 3.00     Mon Aug 17 15:55:11 PDT 2009
         - It finally happened.
 
 3.00     Mon Aug 17 15:55:11 PDT 2009
         - It finally happened.

diff --git a/Makefile.PL b/Makefile.PL
index 54d15bb..03657c1 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -8,14 +8,8 @@ WriteMakefile(
     'PMLIBDIRS'    => [ 'OnlinePayment', 'FraudDetect' ],
     'NORECURS'     => 1, # dont descend into subdirectories
     'PREREQ_PM'    => { 
     'PMLIBDIRS'    => [ 'OnlinePayment', 'FraudDetect' ],
     'NORECURS'     => 1, # dont descend into subdirectories
     'PREREQ_PM'    => { 

-                        # for HTTPS (maybe it should be a separate dist?)
-                        'URI::Escape' => 0,
-                        'Tie::IxHash' => 0,
-
-                        # 'Net::SSLeay' => 0,
-                        # or 'Crypt::SSLeay' => 0,
-                        #    'URI
-
+                        'Tie::IxHash'     => 0,
+                        'Net::HTTPS::Any' => 0,

                       },
     #'dist'         => {CI => 'ci -l'},
 );
                       },
     #'dist'         => {CI => 'ci -l'},
 );

diff --git a/OnlinePayment.pm b/OnlinePayment.pm
index 482f6e8..00a34c1 100644 (file)
--- a/OnlinePayment.pm
+++ b/OnlinePayment.pm
@@ -6,7 +6,7 @@ use Carp;
 
 require 5.005;
 
 
 require 5.005;
 

-$VERSION = '3.01_03';
+$VERSION = '3.01_04';

 $VERSION = eval $VERSION; # modperlstyle: convert the string into a number
 
 # Remember subclasses we have "wrapped" submit() with _pre_submit()
 $VERSION = eval $VERSION; # modperlstyle: convert the string into a number
 
 # Remember subclasses we have "wrapped" submit() with _pre_submit()


@@ -492,14 +492,27 @@ IP Address from which the transaction originated.
 
 Credit card number.
 
 
 Credit card number.
 

+=item expiration
+
+Credit card expiration.
+

 =item cvv2
 
 CVV2 number (also called CVC2 or CID) is a three- or four-digit
 security code used to reduce credit card fraud.
 
 =item cvv2
 
 CVV2 number (also called CVC2 or CID) is a three- or four-digit
 security code used to reduce credit card fraud.
 

-=item expiration
+=item card_token

 
 

-Credit card expiration.
+If supported by your gateway, you can pass a card_token instead of a
+card_number and expiration.
+
+=cut
+
+#=item card_response
+#
+#Some card_token schemes implement a challenge/response handshake.  In those
+#cases, this field is used for the response.  In most cases the handshake
+#it taken care of by the gateway module.

 
 =item track1
 
 
 =item track1
 


@@ -649,6 +662,11 @@ later.
 The unique order number for the transaction generated by the gateway.  Store
 this if you would like to run inquiries or refunds on the transaction later.
 
 The unique order number for the transaction generated by the gateway.  Store
 this if you would like to run inquiries or refunds on the transaction later.
 

+=head2 card_token()
+
+If supported by your gateway, a card_token can be used in a subsequent
+transaction to refer to a card number.
+

 =head2 fraud_score()
 
 Retrieve or change the fraud score from any Business::FraudDetect plugin
 =head2 fraud_score()
 
 Retrieve or change the fraud score from any Business::FraudDetect plugin

diff --git a/OnlinePayment/HTTPS.pm b/OnlinePayment/HTTPS.pm
index cb51905..7248cd7 100644 (file)
--- a/OnlinePayment/HTTPS.pm
+++ b/OnlinePayment/HTTPS.pm
@@ -1,46 +1,14 @@
 package Business::OnlinePayment::HTTPS;
 
 use strict;
 package Business::OnlinePayment::HTTPS;
 
 use strict;

-use vars qw($VERSION $DEBUG $ssl_module $skip_NetSSLeay);
-use URI::Escape;
-use Tie::IxHash;

 use base qw(Business::OnlinePayment);
 use base qw(Business::OnlinePayment);

+use vars qw($VERSION $DEBUG);
+use Tie::IxHash;
+use Net::HTTPS::Any 0.10;

 
 

-$VERSION = '0.09';
+$VERSION = '0.10';

 $DEBUG   = 0;
 
 $DEBUG   = 0;
 

-BEGIN {
-
-    $ssl_module = '';
-
-    eval {
-        die if defined($skip_NetSSLeay) && $skip_NetSSLeay;
-        require Net::SSLeay;
-        Net::SSLeay->VERSION(1.30);
-
-        #import Net::SSLeay
-        #  qw(get_https post_https make_form make_headers);
-        $ssl_module = 'Net::SSLeay';
-    };
-
-    if ($@) {
-        eval {
-            require LWP::UserAgent;
-            require HTTP::Request::Common;
-            require Crypt::SSLeay;
-
-            #import HTTP::Request::Common qw(GET POST);
-            $ssl_module = 'Crypt::SSLeay';
-        };
-    }
-
-    unless ($ssl_module) {
-        die "One of Net::SSLeay (v1.30 or later)"
-          . " or Crypt::SSLeay (+LWP) is required";
-    }
-
-}
-

 =head1 NAME
 
 Business::OnlinePayment::HTTPS - Base class for HTTPS payment APIs
 =head1 NAME
 
 Business::OnlinePayment::HTTPS - Base class for HTTPS payment APIs


@@ -72,7 +40,8 @@ Business::OnlinePayment::HTTPS - Base class for HTTPS payment APIs
 This is a base class for HTTPS based gateways, providing useful code
 for implementors of HTTPS payment APIs.
 
 This is a base class for HTTPS based gateways, providing useful code
 for implementors of HTTPS payment APIs.
 

-It depends on Net::SSLeay _or_ ( Crypt::SSLeay and LWP::UserAgent ).
+It depends on Net::HTTPS::Any, which in turn depends on
+Net::SSLeay _or_ ( Crypt::SSLeay and LWP::UserAgent ).

 
 =head1 METHODS
 
 
 =head1 METHODS
 


@@ -88,108 +57,53 @@ Returns a list consisting of the page content as a string, the HTTP
 response code and message (i.e. "200 OK" or "404 Not Found"), and a list of
 key/value pairs representing the HTTP response headers.
 
 response code and message (i.e. "200 OK" or "404 Not Found"), and a list of
 key/value pairs representing the HTTP response headers.
 

-The options hashref supports setting headers and Content-Type:
+The options hashref supports setting headers:

 
   {
       headers => { 'X-Header1' => 'value', ... },
 
   {
       headers => { 'X-Header1' => 'value', ... },

-      Content-Type => 'text/namevalue',

   }
 
 =cut
 
   }
 
 =cut
 

+#      Content-Type => 'text/namevalue',
+

 sub https_get {
     my $self = shift;
 
     # handle optional options hashref
 sub https_get {
     my $self = shift;
 
     # handle optional options hashref

-    my $opts;
+    my $opts = {};

     if ( scalar(@_) > 1 and ref( $_[0] ) eq "HASH" ) {
     if ( scalar(@_) > 1 and ref( $_[0] ) eq "HASH" ) {

-        $opts = shift;
+      $opts = shift;

     }
 
     # accept a hashref or a list (keep it ordered)
     my $post_data;
     if ( ref( $_[0] ) eq 'HASH' ) {
     }
 
     # accept a hashref or a list (keep it ordered)
     my $post_data;
     if ( ref( $_[0] ) eq 'HASH' ) {

-        $post_data = shift;
-    }
-    elsif ( scalar(@_) > 1 ) {
-        tie my %hash, 'Tie::IxHash', @_;
-        $post_data = \%hash;
-    }
-    elsif ( scalar(@_) == 1 ) {
-        $post_data = shift;
-    }
-    else {
-        die "https_get called with no params\n";
-    }
-
-    $opts->{"Content-Type"} ||= "application/x-www-form-urlencoded";
-
-    ### XXX referer!!!
-    my %headers;
-    if ( ref( $opts->{headers} ) eq "HASH" ) {
-        %headers = %{ $opts->{headers} };
-    }
-    $headers{'Host'} ||= $self->server;
-
-    my $path = $self->path;
-    if ( keys %$post_data ) {
-        $path .= '?'
-          . join( '&',
-            map { uri_escape($_) . '=' . uri_escape( $post_data->{$_} ) }
-              keys %$post_data );
+      $post_data = shift;
+    } elsif ( scalar(@_) > 1 ) {
+      tie my %hash, 'Tie::IxHash', @_;
+      $post_data = \%hash;
+    } elsif ( scalar(@_) == 1 ) {
+      $post_data = shift;
+    } else {
+      die "https_get called with no params\n";

     }
 
     $self->build_subs(qw( response_page response_code response_headers ));
 
     }
 
     $self->build_subs(qw( response_page response_code response_headers ));
 

-    if ( $ssl_module eq 'Net::SSLeay' ) {
-
-        import Net::SSLeay qw(get_https make_headers);
-        my $headers = make_headers(%headers);
-
-        my( $res_page, $res_code, @res_headers ) =
-          get_https( $self->server,
-                     $self->port,
-                     $path,
-                     $headers,
-                     "",
-                     $opts->{"Content-Type"},
-                   );
-
-        $res_code =~ /^(HTTP\S+ )?(.*)/ and $res_code = $2;
-
-        $self->response_page( $res_page );
-        $self->response_code( $res_code );
-        $self->response_headers( { @res_headers } );
-
-        ( $res_page, $res_code, @res_headers );
-
-    } elsif ( $ssl_module eq 'Crypt::SSLeay' ) {
-
-        import HTTP::Request::Common qw(GET);
-
-        my $url = 'https://' . $self->server;
-        $url .= ':' . $self->port
-          unless $self->port == 443;
-        $url .= "/$path";
+    my( $res_page, $res_code, @res_headers) = Net::HTTPS::Any::https_get( 
+      'host'    => $self->server,
+      'path'    => $self->path,
+      'headers' => $opts->{headers},
+      'args'    => $post_data,
+      'debug'   => $DEBUG,
+    );

 
 

-        my $ua = new LWP::UserAgent;
-        foreach my $hdr ( keys %headers ) {
-            $ua->default_header( $hdr => $headers{$hdr} );
-        }
-        my $res = $ua->request( GET($url) );
+    $self->response_page( $res_page );
+    $self->response_code( $res_code );
+    $self->response_headers( { @res_headers } );

 
 

-        my @res_headers = map { $_ => $res->header($_) }
-                              $res->header_field_names;
-
-        $self->response_page( $res->content );
-        $self->response_code( $res->code. ' '. $res->message );
-        $self->response_headers( { @res_headers } );
-
-        ( $res->content, $res->code. ' '. $res->message, @res_headers );
-
-    } else {
-        die "unknown SSL module $ssl_module";
-    }
+    ( $res_page, $res_code, @res_headers );

 
 }
 
 
 }
 


@@ -218,115 +132,42 @@ sub https_post {
     my $self = shift;
 
     # handle optional options hashref
     my $self = shift;
 
     # handle optional options hashref

-    my $opts;
+    my $opts = {};

     if ( scalar(@_) > 1 and ref( $_[0] ) eq "HASH" ) {
         $opts = shift;
     }
 
     if ( scalar(@_) > 1 and ref( $_[0] ) eq "HASH" ) {
         $opts = shift;
     }
 

+    my %post = (
+      'host'         => $self->server,
+      'path'         => $self->path,
+      'headers'      => $opts->{headers},
+      'Content-Type' => $opts->{'Content-Type'},
+      'debug'        => $DEBUG,
+    );
+

     # accept a hashref or a list (keep it ordered)
     # accept a hashref or a list (keep it ordered)

-    my $post_data;
+    my $post_data = '';
+    my $content = undef;

     if ( ref( $_[0] ) eq 'HASH' ) {
     if ( ref( $_[0] ) eq 'HASH' ) {

-        $post_data = shift;
-    }
-    elsif ( scalar(@_) > 1 ) {
-        tie my %hash, 'Tie::IxHash', @_;
-        $post_data = \%hash;
-    }
-    elsif ( scalar(@_) == 1 ) {
-        $post_data = shift;
-    }
-    else {
-        die "https_post called with no params\n";
-    }
-
-    $opts->{"Content-Type"} ||= "application/x-www-form-urlencoded";
-
-    ### XXX referer!!!
-    my %headers;
-    if ( ref( $opts->{headers} ) eq "HASH" ) {
-        %headers = %{ $opts->{headers} };
-    }
-    $headers{'Host'} ||= $self->server;
-
-    if ( $DEBUG && ref($post_data) ) {
-        warn "post data:\n",
-          join( '',
-            map { "  $_ => " . $post_data->{$_} . "\n" } keys %$post_data );
+      $post{'args'} = shift;
+    } elsif ( scalar(@_) > 1 ) {
+      tie my %hash, 'Tie::IxHash', @_;
+      $post{'args'} = \%hash;
+    } elsif ( scalar(@_) == 1 ) {
+      $post{'content'} = shift;
+    } else {
+      die "https_post called with no params\n";

     }
 
     $self->build_subs(qw( response_page response_code response_headers ));
 
     }
 
     $self->build_subs(qw( response_page response_code response_headers ));
 

-    if ( $ssl_module eq 'Net::SSLeay' ) {
-
-        import Net::SSLeay qw(post_https make_headers make_form);
-        my $headers = make_headers(%headers);
+    my( $res_page, $res_code, @res_headers)= Net::HTTPS::Any::https_post(%post);

 
 

-        if ($DEBUG) {
-            no warnings 'uninitialized';
-            warn $self->server . ':' . $self->port . $self->path . "\n";
-            $Net::SSLeay::trace = $DEBUG;
-        }
+    $self->response_page( $res_page );
+    $self->response_code( $res_code );
+    $self->response_headers( { @res_headers } );

 
 

-        my $raw_data = ref($post_data) ? make_form(%$post_data) : $post_data;
-
-        my( $res_page, $res_code, @res_headers ) =
-          post_https( $self->server,
-                      $self->port,
-                      $self->path,
-                      $headers,
-                      $raw_data,
-                      $opts->{"Content-Type"},
-                    );
-
-        $res_code =~ /^(HTTP\S+ )?(.*)/ and $res_code = $2;
-
-        $self->response_page( $res_page );
-        $self->response_code( $res_code );
-        $self->response_headers( { @res_headers } );
-
-        ( $res_page, $res_code, @res_headers );
-
-    } elsif ( $ssl_module eq 'Crypt::SSLeay' ) {
-
-        import HTTP::Request::Common qw(POST);
-
-        my $url = 'https://' . $self->server;
-        $url .= ':' . $self->port
-          unless $self->port == 443;
-        $url .= $self->path;
-
-        if ($DEBUG) {
-            warn $url;
-        }
-
-        my $ua = new LWP::UserAgent;
-        foreach my $hdr ( keys %headers ) {
-            $ua->default_header( $hdr => $headers{$hdr} );
-        }
-
-        my $res;
-        if ( ref($post_data) ) {
-            $res = $ua->request( POST( $url, [%$post_data] ) );
-        }
-        else {
-            my $req = new HTTP::Request( 'POST' => $url );
-            $req->content_type( $opts->{"Content-Type"} );
-            $req->content($post_data);
-            $res = $ua->request($req);
-        }
-
-        my @res_headers = map { $_ => $res->header($_) }
-                              $res->header_field_names;
-
-        $self->response_page( $res->content );
-        $self->response_code( $res->code. ' '. $res->message );
-        $self->response_headers( { @res_headers } );
-
-        ( $res->content, $res->code. ' '. $res->message, @res_headers );
-
-    } else {
-        die "unknown SSL module $ssl_module";
-    }
+    ( $res_page, $res_code, @res_headers );

 
 }
 
 
 }
 


@@ -334,7 +175,7 @@ sub https_post {
 
 =head1 SEE ALSO
 
 
 =head1 SEE ALSO
 

-L<Business::OnlinePayment>
+L<Business::OnlinePayment>, L<Net::HTTPS::Any>

 
 =cut
 
 
 =cut
 

diff --git a/notes_for_module_writers_v3 b/notes_for_module_writers_v3
index f8d9ce5..e7f0501 100644 (file)
--- a/notes_for_module_writers_v3
+++ b/notes_for_module_writers_v3
@@ -5,9 +5,6 @@ These are the module writer's notes for v3.  See the regular
 - If your gateway is HTTPS-based, use (or convert to)
   Business::OnlinePayment::HTTPS !!
 
 - If your gateway is HTTPS-based, use (or convert to)
   Business::OnlinePayment::HTTPS !!
 

-    - Business::OnlinePayment::OpenECHO is the first "v3-ish" module, try
-      starting from there.
-

 
 - Handling failures:
 
 
 - Handling failures:
 


@@ -53,6 +50,8 @@ These are the module writer's notes for v3.  See the regular
           'gateway_url'           => 'http://www.example.com/',
           'module_version'        => $VERSION,
           'supported_types'       => [ qw( CC ECHECK ) ],
           'gateway_url'           => 'http://www.example.com/',
           'module_version'        => $VERSION,
           'supported_types'       => [ qw( CC ECHECK ) ],

+          'token_support'         => 0, #card storage/tokenization support
+          'test_transaction'      => 0, #set true if ->test_transaction(1) works

           'supported_actions'     => [
                                        'Normal Authorization',
                                        'Authorization Only',
           'supported_actions'     => [
                                        'Normal Authorization',
                                        'Authorization Only',


@@ -74,6 +73,8 @@ These are the module writer's notes for v3.  See the regular
           'module_version'        => $VERSION,
           'module_notes'          => 'usage notes',
           'supported_types'       => [ qw( CC ECHECK ) ],
           'module_version'        => $VERSION,
           'module_notes'          => 'usage notes',
           'supported_types'       => [ qw( CC ECHECK ) ],

+          'token_support'         => 1,
+          'test_transaction'      => 1,

           'supported_actions'     => { 'CC' => [
                                          'Normal Authorization',
                                          'Authorization Only',
           'supported_actions'     => { 'CC' => [
                                          'Normal Authorization',
                                          'Authorization Only',