lib/Net/HTTPS/Any.pm

   1 package Net::HTTPS::Any;
   2
   3 use warnings;
   4 use strict;
   5 use vars qw(@EXPORT_OK $ssl_module $skip_NetSSLeay);
   6 use Exporter;
   7 use URI::Escape;
   8 use Tie::IxHash;
   9
  10 @EXPORT_OK = qw( https_get https_post );
  11
  12 BEGIN {
  13
  14     $ssl_module = '';
  15
  16     eval {
  17         die if defined($skip_NetSSLeay) && $skip_NetSSLeay;
  18         require Net::SSLeay;
  19         Net::SSLeay->VERSION(1.30);
  20
  21         #import Net::SSLeay
  22         #  qw(get_https post_https make_form make_headers);
  23         $ssl_module = 'Net::SSLeay';
  24     };
  25
  26     if ($@) {
  27         eval {
  28             require LWP::UserAgent;
  29             require HTTP::Request::Common;
  30             require Crypt::SSLeay;
  31
  32             #import HTTP::Request::Common qw(GET POST);
  33             $ssl_module = 'Crypt::SSLeay';
  34         };
  35     }
  36
  37     unless ($ssl_module) {
  38         die "One of Net::SSLeay (v1.30 or later)"
  39           . " or Crypt::SSLeay (+LWP) is required";
  40     }
  41
  42 }
  43
  44 =head1 NAME
  45
  46 Net::HTTPS::Any - Simple HTTPS class using whatever underlying module is available
  47
  48 =head1 VERSION
  49
  50 Version 0.09
  51
  52 =cut
  53
  54 our $VERSION = '0.09';
  55
  56 =head1 SYNOPSIS
  57
  58   use Net::HTTPS::Any qw(https_get https_post);
  59
  60   ( $page, $response, %reply_headers )
  61       = https_get(
  62                    { 'host' => 'secure.sisd.com',
  63                      'port' => 443,
  64                      'path' => '/freeside/index.html',
  65                      'args' => { 'field' => 'value' },
  66                      #'args' => [ 'field'=>'value' ], #order preserved
  67                    },
  68                  );
  69
  70   ( $page, $response, %reply_headers )
  71       = https_post(
  72                     'host' => 'secure.sisd.com',
  73                     'port' => 443,
  74                     'path' => '/freeside/index.html',
  75                     'args' => { 'field' => 'value' },
  76                     #'args' => [ 'field'=>'value' ], #order preserved
  77                   );
  78
  79   #...
  80
  81 =head1 DESCRIPTION
  82
  83 This is a simple wrapper around either of the two available SSL
  84 modules.
  85
  86 It depends on Net::SSLeay _or_ ( Crypt::SSLeay and LWP::UserAgent ).
  87
  88 =head1 FUNCTIONS
  89
  90 =head2 https_get HASHREF | FIELD => VALUE, ...
  91
  92 Accepts parameters as either a hashref or a list of fields and values.
  93
  94 Parameters are:
  95
  96 =over 4
  97
  98 =item host
  99
 100 =item port
 101
 102 =item path
 103
 104 =item headers (hashref)
 105
 106 For example: { 'X-Header1' => 'value', ... }
 107
 108 =item Content-Type
 109
 110 For example: 'text/namevalue',
 111
 112 =item args
 113
 114 CGI arguments, eitehr as a hashref or a listref.  In the latter case, ordering
 115 is preserved (see L<Tie::IxHash> to do so when passing a hashref).
 116
 117 =back
 118
 119 Returns a list consisting of the page content as a string, the HTTP
 120 response code and message (i.e. "200 OK" or "404 Not Found"), and a list of
 121 key/value pairs representing the HTTP response headers.
 122
 123 =cut
 124
 125 sub https_get {
 126     my $opts = ref($_[0]) ? shift : { @_ }; #hashref or list
 127
 128     # accept a hashref or a list (keep it ordered)
 129     my $post_data = {};
 130     if (      exists($opts->{'args'}) && ref($opts->{'args'}) eq 'HASH'  ) {
 131         $post_data = shift;
 132     } elsif ( exists($opts->{'args'}) && ref($opts->{'args'}) eq 'ARRAY' ) {
 133         tie my %hash, 'Tie::IxHash', @{ $opts->{'args'} };
 134         $post_data = \%hash;
 135     }
 136
 137     $opts->{"Content-Type"} ||= "application/x-www-form-urlencoded";
 138
 139     ### XXX referer!!!
 140     my %headers = ();
 141     if ( ref( $opts->{headers} ) eq "HASH" ) {
 142         %headers = %{ $opts->{headers} };
 143     }
 144     $headers{'Host'} ||= $opts->{'host'};
 145
 146     my $path = $opts->{'path'};
 147     if ( keys %$post_data ) {
 148         $path .= '?'
 149           . join( ';',
 150             map { uri_escape($_) . '=' . uri_escape( $post_data->{$_} ) }
 151               keys %$post_data );
 152     }
 153
 154     if ( $ssl_module eq 'Net::SSLeay' ) {
 155
 156         import Net::SSLeay qw(get_https make_headers);
 157         my $headers = make_headers(%headers);
 158
 159         my( $res_page, $res_code, @res_headers ) =
 160           get_https( $opts->{'host'},
 161                      $opts->{'port'},
 162                      $path,
 163                      $headers,
 164                      "",
 165                      $opts->{"Content-Type"},
 166                    );
 167
 168         return ( $res_page, $res_code, @res_headers );
 169
 170     } elsif ( $ssl_module eq 'Crypt::SSLeay' ) {
 171
 172         import HTTP::Request::Common qw(GET);
 173
 174         my $url = 'https://' . $opts->{'host'};
 175         $url .= ':' . $opts->{'port'}
 176           unless $opts->{'port'} == 443;
 177         $url .= "/$path";
 178
 179         my $ua = new LWP::UserAgent;
 180         foreach my $hdr ( keys %headers ) {
 181             $ua->default_header( $hdr => $headers{$hdr} );
 182         }
 183         my $res = $ua->request( GET($url) );
 184
 185         my @res_headers = map { $_ => $res->header($_) }
 186                               $res->header_field_names;
 187
 188         return ( $res->content, $res->code. ' '. $res->message, @res_headers );
 189
 190     } else {
 191         die "unknown SSL module $ssl_module";
 192     }
 193
 194 }
 195
 196 =head2 https_post HASHREF | FIELD => VALUE, ...
 197
 198 Accepts parameters as either a hashref or a list of fields and values.
 199
 200 Parameters are:
 201
 202 =over 4
 203
 204 =item host
 205
 206 =item port
 207
 208 =item path
 209
 210 =item headers (hashref)
 211
 212 For example: { 'X-Header1' => 'value', ... }
 213
 214 =item Content-Type
 215
 216 For example: 'text/namevalue',
 217
 218 =item args
 219
 220 CGI arguments, eitehr as a hashref or a listref.  In the latter case, ordering
 221 is preserved (see L<Tie::IxHash> to do so when passing a hashref).
 222
 223 =item content
 224
 225 Raw content (overrides args).  A simple scalar containing the raw content.
 226
 227
 228 =back
 229
 230 Returns a list consisting of the page content as a string, the HTTP
 231 response code and message (i.e. "200 OK" or "404 Not Found"), and a list of
 232 key/value pairs representing the HTTP response headers.
 233
 234 =cut
 235
 236 sub https_post {
 237     my $opts = ref($_[0]) ? shift : { @_ }; #hashref or list
 238
 239     # accept a hashref or a list (keep it ordered).  or a scalar of content.
 240     my $post_data = '';
 241     if (      exists($opts->{'args'}) && ref($opts->{'args'}) eq 'HASH'  ) {
 242         $post_data = shift;
 243     } elsif ( exists($opts->{'args'}) && ref($opts->{'args'}) eq 'ARRAY' ) {
 244         tie my %hash, 'Tie::IxHash', @{ $opts->{'args'} };
 245         $post_data = \%hash;
 246     }
 247     if ( exists $opts->{'content'} ) {
 248         $post_data = $opts->{'content'};
 249     }
 250
 251     $opts->{"Content-Type"} ||= "application/x-www-form-urlencoded";
 252
 253     ### XXX referer!!!
 254     my %headers;
 255     if ( ref( $opts->{headers} ) eq "HASH" ) {
 256         %headers = %{ $opts->{headers} };
 257     }
 258     $headers{'Host'} ||= $opts->{'host'};
 259
 260     if ( $ssl_module eq 'Net::SSLeay' ) {
 261
 262         import Net::SSLeay qw(post_https make_headers make_form);
 263         my $headers = make_headers(%headers);
 264
 265         my $raw_data = ref($post_data) ? make_form(%$post_data) : $post_data;
 266
 267         my( $res_page, $res_code, @res_headers ) =
 268           post_https( $opts->{'host'},
 269                       $opts->{'port'},
 270                       $opts->{'path'},
 271                       $headers,
 272                       $raw_data,
 273                       $opts->{"Content-Type"},
 274                     );
 275
 276         return ( $res_page, $res_code, @res_headers );
 277
 278     } elsif ( $ssl_module eq 'Crypt::SSLeay' ) {
 279
 280         import HTTP::Request::Common qw(POST);
 281
 282         my $url = 'https://' . $opts->{'host'};
 283         $url .= ':' . $opts->{'port'}
 284           unless $opts->{'port'} == 443;
 285         $url .= $opts->{'path'};
 286
 287         my $ua = new LWP::UserAgent;
 288         foreach my $hdr ( keys %headers ) {
 289             $ua->default_header( $hdr => $headers{$hdr} );
 290         }
 291
 292         my $res;
 293         if ( ref($post_data) ) {
 294             $res = $ua->request( POST( $url, [%$post_data] ) );
 295         }
 296         else {
 297             my $req = new HTTP::Request( 'POST' => $url );
 298             $req->content_type( $opts->{"Content-Type"} );
 299             $req->content($post_data);
 300             $res = $ua->request($req);
 301         }
 302
 303         my @res_headers = map { $_ => $res->header($_) }
 304                               $res->header_field_names;
 305
 306         return ( $res->content, $res->code. ' '. $res->message, @res_headers );
 307
 308     } else {
 309         die "unknown SSL module $ssl_module";
 310     }
 311
 312 }
 313
 314 =head1 AUTHOR
 315
 316 Ivan Kohler, C<< <ivan-net-https-any at freeside.biz> >>
 317
 318 =head1 BUGS
 319
 320 Please report any bugs or feature requests to C<bug-net-https-any at rt.cpan.org>, or through
 321 the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-HTTPS-Any>.  I will be notified, and then you'll
 322 automatically be notified of progress on your bug as I make changes.
 323
 324 =head1 SUPPORT
 325
 326 You can find documentation for this module with the perldoc command.
 327
 328     perldoc Net::HTTPS::Any
 329
 330
 331 You can also look for information at:
 332
 333 =over 4
 334
 335 =item * RT: CPAN's request tracker
 336
 337 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-HTTPS-Any>
 338
 339 =item * AnnoCPAN: Annotated CPAN documentation
 340
 341 L<http://annocpan.org/dist/Net-HTTPS-Any>
 342
 343 =item * CPAN Ratings
 344
 345 L<http://cpanratings.perl.org/d/Net-HTTPS-Any>
 346
 347 =item * Search CPAN
 348
 349 L<http://search.cpan.org/dist/Net-HTTPS-Any>
 350
 351 =back
 352
 353
 354 =head1 ACKNOWLEDGEMENTS
 355
 356
 357 =head1 COPYRIGHT & LICENSE
 358
 359 Copyright 2008 Freeside Internet Services, Inc. (http://freeside.biz/)
 360 All rights reserved.
 361
 362 This program is free software; you can redistribute it and/or modify it
 363 under the same terms as Perl itself.
 364
 365 =cut
 366
 367 1;