libnet-https-any-perl 0.12-1 / usr / share / perl5 / Net / HTTPS / Any.pm

package Net::HTTPS::Any;

use warnings;
use strict;
use base qw( Exporter );
use vars qw( @EXPORT_OK );
use URI::Escape;
use Tie::IxHash;
use Net::SSLeay 1.30, qw( get_https post_https make_headers make_form );

@EXPORT_OK = qw( https_get https_post );

=head1 NAME

Net::HTTPS::Any - Simple HTTPS client

=cut

our $VERSION = '0.12';

=head1 SYNOPSIS

  use Net::HTTPS::Any qw(https_get https_post);
  
  ( $page, $response, %reply_headers )
      = https_get(
                   { 'host' => 'www.fortify.net',
                     'port' => 443,
                     'path' => '/sslcheck.html',
                     'args' => { 'field' => 'value' },
                     #'args' => [ 'field'=>'value' ], #order preserved
                   },
                 );

  ( $page, $response, %reply_headers )
      = https_post(
                    'host' => 'www.google.com',
                    'port' => 443,
                    'path' => '/accounts/ServiceLoginAuth',
                    'args' => { 'field' => 'value' },
                    #'args' => [ 'field'=>'value' ], #order preserved
                  );
  
  #...

=head1 DESCRIPTION

This is a wrapper around Net::SSLeay providing a simple interface for the use
of Business::OnlinePayment.

It used to allow switching between Net::SSLeay and Crypt::SSLeay
implementations, but that was obsoleted.  If you need to do that, use LWP
instead.  You can set $Net::HTTPS::SSL_SOCKET_CLASS = "Net::SSL" for
Crypt::SSLeay instead of the default Net::SSLeay (since 6.02).

=head1 FUNCTIONS

=head2 https_get HASHREF | FIELD => VALUE, ...

Accepts parameters as either a hashref or a list of fields and values.

Parameters are:

=over 4

=item host

=item port

=item path

=item headers (hashref)

For example: { 'X-Header1' => 'value', ... }

=cut

# =item Content-Type
# 
# Defaults to "application/x-www-form-urlencoded" if not specified.

=item args

CGI arguments, either as a hashref or a listref.  In the latter case, ordering
is preserved (see L<Tie::IxHash> to do so when passing a hashref).

=item debug

Set true to enable debugging.

=back

Returns a list consisting of the page content as a string, the HTTP
response code and message (i.e. "200 OK" or "404 Not Found"), and a list of
key/value pairs representing the HTTP response headers.

=cut

sub https_get {
    my $opts = ref($_[0]) ? shift : { @_ }; #hashref or list

    # accept a hashref or a list (keep it ordered)
    my $post_data = {}; # technically get_data, pedant
    if (      exists($opts->{'args'}) && ref($opts->{'args'}) eq 'HASH'  ) {
        $post_data = $opts->{'args'};
    } elsif ( exists($opts->{'args'}) && ref($opts->{'args'}) eq 'ARRAY' ) {
        tie my %hash, 'Tie::IxHash', @{ $opts->{'args'} };
        $post_data = \%hash;
    }

    $opts->{'port'} ||= 443;
    #$opts->{"Content-Type"} ||= "application/x-www-form-urlencoded";

    ### XXX referer!!!
    my %headers = ();
    if ( ref( $opts->{headers} ) eq "HASH" ) {
        %headers = %{ $opts->{headers} };
    }
    $headers{'Host'} ||= $opts->{'host'};

    my $path = $opts->{'path'};
    if ( keys %$post_data ) {
        $path .= '?'
          . join( ';',
            map { uri_escape($_) . '=' . uri_escape( $post_data->{$_} ) }
              keys %$post_data );
    }

    my $headers = make_headers(%headers);

    $Net::SSLeay::trace = $opts->{'debug'}
      if exists $opts->{'debug'} && $opts->{'debug'};

    my( $res_page, $res_code, @res_headers ) =
      get_https( $opts->{'host'},
                 $opts->{'port'},
                 $path,
                 $headers,
                 #"",
                 #$opts->{"Content-Type"},
               );

    $res_code =~ /^(HTTP\S+ )?(.*)/ and $res_code = $2;

    return ( $res_page, $res_code, @res_headers );

}

=head2 https_post HASHREF | FIELD => VALUE, ...

Accepts parameters as either a hashref or a list of fields and values.

Parameters are:

=over 4

=item host

=item port

=item path

=item headers (hashref)

For example: { 'X-Header1' => 'value', ... }

=item Content-Type

Defaults to "application/x-www-form-urlencoded" if not specified.

=item args

CGI arguments, either as a hashref or a listref.  In the latter case, ordering
is preserved (see L<Tie::IxHash> to do so when passing a hashref).

=item content

Raw content (overrides args).  A simple scalar containing the raw content.

=item debug

Set true to enable debugging in the underlying SSL module.

=back

Returns a list consisting of the page content as a string, the HTTP
response code and message (i.e. "200 OK" or "404 Not Found"), and a list of
key/value pairs representing the HTTP response headers.

=cut

sub https_post {
    my $opts = ref($_[0]) ? shift : { @_ }; #hashref or list

    # accept a hashref or a list (keep it ordered).  or a scalar of content.
    my $post_data = '';
    if (      exists($opts->{'args'}) && ref($opts->{'args'}) eq 'HASH'  ) {
        $post_data = $opts->{'args'};
    } elsif ( exists($opts->{'args'}) && ref($opts->{'args'}) eq 'ARRAY' ) {
        tie my %hash, 'Tie::IxHash', @{ $opts->{'args'} };
        $post_data = \%hash;
    }
    if ( exists $opts->{'content'} ) {
        $post_data = $opts->{'content'};
    }

    $opts->{'port'} ||= 443;
    $opts->{"Content-Type"} ||= "application/x-www-form-urlencoded";

    ### XXX referer!!!
    my %headers;
    if ( ref( $opts->{headers} ) eq "HASH" ) {
        %headers = %{ $opts->{headers} };
    }
    $headers{'Host'} ||= $opts->{'host'};

    my $headers = make_headers(%headers);

    $Net::SSLeay::trace = $opts->{'debug'}
      if exists $opts->{'debug'} && $opts->{'debug'};

    my $raw_data = ref($post_data) ? make_form(%$post_data) : $post_data;

    $Net::SSLeay::trace = $opts->{'debug'}
      if exists $opts->{'debug'} && $opts->{'debug'};

    my( $res_page, $res_code, @res_headers ) =
      post_https( $opts->{'host'},
                  $opts->{'port'},
                  $opts->{'path'},
                  $headers,
                  $raw_data,
                  $opts->{"Content-Type"},
                );

    $res_code =~ /^(HTTP\S+ )?(.*)/ and $res_code = $2;

    return ( $res_page, $res_code, @res_headers );

}

=head1 AUTHOR

Ivan Kohler, C<< <ivan-net-https-any at freeside.biz> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-net-https-any at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-HTTPS-Any>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Net::HTTPS::Any

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-HTTPS-Any>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Net-HTTPS-Any>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Net-HTTPS-Any>

=item * Search CPAN

L<http://search.cpan.org/dist/Net-HTTPS-Any>

=back

=head1 COPYRIGHT & LICENSE

Copyright 2008-2016 Freeside Internet Services, Inc. (http://freeside.biz/)
All rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1;