X-Git-Url: http://git.freeside.biz/gitweb/?p=Business-OnlinePayment.git;a=blobdiff_plain;f=OnlinePayment%2FHTTPS.pm;h=7248cd76fad516acb09e781e95ca06cf34f39c88;hp=315429797f283eef5b7bb87c0c3b1e4635e7595c;hb=HEAD;hpb=539664e913f52544a705dcbdaee19c8ef10d38e7

diff --git a/OnlinePayment/HTTPS.pm b/OnlinePayment/HTTPS.pm
index 3154297..7248cd7 100644
--- a/OnlinePayment/HTTPS.pm
+++ b/OnlinePayment/HTTPS.pm
@@ -1,46 +1,14 @@
 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 vars qw($VERSION $DEBUG);
+use Tie::IxHash;
+use Net::HTTPS::Any 0.10;
 
-$VERSION = '0.05';
+$VERSION = '0.10';
 $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
@@ -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.
 
-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
 
@@ -85,90 +54,57 @@ In the latter case, ordering is preserved (see L<Tie::IxHash> to do so
 when passing a hashref).
 
 Returns a list consisting of the page content as a string, the HTTP
-response code, 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', ... },
-      Content-Type => 'text/namevalue',
   }
 
 =cut
 
+#      Content-Type => 'text/namevalue',
+
 sub https_get {
     my $self = shift;
 
     # handle optional options hashref
-    my $opts;
+    my $opts = {};
     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' ) {
-        $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";
+      $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";
+    $self->build_subs(qw( response_page response_code response_headers ));
 
-    ### 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 );
-    }
-
-    if ( $ssl_module eq 'Net::SSLeay' ) {
-
-        import Net::SSLeay qw(get_https make_headers);
-        my $headers = make_headers(%headers);
-        get_https( $self->server, $self->port, $path, $headers, "",
-            $opts->{"Content-Type"} );
-    }
-    elsif ( $ssl_module eq 'Crypt::SSLeay' ) {
+    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,
+    );
 
-        import HTTP::Request::Common qw(GET);
+    $self->response_page( $res_page );
+    $self->response_code( $res_code );
+    $self->response_headers( { @res_headers } );
 
-        my $url = 'https://' . $self->server;
-        $url .= ':' . $self->port
-          unless $self->port == 443;
-        $url .= "/$path";
+    ( $res_page, $res_code, @res_headers );
 
-        my $ua = new LWP::UserAgent;
-        foreach my $hdr ( keys %headers ) {
-            $ua->default_header( $hdr => $headers{$hdr} );
-        }
-        my $res = $ua->request( GET($url) );
-
-        (
-            $res->content, $res->code,
-            map { $_ => $res->header($_) } $res->header_field_names
-        );
-    }
-    else {
-        die "unknown SSL module $ssl_module";
-    }
 }
 
 =item https_post [ \%options ] SCALAR | HASHREF | FIELD => VALUE, ...
@@ -180,8 +116,8 @@ passing a hashref).
 Also accepts instead a simple scalar containing the raw content.
 
 Returns a list consisting of the page content as a string, the HTTP
-response code, 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:
 
@@ -196,101 +132,50 @@ sub https_post {
     my $self = shift;
 
     # handle optional options hashref
-    my $opts;
+    my $opts = {};
     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)
-    my $post_data;
+    my $post_data = '';
+    my $content = undef;
     if ( ref( $_[0] ) eq 'HASH' ) {
-        $post_data = shift;
+      $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";
     }
-    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 );
-    }
+    $self->build_subs(qw( response_page response_code response_headers ));
 
-    if ( $ssl_module eq 'Net::SSLeay' ) {
+    my( $res_page, $res_code, @res_headers)= Net::HTTPS::Any::https_post(%post);
 
-        import Net::SSLeay qw(post_https make_headers make_form);
-        my $headers = make_headers(%headers);
+    $self->response_page( $res_page );
+    $self->response_code( $res_code );
+    $self->response_headers( { @res_headers } );
 
-        if ($DEBUG) {
-            no warnings 'uninitialized';
-            warn $self->server . ':' . $self->port . $self->path . "\n";
-            $Net::SSLeay::trace = $DEBUG;
-        }
+    ( $res_page, $res_code, @res_headers );
 
-        my $raw_data = ref($post_data) ? make_form(%$post_data) : $post_data;
-        post_https( $self->server, $self->port, $self->path, $headers,
-            $raw_data, $opts->{"Content-Type"} );
-    }
-    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);
-        }
-
-        (
-            $res->content, $res->code,
-            map { $_ => $res->header($_) } $res->header_field_names
-        );
-    }
-    else {
-        die "unknown SSL module $ssl_module";
-    }
 }
 
 =back
 
 =head1 SEE ALSO
 
-L<Business::OnlinePayment>
+L<Business::OnlinePayment>, L<Net::HTTPS::Any>
 
 =cut