X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=OnlinePayment%2FHTTPS.pm;h=7248cd76fad516acb09e781e95ca06cf34f39c88;hb=06aef4f2a899ed6d6aaaf77c23567aea7db8847c;hp=4c8336fb0eea9f88c96c8d46a61b7dcc661a62ac;hpb=09de1aa7b1c5a33a0178aaae4bc252df152d8b2f;p=Business-OnlinePayment.git diff --git a/OnlinePayment/HTTPS.pm b/OnlinePayment/HTTPS.pm index 4c8336f..7248cd7 100644 --- a/OnlinePayment/HTTPS.pm +++ b/OnlinePayment/HTTPS.pm @@ -1,47 +1,13 @@ package Business::OnlinePayment::HTTPS; use strict; -use vars qw($VERSION @ISA $DEBUG $ssl_module $skip_NetSSLeay); -#use URI; -#use URI::QueryParam; -use URI::Escape; +use base qw(Business::OnlinePayment); +use vars qw($VERSION $DEBUG); use Tie::IxHash; +use Net::HTTPS::Any 0.10; -@ISA = qw( Business::OnlinePayment ); - -$VERSION = '0.04'; - -$DEBUG = 0; - -BEGIN { - - $ssl_module = ''; - - 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'; - }; - - if ($@) { - eval { - require LWP::UserAgent; - require HTTP::Request::Common; - require Crypt::SSLeay; - #import HTTP::Request::Common qw(GET POST); - $ssl_module = 'Crypt::SSLeay'; - }; - } - - unless ( $ssl_module ) { - die "One of Net::SSLeay (v1.30 or later)". - " or Crypt::SSLeay (+LWP) is required"; - } - -} +$VERSION = '0.10'; +$DEBUG = 0; =head1 NAME @@ -49,212 +15,168 @@ Business::OnlinePayment::HTTPS - Base class for HTTPS payment APIs =head1 SYNOPSIS - package Business::OnlinePayment::MyProcessor - @ISA = qw( Business::OnlinePayment::HTTPS ); - + package Business::OnlinePayment::MyProcessor; + use base qw(Business::OnlinePayment::HTTPS); + sub submit { - my $self = shift; - - #... - - # pass a list (order is preserved, if your gateway needs that) - ($page, $response, %reply_headers) - = $self->https_get( field => 'value', ... ); - - #or a hashref - my %hash = ( field => 'value', ... ); - ($page, $response_code, %reply_headers) + my $self = shift; + + #... + + # pass a list (order is preserved, if your gateway needs that) + ( $page, $response, %reply_headers ) + = $self->https_get( field => 'value', ... ); + + # or a hashref + my %hash = ( field => 'value', ... ); + ( $page, $response_code, %reply_headers ) = $self->https_get( \%hash ); - - #... + + #... } =head1 DESCRIPTION -This is a base class for HTTPS based gateways, providing useful code for -implementors of HTTPS payment APIs. +This is a base class for HTTPS based gateways, providing useful code +for implementors of HTTPS payment APIs. -It depends on Net::SSLeay _or_ ( Crypt::SSLeay and LWP::UserAgent ). +It depends on Net::HTTPS::Any, which in turn depends on +Net::SSLeay _or_ ( Crypt::SSLeay and LWP::UserAgent ). =head1 METHODS =over 4 -=item https_get HASHREF | FIELD => VALUE, ... - -Accepts parameters as either a hashref or a list of fields and values. In the -latter case, ordering is preserved (see L to do so when passing a -hashref). - -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_get { - my $self = shift; - - #accept a hashref or a list (keep it ordered) - my $post_data; - if ( ref($_[0]) ) { - $post_data = shift; - } else { - tie my %hash, 'Tie::IxHash', @_; - $post_data = \%hash; - } +=item https_get [ \%options ] HASHREF | FIELD => VALUE, ... - my $path = $self->path; - if ( keys %$post_data ) { +Accepts parameters as either a hashref or a list of fields and values. +In the latter case, ordering is preserved (see L to do so +when passing a hashref). - #my $u = URI->new("", "https"); - #$u->query_param(%$post_data); - #$path .= '?'. $u->query; +Returns a list consisting of the page content as a string, the HTTP +response code and message (i.e. "200 OK" or "404 Not Found"), and a list of +key/value pairs representing the HTTP response headers. - $path .= '?'. join('&', - map { uri_escape($_).'='. uri_escape($post_data->{$_}) } - keys %$post_data - ); - #warn $path; +The options hashref supports setting headers: + { + headers => { 'X-Header1' => 'value', ... }, } - my $referer = ''; ### XXX referer!!! - my %headers; - $headers{'Referer'} = $referer if length($referer); - - if ( $ssl_module eq 'Net::SSLeay' ) { +=cut - import Net::SSLeay qw(get_https make_headers); - my $headers = make_headers(%headers); - get_https( $self->server, $self->port, $path, $referer, $headers ); +# Content-Type => 'text/namevalue', - } elsif ( $ssl_module eq 'Crypt::SSLeay' ) { +sub https_get { + my $self = shift; - import HTTP::Request::Common qw(GET); + # handle optional options hashref + my $opts = {}; + if ( scalar(@_) > 1 and ref( $_[0] ) eq "HASH" ) { + $opts = shift; + } - my $url = 'https://'. $self->server; - $url .= ':'. $self->port - unless $self->port == 443; - $url .= "/$path"; + # 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_get called with no params\n"; + } - my $ua = new LWP::UserAgent; - my $res = $ua->request( GET( $url ) ); + $self->build_subs(qw( response_page response_code response_headers )); - #( $res->as_string, # wtf? - ( $res->content, - $res->code, - map { $_ => $res->header($_) } $res->header_field_names + my( $res_page, $res_code, @res_headers) = Net::HTTPS::Any::https_get( + 'host' => $self->server, + 'path' => $self->path, + 'headers' => $opts->{headers}, + 'args' => $post_data, + 'debug' => $DEBUG, ); - } else { - - die "unknown SSL module $ssl_module"; + $self->response_page( $res_page ); + $self->response_code( $res_code ); + $self->response_headers( { @res_headers } ); - } + ( $res_page, $res_code, @res_headers ); } -=item https_post SCALAR | HASHREF | FIELD => VALUE, ... +=item https_post [ \%options ] SCALAR | HASHREF | FIELD => VALUE, ... -Accepts form fields and values as either a hashref or a list. In the latter -case, ordering is preserved (see L to do so when passing a -hashref). +Accepts form fields and values as either a hashref or a list. In the +latter case, ordering is preserved (see L 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. +Returns a list consisting of the page content as a string, the HTTP +response code and message (i.e. "200 OK" or "404 Not Found"), and a list of +key/value pairs representing the HTTP response headers. -=cut - -sub https_post { - my $self = shift; - - #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; +The options hashref supports setting headers and Content-Type: - if ( $DEBUG && ref($post_data) ) { - warn join('', map { " $_ => ". $post_data->{$_}. "\n" } keys %$post_data ); + { + headers => { 'X-Header1' => 'value', ... }, + Content-Type => 'text/namevalue', } - if ( $ssl_module eq 'Net::SSLeay' ) { - - #import Net::SSLeay qw(post_https make_headers make_form); - import Net::SSLeay qw(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); +=cut - my $url = 'https://'. $self->server; - $url .= ':'. $self->port - unless $self->port == 443; - $url .= $self->path; +sub https_post { + my $self = shift; - if ( $DEBUG ) { - warn $url; + # handle optional options hashref + my $opts = {}; + if ( scalar(@_) > 1 and ref( $_[0] ) eq "HASH" ) { + $opts = shift; } - my $ua = new LWP::UserAgent; + my %post = ( + 'host' => $self->server, + 'path' => $self->path, + 'headers' => $opts->{headers}, + 'Content-Type' => $opts->{'Content-Type'}, + 'debug' => $DEBUG, + ); - my $res; - if ( ref($post_data) ) { - $res = $ua->request( POST( $url, [ %$post_data ] ) ); + # accept a hashref or a list (keep it ordered) + my $post_data = ''; + my $content = undef; + if ( ref( $_[0] ) eq 'HASH' ) { + $post{'args'} = shift; + } elsif ( scalar(@_) > 1 ) { + tie my %hash, 'Tie::IxHash', @_; + $post{'args'} = \%hash; + } elsif ( scalar(@_) == 1 ) { + $post{'content'} = shift; } else { - my $req =new HTTP::Request( 'POST' => $url ); - $req->content_type('application/x-www-form-urlencoded'); - $req->content($post_data); - $res = $ua->request($req); + die "https_post called with no params\n"; } - #( $res->as_string, # wtf? - ( $res->content, - $res->code, - map { $_ => $res->header($_) } $res->header_field_names - ); + $self->build_subs(qw( response_page response_code response_headers )); - } else { + my( $res_page, $res_code, @res_headers)= Net::HTTPS::Any::https_post(%post); - die "unknown SSL module $ssl_module"; + $self->response_page( $res_page ); + $self->response_code( $res_code ); + $self->response_headers( { @res_headers } ); - } + ( $res_page, $res_code, @res_headers ); } =back -=head1 SEE ALSO +=head1 SEE ALSO -L +L, L =cut 1; -