doc: list a bunch of previously undocumented fields

[Business-OnlinePayment.git] / OnlinePayment / HTTPS.pm

diff --git a/OnlinePayment/HTTPS.pm b/OnlinePayment/HTTPS.pm
index 0ba897d..0e5ecbd 100644 (file)
--- a/OnlinePayment/HTTPS.pm
+++ b/OnlinePayment/HTTPS.pm
@@ -1,7 +1,7 @@
 package Business::OnlinePayment::HTTPS;
 
 use strict;
-use vars qw($VERSION @ISA $ssl_module $skip_NetSSLeay);
+use vars qw($VERSION @ISA $DEBUG $ssl_module $skip_NetSSLeay);
 #use URI;
 #use URI::QueryParam;
 use URI::Escape;
@@ -9,7 +9,9 @@ use Tie::IxHash;
 
 @ISA = qw( Business::OnlinePayment );
 
-$VERSION = '0.01';
+$VERSION = '0.04';
+
+$DEBUG = 0;
 
 BEGIN {
 
@@ -18,6 +20,7 @@ BEGIN {
         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';
@@ -34,7 +37,8 @@ BEGIN {
         }
 
         unless ( $ssl_module ) {
-                die "Net::SSLeay (+URI) or Crypt::SSLeay (+LWP) is required";
+                die "One of Net::SSLeay (v1.30 or later)".
+                    " or Crypt::SSLeay (+LWP) is required";
         }
 
 }
@@ -60,7 +64,7 @@ Business::OnlinePayment::HTTPS - Base class for HTTPS payment APIs
           #or a hashref
           my %hash = ( field => 'value', ... );
           ($page, $response_code, %reply_headers)
-            = $self->https_get( $hashref );
+            = $self->https_get( \%hash );
 
           #...
   }
@@ -128,10 +132,13 @@ sub https_get {
 
     import HTTP::Request::Common qw(GET);
 
+    my $url = 'https://'. $self->server;
+    $url .= ':'. $self->port
+      unless $self->port == 443;
+    $url .= "/$path";
+
     my $ua = new LWP::UserAgent;
-    my $res = $ua->request(
-      GET( 'https://'. $self->server. ':'. $self->port. '/'. $path )
-    );
+    my $res = $ua->request( GET( $url ) );
 
     #( $res->as_string, # wtf?
     ( $res->content,
@@ -147,16 +154,97 @@ sub https_get {
 
 }
 
-=item https_post
+=item https_post SCALAR | HASHREF | FIELD => VALUE, ...
 
-Not yet implemented
+Accepts form fields and values as either a hashref or a list.  In the latter
+case, ordering is preserved (see L<Tie::IxHash> to do so when 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.
 
 =cut
 
 sub https_post {
   my $self = shift;
 
-  die "not yet implemented";
+  #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_post called with no params\n";
+  }
+
+  my $referer = ''; ### XXX referer!!!
+  my %headers;
+  $headers{'Referer'} = $referer if length($referer);
+  $headers{'Host'} = $self->server;
+
+  if ( $DEBUG && ref($post_data) ) {
+    warn join('', map { "  $_ => ". $post_data->{$_}. "\n" } keys %$post_data );
+  }
+
+  if ( $ssl_module eq 'Net::SSLeay' ) {
+
+    import Net::SSLeay qw(post_https make_headers make_form);
+    my $headers = make_headers(%headers);
+
+    if ( $DEBUG ) {
+      warn $self->server. ':'. $self->port. $self->path. "\n";
+      $Net::SSLeay::trace = 2;
+    }
+    #post_https( $self->server, $self->port, $self->path,
+    #            $headers, make_form(%$post_data)  );
+
+    my $raw_data = ref($post_data) ? make_form(%$post_data) : $post_data;
+    post_https( $self->server, $self->port, $self->path,
+                $headers, $raw_data );
+
+  } 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;
+
+    my $res;
+    if ( ref($post_data) ) {
+      $res = $ua->request( POST( $url, [ %$post_data ] ) );
+    } else {
+      my $req =new HTTP::Request( 'POST' => $url );
+      $req->content_type('application/x-www-form-urlencoded');
+      $req->content($post_data);
+      $res = $ua->request($req);
+    }
+
+    #( $res->as_string, # wtf?
+    ( $res->content,
+      $res->code,
+      map { $_ => $res->header($_) } $res->header_field_names
+    );
+
+  } else {
+
+    die "unknown SSL module $ssl_module";
+
+  }
+
 }
 
 =back