OnlinePayment/HTTPS.pm

   1 package Business::OnlinePayment::HTTPS;
   2
   3 use strict;
   4 use vars qw($VERSION @ISA $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.01';
  13
  14 BEGIN {
  15
  16         $ssl_module = '';
  17
  18         eval {
  19                 die if defined($skip_NetSSLeay) && $skip_NetSSLeay;
  20                 require Net::SSLeay;
  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 "Net::SSLeay (+URI) or Crypt::SSLeay (+LWP) is required";
  38         }
  39
  40 }
  41
  42 =head1 NAME
  43
  44 Business::OnlinePayment::HTTPS - Base class for HTTPS payment APIs
  45
  46 =head1 SYNOPSIS
  47
  48   package Business::OnlinePayment::MyProcessor
  49   @ISA = qw( Business::OnlinePayment::HTTPS );
  50
  51   sub submit {
  52           my $self = shift;
  53
  54           #...
  55
  56           # pass a list (order is preserved, if your gateway needs that)
  57           ($page, $response, %reply_headers)
  58             = $self->https_get( field => 'value', ... );
  59
  60           #or a hashref
  61           my %hash = ( field => 'value', ... );
  62           ($page, $response_code, %reply_headers)
  63             = $self->https_get( $hashref );
  64
  65           #...
  66   }
  67
  68 =head1 DESCRIPTION
  69
  70 This is a base class for HTTPS based gateways, providing useful code for
  71 implementors of HTTPS payment APIs.
  72
  73 It depends on Net::SSLeay _or_ ( Crypt::SSLeay and LWP::UserAgent ).
  74
  75 =head1 METHODS
  76
  77 =over 4
  78
  79 =item https_get HASHREF | FIELD => VALUE, ...
  80
  81 Accepts parameters as either a hashref or a list of fields and values.  In the
  82 latter case, ordering is preserved (see L<Tie::IxHash> to do so when passing a
  83 hashref).
  84
  85 Returns a list consisting of the page content as a string, the HTTP response
  86 code, and a list of key/value pairs representing the HTTP response headers.
  87
  88 =cut
  89
  90 sub https_get {
  91   my $self = shift;
  92
  93   #accept a hashref or a list (keep it ordered)
  94   my $post_data;
  95   if ( ref($_[0]) ) {
  96     $post_data = shift;
  97   } else {
  98     tie my %hash, 'Tie::IxHash', @_;
  99     $post_data = \%hash;
 100   }
 101
 102   my $path = $self->path;
 103   if ( keys %$post_data ) {
 104
 105     #my $u = URI->new("", "https");
 106     #$u->query_param(%$post_data);
 107     #$path .= '?'. $u->query;
 108
 109     $path .= '?'. join('&',
 110       map { uri_escape($_).'='. uri_escape($post_data->{$_}) }
 111       keys %$post_data
 112     );
 113     #warn $path;
 114
 115   }
 116
 117   my $referer = ''; ### XXX referer!!!
 118   my %headers;
 119   $headers{'Referer'} = $referer if length($referer);
 120
 121   if ( $ssl_module eq 'Net::SSLeay' ) {
 122
 123     import Net::SSLeay qw(get_https make_headers);
 124     my $headers = make_headers(%headers);
 125     get_https( $self->server, $self->port, $path, $referer, $headers );
 126
 127   } elsif ( $ssl_module eq 'Crypt::SSLeay' ) {
 128
 129     import HTTP::Request::Common qw(GET);
 130
 131     my $ua = new LWP::UserAgent;
 132     my $res = $ua->request(
 133       GET( 'https://'. $self->server. ':'. $self->port. '/'. $path )
 134     );
 135
 136     #( $res->as_string, # wtf?
 137     ( $res->content,
 138       $res->code,
 139       map { $_ => $res->header($_) } $res->header_field_names
 140     );
 141
 142   } else {
 143
 144     die "unknown SSL module $ssl_module";
 145
 146   }
 147
 148 }
 149
 150 =item https_post
 151
 152 Not yet implemented
 153
 154 =cut
 155
 156 sub https_post {
 157   my $self = shift;
 158
 159   die "not yet implemented";
 160 }
 161
 162 =back
 163
 164 =head1 SEE ALSO
 165
 166 L<Business::OnlinePayment>
 167
 168 =cut
 169
 170 1;
 171