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.13';
  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     no warnings 'uninitialized';
 135
 136     my( $res_page, $res_code, @res_headers ) =
 137       get_https( $opts->{'host'},
 138                  $opts->{'port'},
 139                  $path,
 140                  $headers,
 141                  #"",
 142                  #$opts->{"Content-Type"},
 143                );
 144
 145     $res_code =~ /^(HTTP\S+ )?(.*)/ and $res_code = $2;
 146
 147     return ( $res_page, $res_code, @res_headers );
 148
 149 }
 150
 151 =head2 https_post HASHREF | FIELD => VALUE, ...
 152
 153 Accepts parameters as either a hashref or a list of fields and values.
 154
 155 Parameters are:
 156
 157 =over 4
 158
 159 =item host
 160
 161 =item port
 162
 163 =item path
 164
 165 =item headers (hashref)
 166
 167 For example: { 'X-Header1' => 'value', ... }
 168
 169 =item Content-Type
 170
 171 Defaults to "application/x-www-form-urlencoded" if not specified.
 172
 173 =item args
 174
 175 CGI arguments, either as a hashref or a listref.  In the latter case, ordering
 176 is preserved (see L<Tie::IxHash> to do so when passing a hashref).
 177
 178 =item content
 179
 180 Raw content (overrides args).  A simple scalar containing the raw content.
 181
 182 =item debug
 183
 184 Set true to enable debugging in the underlying SSL module.
 185
 186 =back
 187
 188 Returns a list consisting of the page content as a string, the HTTP
 189 response code and message (i.e. "200 OK" or "404 Not Found"), and a list of
 190 key/value pairs representing the HTTP response headers.
 191
 192 =cut
 193
 194 sub https_post {
 195     my $opts = ref($_[0]) ? shift : { @_ }; #hashref or list
 196
 197     # accept a hashref or a list (keep it ordered).  or a scalar of content.
 198     my $post_data = '';
 199     if (      exists($opts->{'args'}) && ref($opts->{'args'}) eq 'HASH'  ) {
 200         $post_data = $opts->{'args'};
 201     } elsif ( exists($opts->{'args'}) && ref($opts->{'args'}) eq 'ARRAY' ) {
 202         tie my %hash, 'Tie::IxHash', @{ $opts->{'args'} };
 203         $post_data = \%hash;
 204     }
 205     if ( exists $opts->{'content'} ) {
 206         $post_data = $opts->{'content'};
 207     }
 208
 209     $opts->{'port'} ||= 443;
 210     $opts->{"Content-Type"} ||= "application/x-www-form-urlencoded";
 211
 212     ### XXX referer!!!
 213     my %headers;
 214     if ( ref( $opts->{headers} ) eq "HASH" ) {
 215         %headers = %{ $opts->{headers} };
 216     }
 217     $headers{'Host'} ||= $opts->{'host'};
 218
 219     my $headers = make_headers(%headers);
 220
 221     $Net::SSLeay::trace = $opts->{'debug'}
 222       if exists $opts->{'debug'} && $opts->{'debug'};
 223
 224     my $raw_data = ref($post_data) ? make_form(%$post_data) : $post_data;
 225
 226     $Net::SSLeay::trace = $opts->{'debug'}
 227       if exists $opts->{'debug'} && $opts->{'debug'};
 228
 229     no warnings 'uninitialized';
 230
 231     my( $res_page, $res_code, @res_headers ) =
 232       post_https( $opts->{'host'},
 233                   $opts->{'port'},
 234                   $opts->{'path'},
 235                   $headers,
 236                   $raw_data,
 237                   $opts->{"Content-Type"},
 238                 );
 239
 240     $res_code =~ /^(HTTP\S+ )?(.*)/ and $res_code = $2;
 241
 242     return ( $res_page, $res_code, @res_headers );
 243
 244 }
 245
 246 =head1 AUTHOR
 247
 248 Ivan Kohler, C<< <ivan-net-https-any at freeside.biz> >>
 249
 250 =head1 BUGS
 251
 252 Please report any bugs or feature requests to C<bug-net-https-any at rt.cpan.org>, or through
 253 the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-HTTPS-Any>.  I will be notified, and then you'll
 254 automatically be notified of progress on your bug as I make changes.
 255
 256 =head1 SUPPORT
 257
 258 You can find documentation for this module with the perldoc command.
 259
 260     perldoc Net::HTTPS::Any
 261
 262 You can also look for information at:
 263
 264 =over 4
 265
 266 =item * RT: CPAN's request tracker
 267
 268 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-HTTPS-Any>
 269
 270 =item * AnnoCPAN: Annotated CPAN documentation
 271
 272 L<http://annocpan.org/dist/Net-HTTPS-Any>
 273
 274 =item * CPAN Ratings
 275
 276 L<http://cpanratings.perl.org/d/Net-HTTPS-Any>
 277
 278 =item * Search CPAN
 279
 280 L<http://search.cpan.org/dist/Net-HTTPS-Any>
 281
 282 =back
 283
 284 =head1 COPYRIGHT & LICENSE
 285
 286 Copyright 2008-2016 Freeside Internet Services, Inc. (http://freeside.biz/)
 287 All rights reserved.
 288
 289 This program is free software; you can redistribute it and/or modify it
 290 under the same terms as Perl itself.
 291
 292 =cut
 293
 294 1;