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";
+ }
}
=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 ).
=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<Tie::IxHash> 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<Tie::IxHash> 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<Tie::IxHash> 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<Tie::IxHash> 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
projects / Business-OnlinePayment.git / blobdiff