OnlinePayment/HTTPS.pm

   1 package Business::OnlinePayment::HTTPS;
   2
   3 use strict;
   4 use vars qw($VERSION @ISA $DEBUG $ssl_module $skip_NetSSLeay);
   5 #use URI;
   6 #use URI::QueryParam;
   7 use URI::Escape;
   8 use Tie::IxHash;
   9
  10 @ISA = qw( Business::OnlinePayment );
  11
  12 $VERSION = '0.04';
  13
  14 $DEBUG = 0;
  15
  16 BEGIN {
  17
  18         $ssl_module = '';
  19
  20         eval {
  21                 die if defined($skip_NetSSLeay) && $skip_NetSSLeay;
  22                 require Net::SSLeay;
  23                 Net::SSLeay->VERSION(1.30);
  24                 #import Net::SSLeay
  25                 #  qw(get_https post_https make_form make_headers);
  26                 $ssl_module = 'Net::SSLeay';
  27         };
  28
  29         if ($@) {
  30                 eval {
  31                         require LWP::UserAgent;
  32                         require HTTP::Request::Common;
  33                         require Crypt::SSLeay;
  34                         #import HTTP::Request::Common qw(GET POST);
  35                         $ssl_module = 'Crypt::SSLeay';
  36                 };
  37         }
  38
  39         unless ( $ssl_module ) {
  40                 die "One of Net::SSLeay (v1.30 or later)".
  41                     " or Crypt::SSLeay (+LWP) is required";
  42         }
  43
  44 }
  45
  46 =head1 NAME
  47
  48 Business::OnlinePayment::HTTPS - Base class for HTTPS payment APIs
  49
  50 =head1 SYNOPSIS
  51
  52   package Business::OnlinePayment::MyProcessor
  53   @ISA = qw( Business::OnlinePayment::HTTPS );
  54
  55   sub submit {
  56           my $self = shift;
  57
  58           #...
  59
  60           # pass a list (order is preserved, if your gateway needs that)
  61           ($page, $response, %reply_headers)
  62             = $self->https_get( field => 'value', ... );
  63
  64           #or a hashref
  65           my %hash = ( field => 'value', ... );
  66           ($page, $response_code, %reply_headers)
  67             = $self->https_get( \%hash );
  68
  69           #...
  70   }
  71
  72 =head1 DESCRIPTION
  73
  74 This is a base class for HTTPS based gateways, providing useful code for
  75 implementors of HTTPS payment APIs.
  76
  77 It depends on Net::SSLeay _or_ ( Crypt::SSLeay and LWP::UserAgent ).
  78
  79 =head1 METHODS
  80
  81 =over 4
  82
  83 =item https_get HASHREF | FIELD => VALUE, ...
  84
  85 Accepts parameters as either a hashref or a list of fields and values.  In the
  86 latter case, ordering is preserved (see L<Tie::IxHash> to do so when passing a
  87 hashref).
  88
  89 Returns a list consisting of the page content as a string, the HTTP response
  90 code, and a list of key/value pairs representing the HTTP response headers.
  91
  92 =cut
  93
  94 sub https_get {
  95   my $self = shift;
  96
  97   #accept a hashref or a list (keep it ordered)
  98   my $post_data;
  99   if ( ref($_[0]) ) {
 100     $post_data = shift;
 101   } else {
 102     tie my %hash, 'Tie::IxHash', @_;
 103     $post_data = \%hash;
 104   }
 105
 106   my $path = $self->path;
 107   if ( keys %$post_data ) {
 108
 109     #my $u = URI->new("", "https");
 110     #$u->query_param(%$post_data);
 111     #$path .= '?'. $u->query;
 112
 113     $path .= '?'. join('&',
 114       map { uri_escape($_).'='. uri_escape($post_data->{$_}) }
 115       keys %$post_data
 116     );
 117     #warn $path;
 118
 119   }
 120
 121   my $referer = ''; ### XXX referer!!!
 122   my %headers;
 123   $headers{'Referer'} = $referer if length($referer);
 124
 125   if ( $ssl_module eq 'Net::SSLeay' ) {
 126
 127     import Net::SSLeay qw(get_https make_headers);
 128     my $headers = make_headers(%headers);
 129     get_https( $self->server, $self->port, $path, $referer, $headers );
 130
 131   } elsif ( $ssl_module eq 'Crypt::SSLeay' ) {
 132
 133     import HTTP::Request::Common qw(GET);
 134
 135     my $url = 'https://'. $self->server;
 136     $url .= ':'. $self->port
 137       unless $self->port == 443;
 138     $url .= "/$path";
 139
 140     my $ua = new LWP::UserAgent;
 141     my $res = $ua->request( GET( $url ) );
 142
 143     #( $res->as_string, # wtf?
 144     ( $res->content,
 145       $res->code,
 146       map { $_ => $res->header($_) } $res->header_field_names
 147     );
 148
 149   } else {
 150
 151     die "unknown SSL module $ssl_module";
 152
 153   }
 154
 155 }
 156
 157 =item https_post SCALAR | HASHREF | FIELD => VALUE, ...
 158
 159 Accepts form fields and values as either a hashref or a list.  In the latter
 160 case, ordering is preserved (see L<Tie::IxHash> to do so when passing a
 161 hashref).
 162
 163 Also accepts instead a simple scalar containing the raw content.
 164
 165 Returns a list consisting of the page content as a string, the HTTP response
 166 code, and a list of key/value pairs representing the HTTP response headers.
 167
 168 =cut
 169
 170 sub https_post {
 171   my $self = shift;
 172
 173   #accept a hashref or a list (keep it ordered)
 174   my $post_data;
 175   if ( ref($_[0]) eq 'HASH' ) {
 176     $post_data = shift;
 177   } elsif ( scalar(@_) > 1 ) {
 178     tie my %hash, 'Tie::IxHash', @_;
 179     $post_data = \%hash;
 180   } elsif ( scalar(@_) == 1 ) {
 181     $post_data = shift;
 182   } else {
 183     die "https_post called with no params\n";
 184   }
 185
 186   my $referer = ''; ### XXX referer!!!
 187   my %headers;
 188   $headers{'Referer'} = $referer if length($referer);
 189   $headers{'Host'} = $self->server;
 190
 191   if ( $DEBUG && ref($post_data) ) {
 192     warn join('', map { "  $_ => ". $post_data->{$_}. "\n" } keys %$post_data );
 193   }
 194
 195   if ( $ssl_module eq 'Net::SSLeay' ) {
 196
 197     #import Net::SSLeay qw(post_https make_headers make_form);
 198     import Net::SSLeay qw(make_headers make_form);
 199     my $headers = make_headers(%headers);
 200
 201     if ( $DEBUG ) {
 202       warn $self->server. ':'. $self->port. $self->path. "\n";
 203       $Net::SSLeay::trace = 2;
 204     }
 205     #post_https( $self->server, $self->port, $self->path,
 206     #            $headers, make_form(%$post_data)  );
 207
 208     my $raw_data = ref($post_data) ? make_form(%$post_data) : $post_data;
 209     post_https( $self->server, $self->port, $self->path,
 210                 $headers, $raw_data );
 211
 212   } elsif ( $ssl_module eq 'Crypt::SSLeay' ) {
 213
 214     import HTTP::Request::Common qw(POST);
 215
 216     my $url = 'https://'. $self->server;
 217     $url .= ':'. $self->port
 218       unless $self->port == 443;
 219     $url .= $self->path;
 220
 221     if ( $DEBUG ) {
 222       warn $url;
 223     }
 224
 225     my $ua = new LWP::UserAgent;
 226
 227     my $res;
 228     if ( ref($post_data) ) {
 229       $res = $ua->request( POST( $url, [ %$post_data ] ) );
 230     } else {
 231       my $req =new HTTP::Request( 'POST' => $url );
 232       $req->content_type('application/x-www-form-urlencoded');
 233       $req->content($post_data);
 234       $res = $ua->request($req);
 235     }
 236
 237     #( $res->as_string, # wtf?
 238     ( $res->content,
 239       $res->code,
 240       map { $_ => $res->header($_) } $res->header_field_names
 241     );
 242
 243   } else {
 244
 245     die "unknown SSL module $ssl_module";
 246
 247   }
 248
 249 }
 250
 251 =back
 252
 253 =head1 SEE ALSO
 254
 255 L<Business::OnlinePayment>
 256
 257 =cut
 258
 259 1;
 260