OnlinePayment/HTTPS.pm

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