initial importSTART

13 files changed, 651 insertions, 0 deletions

diff --git a/.cvsignore b/.cvsignore
new file mode 100644
index 0000000..c913efe
--- /dev/null
+++ b/.cvsignore
@@ -0,0 +1,10 @@
+blib*
+Makefile
+Makefile.old
+Build
+_build*
+pm_to_blib*
+*.tar.gz
+.lwpcookies
+Net-HTTPS-Any-*
+cover_db
diff --git a/Changes b/Changes
new file mode 100644
index 0000000..32caa87
--- /dev/null
+++ b/Changes
@@ -0,0 +1,6 @@
+Revision history for Net-HTTPS-Any
+
+0.09    unrelesed
+        First version numbered 0.09
+        (based on Business::OnlinePayment::HTTPS 0.08)
+
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..2fb0be3
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,12 @@
+Changes
+MANIFEST
+Makefile.PL
+README
+lib/Net/HTTPS/Any.pm
+t/00-load.t
+t/get-cryptssleay.t
+t/get-netssleay.t
+t/pod-coverage.t
+t/pod.t
+t/post-cryptssleay.t
+t/post-netssleay.t
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..c6dbbc8
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,18 @@
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+    NAME                => 'Net::HTTPS::Any',
+    AUTHOR              => 'Ivan Kohler <ivan-net-https-any@freeside.biz>',
+    VERSION_FROM        => 'lib/Net/HTTPS/Any.pm',
+    ABSTRACT_FROM       => 'lib/Net/HTTPS/Any.pm',
+    PL_FILES            => {},
+    PREREQ_PM => {
+        'Test::More'  => 0,
+        'URI::Escape' => 0,
+        'Tie::IxHash' => 0,
+    },
+    dist                => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
+    clean               => { FILES => 'Net-HTTPS-Any-*' },
+);
diff --git a/README b/README
new file mode 100644
index 0000000..8d67ccb
--- /dev/null
+++ b/README
@@ -0,0 +1,45 @@
+Net-HTTPS-Any
+
+This module will make an HTTPS connection using Net::SSLeay or ( Crypt::SSLeay
+and LWP), whatever is available on the current system.
+
+It is derived from Business::OnlinePayment::HTTPS.
+
+INSTALLATION
+
+To install this module, run the following commands:
+
+	perl Makefile.PL
+	make
+	make test
+	make install
+
+SUPPORT AND DOCUMENTATION
+
+After installing, you can find documentation for this module with the
+perldoc command.
+
+    perldoc Net::HTTPS::Any
+
+You can also look for information at:
+
+    RT, CPAN's request tracker
+        http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-HTTPS-Any
+
+    AnnoCPAN, Annotated CPAN documentation
+        http://annocpan.org/dist/Net-HTTPS-Any
+
+    CPAN Ratings
+        http://cpanratings.perl.org/d/Net-HTTPS-Any
+
+    Search CPAN
+        http://search.cpan.org/dist/Net-HTTPS-Any
+
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2008 Freeside Internet Services, Inc.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
diff --git a/lib/Net/HTTPS/Any.pm b/lib/Net/HTTPS/Any.pm
new file mode 100644
index 0000000..c65c7d9
--- /dev/null
+++ b/lib/Net/HTTPS/Any.pm
@@ -0,0 +1,367 @@
+package Net::HTTPS::Any;
+
+use warnings;
+use strict;
+use vars qw(@EXPORT_OK $ssl_module $skip_NetSSLeay);
+use Exporter;
+use URI::Escape;
+use Tie::IxHash;
+
+@EXPORT_OK = qw( https_get https_post );
+
+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";
+    }
+
+}
+
+=head1 NAME
+
+Net::HTTPS::Any - Simple HTTPS class using whatever underlying module is available
+
+=head1 VERSION
+
+Version 0.09
+
+=cut
+
+our $VERSION = '0.09';
+
+=head1 SYNOPSIS
+
+  use Net::HTTPS::Any qw(https_get https_post);
+  
+  ( $page, $response, %reply_headers )
+      = https_get(
+                   { 'host' => 'secure.sisd.com',
+                     'port' => 443,
+                     'path' => '/freeside/index.html',
+                     'args' => { 'field' => 'value' },
+                     #'args' => [ 'field'=>'value' ], #order preserved
+                   },
+                 );
+
+  ( $page, $response, %reply_headers )
+      = https_post(
+                    'host' => 'secure.sisd.com',
+                    'port' => 443,
+                    'path' => '/freeside/index.html',
+                    'args' => { 'field' => 'value' },
+                    #'args' => [ 'field'=>'value' ], #order preserved
+                  );
+  
+  #...
+
+=head1 DESCRIPTION
+
+This is a simple wrapper around either of the two available SSL
+modules.
+
+It depends on Net::SSLeay _or_ ( Crypt::SSLeay and LWP::UserAgent ).
+
+=head1 FUNCTIONS
+
+=head2 https_get HASHREF | FIELD => VALUE, ...
+
+Accepts parameters as either a hashref or a list of fields and values.
+
+Parameters are:
+
+=over 4
+
+=item host
+
+=item port
+
+=item path
+
+=item headers (hashref)
+
+For example: { 'X-Header1' => 'value', ... }
+
+=item Content-Type
+
+For example: 'text/namevalue',
+
+=item args
+
+CGI arguments, eitehr as a hashref or a listref.  In the latter case, ordering
+is preserved (see L<Tie::IxHash> to do so when passing a hashref).
+
+=back
+
+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_get {
+    my $opts = ref($_[0]) ? shift : { @_ }; #hashref or list
+
+    # accept a hashref or a list (keep it ordered)
+    my $post_data = {};
+    if (      exists($opts->{'args'}) && ref($opts->{'args'}) eq 'HASH'  ) {
+        $post_data = shift;
+    } elsif ( exists($opts->{'args'}) && ref($opts->{'args'}) eq 'ARRAY' ) {
+        tie my %hash, 'Tie::IxHash', @{ $opts->{'args'} };
+        $post_data = \%hash;
+    }
+
+    $opts->{"Content-Type"} ||= "application/x-www-form-urlencoded";
+
+    ### XXX referer!!!
+    my %headers = ();
+    if ( ref( $opts->{headers} ) eq "HASH" ) {
+        %headers = %{ $opts->{headers} };
+    }
+    $headers{'Host'} ||= $opts->{'host'};
+
+    my $path = $opts->{'path'};
+    if ( keys %$post_data ) {
+        $path .= '?'
+          . join( ';',
+            map { uri_escape($_) . '=' . uri_escape( $post_data->{$_} ) }
+              keys %$post_data );
+    }
+
+    if ( $ssl_module eq 'Net::SSLeay' ) {
+
+        import Net::SSLeay qw(get_https make_headers);
+        my $headers = make_headers(%headers);
+
+        my( $res_page, $res_code, @res_headers ) =
+          get_https( $opts->{'host'},
+                     $opts->{'port'},
+                     $path,
+                     $headers,
+                     "",
+                     $opts->{"Content-Type"},
+                   );
+
+        return ( $res_page, $res_code, @res_headers );
+
+    } elsif ( $ssl_module eq 'Crypt::SSLeay' ) {
+
+        import HTTP::Request::Common qw(GET);
+
+        my $url = 'https://' . $opts->{'host'};
+        $url .= ':' . $opts->{'port'}
+          unless $opts->{'port'} == 443;
+        $url .= "/$path";
+
+        my $ua = new LWP::UserAgent;
+        foreach my $hdr ( keys %headers ) {
+            $ua->default_header( $hdr => $headers{$hdr} );
+        }
+        my $res = $ua->request( GET($url) );
+
+        my @res_headers = map { $_ => $res->header($_) }
+                              $res->header_field_names;
+
+        return ( $res->content, $res->code. ' '. $res->message, @res_headers );
+
+    } else {
+        die "unknown SSL module $ssl_module";
+    }
+
+}
+
+=head2 https_post HASHREF | FIELD => VALUE, ...
+
+Accepts parameters as either a hashref or a list of fields and values.
+
+Parameters are:
+
+=over 4
+
+=item host
+
+=item port
+
+=item path
+
+=item headers (hashref)
+
+For example: { 'X-Header1' => 'value', ... }
+
+=item Content-Type
+
+For example: 'text/namevalue',
+
+=item args
+
+CGI arguments, eitehr as a hashref or a listref.  In the latter case, ordering
+is preserved (see L<Tie::IxHash> to do so when passing a hashref).
+
+=item content
+
+Raw content (overrides args).  A simple scalar containing the raw content.
+
+
+=back
+
+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 $opts = ref($_[0]) ? shift : { @_ }; #hashref or list
+
+    # accept a hashref or a list (keep it ordered).  or a scalar of content.
+    my $post_data = '';
+    if (      exists($opts->{'args'}) && ref($opts->{'args'}) eq 'HASH'  ) {
+        $post_data = shift;
+    } elsif ( exists($opts->{'args'}) && ref($opts->{'args'}) eq 'ARRAY' ) {
+        tie my %hash, 'Tie::IxHash', @{ $opts->{'args'} };
+        $post_data = \%hash;
+    }
+    if ( exists $opts->{'content'} ) {
+        $post_data = $opts->{'content'};
+    }
+
+    $opts->{"Content-Type"} ||= "application/x-www-form-urlencoded";
+
+    ### XXX referer!!!
+    my %headers;
+    if ( ref( $opts->{headers} ) eq "HASH" ) {
+        %headers = %{ $opts->{headers} };
+    }
+    $headers{'Host'} ||= $opts->{'host'};
+
+    if ( $ssl_module eq 'Net::SSLeay' ) {
+
+        import Net::SSLeay qw(post_https make_headers make_form);
+        my $headers = make_headers(%headers);
+
+        my $raw_data = ref($post_data) ? make_form(%$post_data) : $post_data;
+
+        my( $res_page, $res_code, @res_headers ) =
+          post_https( $opts->{'host'},
+                      $opts->{'port'},
+                      $opts->{'path'},
+                      $headers,
+                      $raw_data,
+                      $opts->{"Content-Type"},
+                    );
+
+        return ( $res_page, $res_code, @res_headers );
+
+    } elsif ( $ssl_module eq 'Crypt::SSLeay' ) {
+
+        import HTTP::Request::Common qw(POST);
+
+        my $url = 'https://' . $opts->{'host'};
+        $url .= ':' . $opts->{'port'}
+          unless $opts->{'port'} == 443;
+        $url .= $opts->{'path'};
+
+        my $ua = new LWP::UserAgent;
+        foreach my $hdr ( keys %headers ) {
+            $ua->default_header( $hdr => $headers{$hdr} );
+        }
+
+        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 @res_headers = map { $_ => $res->header($_) }
+                              $res->header_field_names;
+
+        return ( $res->content, $res->code. ' '. $res->message, @res_headers );
+
+    } else {
+        die "unknown SSL module $ssl_module";
+    }
+
+}
+
+=head1 AUTHOR
+
+Ivan Kohler, C<< <ivan-net-https-any at freeside.biz> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-net-https-any at rt.cpan.org>, or through
+the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-HTTPS-Any>.  I will be notified, and then you'll
+automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc Net::HTTPS::Any
+
+
+You can also look for information at:
+
+=over 4
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-HTTPS-Any>
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/Net-HTTPS-Any>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/Net-HTTPS-Any>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/Net-HTTPS-Any>
+
+=back
+
+
+=head1 ACKNOWLEDGEMENTS
+
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2008 Freeside Internet Services, Inc. (http://freeside.biz/)
+All rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/t/00-load.t b/t/00-load.t
new file mode 100644
index 0000000..b986555
--- /dev/null
+++ b/t/00-load.t
@@ -0,0 +1,9 @@
+#!perl -T
+
+use Test::More tests => 1;
+
+BEGIN {
+	use_ok( 'Net::HTTPS::Any' );
+}
+
+diag( "Testing Net::HTTPS::Any $Net::HTTPS::Any::VERSION, Perl $], $^X" );
diff --git a/t/get-cryptssleay.t b/t/get-cryptssleay.t
new file mode 100644
index 0000000..2b3babe
--- /dev/null
+++ b/t/get-cryptssleay.t
@@ -0,0 +1,41 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More;
+
+BEGIN {
+  $Business::OnlinePayment::HTTPS::skip_NetSSLeay=1;
+  $Business::OnlinePayment::HTTPS::skip_NetSSLeay=1;
+}
+
+plan( tests=>4 );
+
+use_ok 'Net::HTTPS::Any';
+
+#200
+
+my($content, $response, %headers) = Net::HTTPS::Any::https_get(
+  { 'host' => 'secure.sisd.com',
+    'port' => 443,
+    'path' => '/freeside/index.html',
+  },
+  'net_https_any_test' => 1,
+);
+
+like($response, qr/^HTTP\/[\d\.]+\s+200/i, 'Received 200 (OK) response');
+
+ok( length($content), 'Received content' );
+
+#404
+
+my($content2, $response2, %headers2) = Net::HTTPS::Any::https_get(
+  { 'host' => 'secure.sisd.com',
+    'port' => 443,
+    'path' => '/freeside/notfound.html',
+  },
+  'net_https_any_test' => 1,
+);
+
+like($response2, qr/^HTTP\/[\d\.]+\s+404/i, 'Received 404 (OK) response');
+
diff --git a/t/get-netssleay.t b/t/get-netssleay.t
new file mode 100644
index 0000000..9c83a0f
--- /dev/null
+++ b/t/get-netssleay.t
@@ -0,0 +1,36 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More;
+
+plan( tests=>4 );
+
+use_ok 'Net::HTTPS::Any';
+
+#200
+
+my($content, $response, %headers) = Net::HTTPS::Any::https_get(
+  { 'host' => 'secure.sisd.com',
+    'port' => 443,
+    'path' => '/freeside/index.html',
+  },
+  'net_https_any_test' => 1,
+);
+
+like($response, qr/^HTTP\/[\d\.]+\s+200/i, 'Received 200 (OK) response');
+
+ok( length($content), 'Received content' );
+
+#404
+
+my($content2, $response2, %headers2) = Net::HTTPS::Any::https_get(
+  { 'host' => 'secure.sisd.com',
+    'port' => 443,
+    'path' => '/freeside/notfound.html',
+  },
+  'net_https_any_test' => 1,
+);
+
+like($response2, qr/^HTTP\/[\d\.]+\s+404/i, 'Received 404 (OK) response');
+
diff --git a/t/pod-coverage.t b/t/pod-coverage.t
new file mode 100644
index 0000000..fc40a57
--- /dev/null
+++ b/t/pod-coverage.t
@@ -0,0 +1,18 @@
+use strict;
+use warnings;
+use Test::More;
+
+# Ensure a recent version of Test::Pod::Coverage
+my $min_tpc = 1.08;
+eval "use Test::Pod::Coverage $min_tpc";
+plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage"
+    if $@;
+
+# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
+# but older versions don't recognize some common documentation styles
+my $min_pc = 0.18;
+eval "use Pod::Coverage $min_pc";
+plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
+    if $@;
+
+all_pod_coverage_ok();
diff --git a/t/pod.t b/t/pod.t
new file mode 100644
index 0000000..ee8b18a
--- /dev/null
+++ b/t/pod.t
@@ -0,0 +1,12 @@
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More;
+
+# Ensure a recent version of Test::Pod
+my $min_tp = 1.22;
+eval "use Test::Pod $min_tp";
+plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
+
+all_pod_files_ok();
diff --git a/t/post-cryptssleay.t b/t/post-cryptssleay.t
new file mode 100644
index 0000000..2ddda1b
--- /dev/null
+++ b/t/post-cryptssleay.t
@@ -0,0 +1,41 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More;
+
+BEGIN {
+  $Business::OnlinePayment::HTTPS::skip_NetSSLeay=1;
+  $Business::OnlinePayment::HTTPS::skip_NetSSLeay=1;
+}
+
+plan( tests=>4 );
+
+use_ok 'Net::HTTPS::Any';
+
+#200
+
+my($content, $response, %headers) = Net::HTTPS::Any::https_post(
+  { 'host' => 'secure.sisd.com',
+    'port' => 443,
+    'path' => '/freeside/index.html',
+  },
+  'net_https_any_test' => 1,
+);
+
+like($response, qr/^HTTP\/[\d\.]+\s+200/i, 'Received 200 (OK) response');
+
+ok( length($content), 'Received content' );
+
+#404
+
+my($content2, $response2, %headers2) = Net::HTTPS::Any::https_get(
+  { 'host' => 'secure.sisd.com',
+    'port' => 443,
+    'path' => '/freeside/notfound.html',
+  },
+  'net_https_any_test' => 1,
+);
+
+like($response2, qr/^HTTP\/[\d\.]+\s+404/i, 'Received 404 (OK) response');
+
diff --git a/t/post-netssleay.t b/t/post-netssleay.t
new file mode 100644
index 0000000..e8cb2fd
--- /dev/null
+++ b/t/post-netssleay.t
@@ -0,0 +1,36 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More;
+
+plan( tests=>4 );
+
+use_ok 'Net::HTTPS::Any';
+
+#200
+
+my($content, $response, %headers) = Net::HTTPS::Any::https_post(
+  { 'host' => 'secure.sisd.com',
+    'port' => 443,
+    'path' => '/freeside/index.html',
+  },
+  'net_https_any_test' => 1,
+);
+
+like($response, qr/^HTTP\/[\d\.]+\s+200/i, 'Received 200 (OK) response');
+
+ok( length($content), 'Received content' );
+
+#404
+
+my($content2, $response2, %headers2) = Net::HTTPS::Any::https_get(
+  { 'host' => 'secure.sisd.com',
+    'port' => 443,
+    'path' => '/freeside/notfound.html',
+  },
+  'net_https_any_test' => 1,
+);
+
+like($response2, qr/^HTTP\/[\d\.]+\s+404/i, 'Received 404 (OK) response');
+