1 package Net::HTTPS::Any;
5 use base qw( Exporter );
6 use vars qw(@EXPORT_OK $ssl_module $skip_NetSSLeay);
10 @EXPORT_OK = qw( https_get https_post );
17 die if defined($skip_NetSSLeay) && $skip_NetSSLeay;
19 Net::SSLeay->VERSION(1.30);
22 # qw(get_https post_https make_form make_headers);
23 $ssl_module = 'Net::SSLeay';
28 require LWP::UserAgent;
29 require HTTP::Request::Common;
30 require Crypt::SSLeay;
32 #import HTTP::Request::Common qw(GET POST);
33 $ssl_module = 'Crypt::SSLeay';
37 unless ($ssl_module) {
38 die "One of Net::SSLeay (v1.30 or later)"
39 . " or Crypt::SSLeay (+LWP) is required";
46 Net::HTTPS::Any - Simple HTTPS class using whichever underlying SSL module is available
50 our $VERSION = '0.10';
54 use Net::HTTPS::Any qw(https_get https_post);
56 ( $page, $response, %reply_headers )
58 { 'host' => 'www.fortify.net',
60 'path' => '/sslcheck.html',
64 ( $page, $response, %reply_headers )
66 'host' => 'www.google.com',
68 'path' => '/accounts/ServiceLoginAuth',
69 'args' => { 'field' => 'value' },
70 #'args' => [ 'field'=>'value' ], #order preserved
77 This is a simple wrapper around either of the two available SSL
78 modules. It offers a unified API for sending GET and POST requests over HTTPS
79 and receiving responses.
81 It depends on Net::SSLeay _or_ ( Crypt::SSLeay and LWP::UserAgent ).
83 =head1 WHY THIS MODULE
85 If you just want to write something that speaks HTTPS, you don't need this
86 module. Just go ahead and use whichever of the two modules is good for you.
89 On the other hand, if you are a CPAN author or distribute a Perl application,
90 especially if you aim to support multiple OSes/disributions, using this module
91 for speaking HTTPS may make things easier on your users. It allows your code
92 to be used with either SSL implementation.
96 =head2 https_get HASHREF | FIELD => VALUE, ...
98 Accepts parameters as either a hashref or a list of fields and values.
110 =item headers (hashref)
112 For example: { 'X-Header1' => 'value', ... }
118 # Defaults to "application/x-www-form-urlencoded" if not specified.
122 CGI arguments, eitehr as a hashref or a listref. In the latter case, ordering
123 is preserved (see L<Tie::IxHash> to do so when passing a hashref).
127 Set true to enable debugging.
131 Returns a list consisting of the page content as a string, the HTTP
132 response code and message (i.e. "200 OK" or "404 Not Found"), and a list of
133 key/value pairs representing the HTTP response headers.
138 my $opts = ref($_[0]) ? shift : { @_ }; #hashref or list
140 # accept a hashref or a list (keep it ordered)
141 my $post_data = {}; # technically get_data, pedant
142 if ( exists($opts->{'args'}) && ref($opts->{'args'}) eq 'HASH' ) {
143 $post_data = $opts->{'args'};
144 } elsif ( exists($opts->{'args'}) && ref($opts->{'args'}) eq 'ARRAY' ) {
145 tie my %hash, 'Tie::IxHash', @{ $opts->{'args'} };
149 $opts->{'port'} ||= 443;
150 #$opts->{"Content-Type"} ||= "application/x-www-form-urlencoded";
154 if ( ref( $opts->{headers} ) eq "HASH" ) {
155 %headers = %{ $opts->{headers} };
157 $headers{'Host'} ||= $opts->{'host'};
159 my $path = $opts->{'path'};
160 if ( keys %$post_data ) {
163 map { uri_escape($_) . '=' . uri_escape( $post_data->{$_} ) }
167 if ( $ssl_module eq 'Net::SSLeay' ) {
169 no warnings 'uninitialized';
171 import Net::SSLeay qw(get_https make_headers);
172 my $headers = make_headers(%headers);
174 $Net::SSLeay::trace = $opts->{'debug'}
175 if exists $opts->{'debug'} && $opts->{'debug'};
177 my( $res_page, $res_code, @res_headers ) =
178 get_https( $opts->{'host'},
183 #$opts->{"Content-Type"},
186 $res_code =~ /^(HTTP\S+ )?(.*)/ and $res_code = $2;
188 return ( $res_page, $res_code, @res_headers );
190 } elsif ( $ssl_module eq 'Crypt::SSLeay' ) {
192 import HTTP::Request::Common qw(GET);
194 my $url = 'https://' . $opts->{'host'};
195 $url .= ':' . $opts->{'port'}
196 unless $opts->{'port'} == 443;
199 my $ua = new LWP::UserAgent;
200 foreach my $hdr ( keys %headers ) {
201 $ua->default_header( $hdr => $headers{$hdr} );
203 $ENV{HTTPS_DEBUG} = $opts->{'debug'} if exists $opts->{'debug'};
204 my $res = $ua->request( GET($url) );
206 my @res_headers = map { $_ => $res->header($_) }
207 $res->header_field_names;
209 return ( $res->content, $res->code. ' '. $res->message, @res_headers );
212 die "unknown SSL module $ssl_module";
217 =head2 https_post HASHREF | FIELD => VALUE, ...
219 Accepts parameters as either a hashref or a list of fields and values.
231 =item headers (hashref)
233 For example: { 'X-Header1' => 'value', ... }
237 Defaults to "application/x-www-form-urlencoded" if not specified.
241 CGI arguments, eitehr as a hashref or a listref. In the latter case, ordering
242 is preserved (see L<Tie::IxHash> to do so when passing a hashref).
246 Raw content (overrides args). A simple scalar containing the raw content.
250 Set true to enable debugging in the underlying SSL module.
254 Returns a list consisting of the page content as a string, the HTTP
255 response code and message (i.e. "200 OK" or "404 Not Found"), and a list of
256 key/value pairs representing the HTTP response headers.
261 my $opts = ref($_[0]) ? shift : { @_ }; #hashref or list
263 # accept a hashref or a list (keep it ordered). or a scalar of content.
265 if ( exists($opts->{'args'}) && ref($opts->{'args'}) eq 'HASH' ) {
266 $post_data = $opts->{'args'};
267 } elsif ( exists($opts->{'args'}) && ref($opts->{'args'}) eq 'ARRAY' ) {
268 tie my %hash, 'Tie::IxHash', @{ $opts->{'args'} };
271 if ( exists $opts->{'content'} ) {
272 $post_data = $opts->{'content'};
275 $opts->{'port'} ||= 443;
276 $opts->{"Content-Type"} ||= "application/x-www-form-urlencoded";
280 if ( ref( $opts->{headers} ) eq "HASH" ) {
281 %headers = %{ $opts->{headers} };
283 $headers{'Host'} ||= $opts->{'host'};
285 if ( $ssl_module eq 'Net::SSLeay' ) {
287 no warnings 'uninitialized';
289 import Net::SSLeay qw(post_https make_headers make_form);
290 my $headers = make_headers(%headers);
292 $Net::SSLeay::trace = $opts->{'debug'}
293 if exists $opts->{'debug'} && $opts->{'debug'};
295 my $raw_data = ref($post_data) ? make_form(%$post_data) : $post_data;
297 $Net::SSLeay::trace = $opts->{'debug'}
298 if exists $opts->{'debug'} && $opts->{'debug'};
300 my( $res_page, $res_code, @res_headers ) =
301 post_https( $opts->{'host'},
306 $opts->{"Content-Type"},
309 $res_code =~ /^(HTTP\S+ )?(.*)/ and $res_code = $2;
311 return ( $res_page, $res_code, @res_headers );
313 } elsif ( $ssl_module eq 'Crypt::SSLeay' ) {
315 import HTTP::Request::Common qw(POST);
317 my $url = 'https://' . $opts->{'host'};
318 $url .= ':' . $opts->{'port'}
319 unless $opts->{'port'} == 443;
320 $url .= $opts->{'path'};
322 my $ua = new LWP::UserAgent;
323 foreach my $hdr ( keys %headers ) {
324 $ua->default_header( $hdr => $headers{$hdr} );
327 $ENV{HTTPS_DEBUG} = $opts->{'debug'} if exists $opts->{'debug'};
330 if ( ref($post_data) ) {
331 $res = $ua->request( POST( $url, [%$post_data] ) );
334 my $req = new HTTP::Request( 'POST' => $url );
335 $req->content_type( $opts->{"Content-Type"} );
336 $req->content($post_data);
337 $res = $ua->request($req);
340 my @res_headers = map { $_ => $res->header($_) }
341 $res->header_field_names;
343 return ( $res->content, $res->code. ' '. $res->message, @res_headers );
346 die "unknown SSL module $ssl_module";
353 Ivan Kohler, C<< <ivan-net-https-any at freeside.biz> >>
357 Please report any bugs or feature requests to C<bug-net-https-any at rt.cpan.org>, or through
358 the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-HTTPS-Any>. I will be notified, and then you'll
359 automatically be notified of progress on your bug as I make changes.
363 You can find documentation for this module with the perldoc command.
365 perldoc Net::HTTPS::Any
367 You can also look for information at:
371 =item * RT: CPAN's request tracker
373 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-HTTPS-Any>
375 =item * AnnoCPAN: Annotated CPAN documentation
377 L<http://annocpan.org/dist/Net-HTTPS-Any>
381 L<http://cpanratings.perl.org/d/Net-HTTPS-Any>
385 L<http://search.cpan.org/dist/Net-HTTPS-Any>
389 =head1 COPYRIGHT & LICENSE
391 Copyright 2008-2010 Freeside Internet Services, Inc. (http://freeside.biz/)
394 This program is free software; you can redistribute it and/or modify it
395 under the same terms as Perl itself.