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