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' => 'secure.sisd.com',
60 'path' => '/freeside/index.html',
61 'args' => { 'field' => 'value' },
62 #'args' => [ 'field'=>'value' ], #order preserved
66 ( $page, $response, %reply_headers )
68 'host' => 'secure.sisd.com',
70 'path' => '/freeside/index.html',
71 'args' => { 'field' => 'value' },
72 #'args' => [ 'field'=>'value' ], #order preserved
79 This is a simple wrapper around either of the two available SSL
80 modules. It offers a unified API for sending GET and POST requests over HTTPS
81 and receiving responses.
83 It depends on Net::SSLeay _or_ ( Crypt::SSLeay and LWP::UserAgent ).
85 =head1 WHY THIS MODULE
87 If you just want to write something that speaks HTTPS, you don't need this
88 module. Just go ahead and use whichever of the two modules is good for you.
91 On the other hand, if you are a CPAN author or distribute a Perl application,
92 especially if you aim to support multiple OSes/disributions, using this module
93 for speaking HTTPS may make things easier on your users. It allows your code
94 to be used with either SSL implementation.
98 =head2 https_get HASHREF | FIELD => VALUE, ...
100 Accepts parameters as either a hashref or a list of fields and values.
112 =item headers (hashref)
114 For example: { 'X-Header1' => 'value', ... }
120 # Defaults to "application/x-www-form-urlencoded" if not specified.
124 CGI arguments, eitehr as a hashref or a listref. In the latter case, ordering
125 is preserved (see L<Tie::IxHash> to do so when passing a hashref).
129 Set true to enable debugging.
133 Returns a list consisting of the page content as a string, the HTTP
134 response code and message (i.e. "200 OK" or "404 Not Found"), and a list of
135 key/value pairs representing the HTTP response headers.
140 my $opts = ref($_[0]) ? shift : { @_ }; #hashref or list
142 # accept a hashref or a list (keep it ordered)
143 my $post_data = {}; # technically get_data, pedant
144 if ( exists($opts->{'args'}) && ref($opts->{'args'}) eq 'HASH' ) {
145 $post_data = $opts->{'args'};
146 } elsif ( exists($opts->{'args'}) && ref($opts->{'args'}) eq 'ARRAY' ) {
147 tie my %hash, 'Tie::IxHash', @{ $opts->{'args'} };
151 $opts->{'port'} ||= 443;
152 #$opts->{"Content-Type"} ||= "application/x-www-form-urlencoded";
156 if ( ref( $opts->{headers} ) eq "HASH" ) {
157 %headers = %{ $opts->{headers} };
159 $headers{'Host'} ||= $opts->{'host'};
161 my $path = $opts->{'path'};
162 if ( keys %$post_data ) {
165 map { uri_escape($_) . '=' . uri_escape( $post_data->{$_} ) }
169 if ( $ssl_module eq 'Net::SSLeay' ) {
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 import Net::SSLeay qw(post_https make_headers make_form);
288 my $headers = make_headers(%headers);
290 if ($opts->{debug}) {
291 no warnings 'uninitialized';
292 $Net::SSLeay::trace = $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.