lib/Net/HTTPS/Any.pm

   1 package Net::HTTPS::Any;
   2
   3 use warnings;
   4 use strict;
   5 use base qw( Exporter );
   6 use vars qw( @EXPORT_OK );
   7 use URI::Escape;
   8 use Tie::IxHash;
   9 use Net::SSLeay 1.30, qw( get_https post_https make_headers make_form );
  10
  11 @EXPORT_OK = qw( https_get https_post );
  12
  13 =head1 NAME
  14
  15 Net::HTTPS::Any - Simple HTTPS client
  16
  17 =cut
  18
  19 our $VERSION = '0.12';
  20
  21 =head1 SYNOPSIS
  22
  23   use Net::HTTPS::Any qw(https_get https_post);
  24
  25   ( $page, $response, %reply_headers )
  26       = https_get(
  27                    { 'host' => 'www.fortify.net',
  28                      'port' => 443,
  29                      'path' => '/sslcheck.html',
  30                      'args' => { 'field' => 'value' },
  31                      #'args' => [ 'field'=>'value' ], #order preserved
  32                    },
  33                  );
  34
  35   ( $page, $response, %reply_headers )
  36       = https_post(
  37                     'host' => 'www.google.com',
  38                     'port' => 443,
  39                     'path' => '/accounts/ServiceLoginAuth',
  40                     'args' => { 'field' => 'value' },
  41                     #'args' => [ 'field'=>'value' ], #order preserved
  42                   );
  43
  44   #...
  45
  46 =head1 DESCRIPTION
  47
  48 This is a wrapper around Net::SSLeay providing a simple interface for the use
  49 of Business::OnlinePayment.
  50
  51 It used to allow switching between Net::SSLeay and Crypt::SSLeay
  52 implementations, but that was obsoleted.  If you need to do that, use LWP
  53 instead.  You can set $Net::HTTPS::SSL_SOCKET_CLASS = "Net::SSL" for
  54 Crypt::SSLeay instead of the default Net::SSLeay (since 6.02).
  55
  56 =head1 FUNCTIONS
  57
  58 =head2 https_get HASHREF | FIELD => VALUE, ...
  59
  60 Accepts parameters as either a hashref or a list of fields and values.
  61
  62 Parameters are:
  63
  64 =over 4
  65
  66 =item host
  67
  68 =item port
  69
  70 =item path
  71
  72 =item headers (hashref)
  73
  74 For example: { 'X-Header1' => 'value', ... }
  75
  76 =cut
  77
  78 # =item Content-Type
  79 #
  80 # Defaults to "application/x-www-form-urlencoded" if not specified.
  81
  82 =item args
  83
  84 CGI arguments, either as a hashref or a listref.  In the latter case, ordering
  85 is preserved (see L<Tie::IxHash> to do so when passing a hashref).
  86
  87 =item debug
  88
  89 Set true to enable debugging.
  90
  91 =back
  92
  93 Returns a list consisting of the page content as a string, the HTTP
  94 response code and message (i.e. "200 OK" or "404 Not Found"), and a list of
  95 key/value pairs representing the HTTP response headers.
  96
  97 =cut
  98
  99 sub https_get {
 100     my $opts = ref($_[0]) ? shift : { @_ }; #hashref or list
 101
 102     # accept a hashref or a list (keep it ordered)
 103     my $post_data = {}; # technically get_data, pedant
 104     if (      exists($opts->{'args'}) && ref($opts->{'args'}) eq 'HASH'  ) {
 105         $post_data = $opts->{'args'};
 106     } elsif ( exists($opts->{'args'}) && ref($opts->{'args'}) eq 'ARRAY' ) {
 107         tie my %hash, 'Tie::IxHash', @{ $opts->{'args'} };
 108         $post_data = \%hash;
 109     }
 110
 111     $opts->{'port'} ||= 443;
 112     #$opts->{"Content-Type"} ||= "application/x-www-form-urlencoded";
 113
 114     ### XXX referer!!!
 115     my %headers = ();
 116     if ( ref( $opts->{headers} ) eq "HASH" ) {
 117         %headers = %{ $opts->{headers} };
 118     }
 119     $headers{'Host'} ||= $opts->{'host'};
 120
 121     my $path = $opts->{'path'};
 122     if ( keys %$post_data ) {
 123         $path .= '?'
 124           . join( ';',
 125             map { uri_escape($_) . '=' . uri_escape( $post_data->{$_} ) }
 126               keys %$post_data );
 127     }
 128
 129     my $headers = make_headers(%headers);
 130
 131     $Net::SSLeay::trace = $opts->{'debug'}
 132       if exists $opts->{'debug'} && $opts->{'debug'};
 133
 134     my( $res_page, $res_code, @res_headers ) =
 135       get_https( $opts->{'host'},
 136                  $opts->{'port'},
 137                  $path,
 138                  $headers,
 139                  #"",
 140                  #$opts->{"Content-Type"},
 141                );
 142
 143     $res_code =~ /^(HTTP\S+ )?(.*)/ and $res_code = $2;
 144
 145     return ( $res_page, $res_code, @res_headers );
 146
 147 }
 148
 149 =head2 https_post HASHREF | FIELD => VALUE, ...
 150
 151 Accepts parameters as either a hashref or a list of fields and values.
 152
 153 Parameters are:
 154
 155 =over 4
 156
 157 =item host
 158
 159 =item port
 160
 161 =item path
 162
 163 =item headers (hashref)
 164
 165 For example: { 'X-Header1' => 'value', ... }
 166
 167 =item Content-Type
 168
 169 Defaults to "application/x-www-form-urlencoded" if not specified.
 170
 171 =item args
 172
 173 CGI arguments, either as a hashref or a listref.  In the latter case, ordering
 174 is preserved (see L<Tie::IxHash> to do so when passing a hashref).
 175
 176 =item content
 177
 178 Raw content (overrides args).  A simple scalar containing the raw content.
 179
 180 =item debug
 181
 182 Set true to enable debugging in the underlying SSL module.
 183
 184 =back
 185
 186 Returns a list consisting of the page content as a string, the HTTP
 187 response code and message (i.e. "200 OK" or "404 Not Found"), and a list of
 188 key/value pairs representing the HTTP response headers.
 189
 190 =cut
 191
 192 sub https_post {
 193     my $opts = ref($_[0]) ? shift : { @_ }; #hashref or list
 194
 195     # accept a hashref or a list (keep it ordered).  or a scalar of content.
 196     my $post_data = '';
 197     if (      exists($opts->{'args'}) && ref($opts->{'args'}) eq 'HASH'  ) {
 198         $post_data = $opts->{'args'};
 199     } elsif ( exists($opts->{'args'}) && ref($opts->{'args'}) eq 'ARRAY' ) {
 200         tie my %hash, 'Tie::IxHash', @{ $opts->{'args'} };
 201         $post_data = \%hash;
 202     }
 203     if ( exists $opts->{'content'} ) {
 204         $post_data = $opts->{'content'};
 205     }
 206
 207     $opts->{'port'} ||= 443;
 208     $opts->{"Content-Type"} ||= "application/x-www-form-urlencoded";
 209
 210     ### XXX referer!!!
 211     my %headers;
 212     if ( ref( $opts->{headers} ) eq "HASH" ) {
 213         %headers = %{ $opts->{headers} };
 214     }
 215     $headers{'Host'} ||= $opts->{'host'};
 216
 217     my $headers = make_headers(%headers);
 218
 219     $Net::SSLeay::trace = $opts->{'debug'}
 220       if exists $opts->{'debug'} && $opts->{'debug'};
 221
 222     my $raw_data = ref($post_data) ? make_form(%$post_data) : $post_data;
 223
 224     $Net::SSLeay::trace = $opts->{'debug'}
 225       if exists $opts->{'debug'} && $opts->{'debug'};
 226
 227     my( $res_page, $res_code, @res_headers ) =
 228       post_https( $opts->{'host'},
 229                   $opts->{'port'},
 230                   $opts->{'path'},
 231                   $headers,
 232                   $raw_data,
 233                   $opts->{"Content-Type"},
 234                 );
 235
 236     $res_code =~ /^(HTTP\S+ )?(.*)/ and $res_code = $2;
 237
 238     return ( $res_page, $res_code, @res_headers );
 239
 240 }
 241
 242 =head1 AUTHOR
 243
 244 Ivan Kohler, C<< <ivan-net-https-any at freeside.biz> >>
 245
 246 =head1 BUGS
 247
 248 Please report any bugs or feature requests to C<bug-net-https-any at rt.cpan.org>, or through
 249 the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-HTTPS-Any>.  I will be notified, and then you'll
 250 automatically be notified of progress on your bug as I make changes.
 251
 252 =head1 SUPPORT
 253
 254 You can find documentation for this module with the perldoc command.
 255
 256     perldoc Net::HTTPS::Any
 257
 258 You can also look for information at:
 259
 260 =over 4
 261
 262 =item * RT: CPAN's request tracker
 263
 264 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-HTTPS-Any>
 265
 266 =item * AnnoCPAN: Annotated CPAN documentation
 267
 268 L<http://annocpan.org/dist/Net-HTTPS-Any>
 269
 270 =item * CPAN Ratings
 271
 272 L<http://cpanratings.perl.org/d/Net-HTTPS-Any>
 273
 274 =item * Search CPAN
 275
 276 L<http://search.cpan.org/dist/Net-HTTPS-Any>
 277
 278 =back
 279
 280 =head1 COPYRIGHT & LICENSE
 281
 282 Copyright 2008-2016 Freeside Internet Services, Inc. (http://freeside.biz/)
 283 All rights reserved.
 284
 285 This program is free software; you can redistribute it and/or modify it
 286 under the same terms as Perl itself.
 287
 288 =cut
 289
 290 1;