From 1a6545d6f4fb91d9256f2bec4b1b2b0db483d373 Mon Sep 17 00:00:00 2001 From: plobbes Date: Mon, 12 Mar 2007 06:32:18 +0000 Subject: [PATCH] - ran code through perltidy - TODO: module could use cleanup to reduce duplication of code --- OnlinePayment/HTTPS.pm | 375 +++++++++++++++++++++++++------------------------ 1 file changed, 194 insertions(+), 181 deletions(-) diff --git a/OnlinePayment/HTTPS.pm b/OnlinePayment/HTTPS.pm index 9bbf28d..1a86a1b 100644 --- a/OnlinePayment/HTTPS.pm +++ b/OnlinePayment/HTTPS.pm @@ -7,36 +7,38 @@ use Tie::IxHash; use base qw(Business::OnlinePayment); $VERSION = '0.05_01'; -$VERSION = eval $VERSION; # modperlstyle: convert the string into a number +$VERSION = eval $VERSION; # modperlstyle: convert the string into a number $DEBUG = 0; BEGIN { - $ssl_module = ''; + $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 { - 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'; - }; + require LWP::UserAgent; + require HTTP::Request::Common; + require Crypt::SSLeay; - if ($@) { - eval { - require LWP::UserAgent; - require HTTP::Request::Common; - require Crypt::SSLeay; - #import HTTP::Request::Common qw(GET POST); - $ssl_module = '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"; - } + unless ($ssl_module) { + die "One of Net::SSLeay (v1.30 or later)" + . " or Crypt::SSLeay (+LWP) is required"; + } } @@ -46,30 +48,30 @@ Business::OnlinePayment::HTTPS - Base class for HTTPS payment APIs =head1 SYNOPSIS - package Business::OnlinePayment::MyProcessor + 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 ). @@ -79,193 +81,204 @@ It depends on Net::SSLeay _or_ ( Crypt::SSLeay and LWP::UserAgent ). =item https_get [ \%options ] 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. +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). -=cut +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. -sub https_get { - my $self = shift; +The options hashref supports setting headers and Content-Type: - # handle optional options hashref - my $opts; - if ( scalar(@_) > 1 and ref($_[0]) eq "HASH" ) { - $opts = shift; + { + headers => { 'X-Header1' => 'value', ... }, + Content-Type => 'text/namevalue', } - # 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"; - } - - $opts->{"Content-Type"} ||= "application/x-www-form-urlencoded"; - - ### XXX referer!!! - my %headers; - if ( ref( $opts->{headers} ) eq "HASH" ) { - %headers = %{ $opts->{headers} }; - } - $headers{'Host'} ||= $self->server; - - my $path = $self->path; - if ( keys %$post_data ) { - - #my $u = URI->new("", "https"); - #$u->query_param(%$post_data); - #$path .= '?'. $u->query; - - $path .= '?'. join('&', - map { uri_escape($_).'='. uri_escape($post_data->{$_}) } - keys %$post_data - ); - #warn $path; - - } +=cut - if ( $ssl_module eq 'Net::SSLeay' ) { +sub https_get { + my $self = shift; - import Net::SSLeay qw(get_https make_headers); - my $headers = make_headers(%headers); - get_https( $self->server, $self->port, $path, $headers, "", $opts->{"Content-Type"} ); + # handle optional options hashref + my $opts; + if ( scalar(@_) > 1 and ref( $_[0] ) eq "HASH" ) { + $opts = shift; + } - } elsif ( $ssl_module eq 'Crypt::SSLeay' ) { + # 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"; + } - import HTTP::Request::Common qw(GET); + $opts->{"Content-Type"} ||= "application/x-www-form-urlencoded"; - my $url = 'https://'. $self->server; - $url .= ':'. $self->port - unless $self->port == 443; - $url .= "/$path"; + ### XXX referer!!! + my %headers; + if ( ref( $opts->{headers} ) eq "HASH" ) { + %headers = %{ $opts->{headers} }; + } + $headers{'Host'} ||= $self->server; + + my $path = $self->path; + if ( keys %$post_data ) { + $path .= '?' + . join( '&', + map { uri_escape($_) . '=' . uri_escape( $post_data->{$_} ) } + keys %$post_data ); + } - my $ua = new LWP::UserAgent; - my $res = $ua->request( GET( $url ) ); + if ( $ssl_module eq 'Net::SSLeay' ) { - #( $res->as_string, # wtf? - ( $res->content, - $res->code, - map { $_ => $res->header($_) } $res->header_field_names - ); + import Net::SSLeay qw(get_https make_headers); + my $headers = make_headers(%headers); + get_https( $self->server, $self->port, $path, $headers, "", + $opts->{"Content-Type"} ); + } + elsif ( $ssl_module eq 'Crypt::SSLeay' ) { - } else { + import HTTP::Request::Common qw(GET); - die "unknown SSL module $ssl_module"; + my $url = 'https://' . $self->server; + $url .= ':' . $self->port + unless $self->port == 443; + $url .= "/$path"; - } + my $ua = new LWP::UserAgent; + my $res = $ua->request( GET($url) ); + ( + $res->content, $res->code, + map { $_ => $res->header($_) } $res->header_field_names + ); + } + else { + die "unknown SSL module $ssl_module"; + } } =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. - -=cut - -sub https_post { - my $self = shift; +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. - # handle optional options hashref - my $opts; - if ( scalar(@_) > 1 and ref($_[0]) eq "HASH" ) { - $opts = shift; - } +The options hashref supports setting headers and Content-Type: - # 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"; + { + headers => { 'X-Header1' => 'value', ... }, + Content-Type => 'text/namevalue', } - $opts->{"Content-Type"} ||= "application/x-www-form-urlencoded"; +=cut - ### XXX referer!!! - my %headers; - if ( ref( $opts->{headers} ) eq "HASH" ) { - %headers = %{ $opts->{headers} }; - } - $headers{'Host'} ||= $self->server; +sub https_post { + my $self = shift; - if ( $DEBUG && ref($post_data) ) { - warn "post data:\n", join('', map { " $_ => ". $post_data->{$_}. "\n" } keys %$post_data ); - } + # handle optional options hashref + my $opts; + if ( scalar(@_) > 1 and ref( $_[0] ) eq "HASH" ) { + $opts = shift; + } - if ( $ssl_module eq 'Net::SSLeay' ) { + # 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"; + } - import Net::SSLeay qw(post_https make_headers make_form); - my $headers = make_headers(%headers); + $opts->{"Content-Type"} ||= "application/x-www-form-urlencoded"; - if ( $DEBUG ) { - no warnings 'uninitialized'; - warn $self->server. ':'. $self->port. $self->path. "\n"; - $Net::SSLeay::trace = $DEBUG; + ### XXX referer!!! + my %headers; + if ( ref( $opts->{headers} ) eq "HASH" ) { + %headers = %{ $opts->{headers} }; } + $headers{'Host'} ||= $self->server; - my $raw_data = ref($post_data) ? make_form(%$post_data) : $post_data; - post_https( $self->server, $self->port, $self->path, - $headers, $raw_data, $opts->{"Content-Type"} ); + if ( $DEBUG && ref($post_data) ) { + warn "post data:\n", + join( '', + map { " $_ => " . $post_data->{$_} . "\n" } keys %$post_data ); + } - } elsif ( $ssl_module eq 'Crypt::SSLeay' ) { + if ( $ssl_module eq 'Net::SSLeay' ) { - import HTTP::Request::Common qw(POST); + import Net::SSLeay qw(post_https make_headers make_form); + my $headers = make_headers(%headers); - my $url = 'https://'. $self->server; - $url .= ':'. $self->port - unless $self->port == 443; - $url .= $self->path; + if ($DEBUG) { + no warnings 'uninitialized'; + warn $self->server . ':' . $self->port . $self->path . "\n"; + $Net::SSLeay::trace = $DEBUG; + } - if ( $DEBUG ) { - warn $url; + my $raw_data = ref($post_data) ? make_form(%$post_data) : $post_data; + post_https( $self->server, $self->port, $self->path, $headers, + $raw_data, $opts->{"Content-Type"} ); } + elsif ( $ssl_module eq 'Crypt::SSLeay' ) { - my $ua = new LWP::UserAgent; + import HTTP::Request::Common qw(POST); - my $res; - if ( ref($post_data) ) { - $res = $ua->request( POST( $url, [ %$post_data ] ) ); - } else { - my $req =new HTTP::Request( 'POST' => $url ); - $req->content_type( $opts->{"Content-Type"} ); - $req->content($post_data); - $res = $ua->request($req); - } + my $url = 'https://' . $self->server; + $url .= ':' . $self->port + unless $self->port == 443; + $url .= $self->path; - #( $res->as_string, # wtf? - ( $res->content, - $res->code, - map { $_ => $res->header($_) } $res->header_field_names - ); - - } else { + if ($DEBUG) { + warn $url; + } - die "unknown SSL module $ssl_module"; + my $ua = new LWP::UserAgent; - } + my $res; + if ( ref($post_data) ) { + $res = $ua->request( POST( $url, [%$post_data] ) ); + } + else { + my $req = new HTTP::Request( 'POST' => $url ); + $req->content_type( $opts->{"Content-Type"} ); + $req->content($post_data); + $res = $ua->request($req); + } + ( + $res->content, $res->code, + map { $_ => $res->header($_) } $res->header_field_names + ); + } + else { + die "unknown SSL module $ssl_module"; + } } =back -- 2.11.0