view release on metacpan or  search on metacpan

lib/Acme/HTTP.pm  view on Meta::CPAN

use warnings;

require Exporter;
our @ISA       = qw(Exporter);
our @EXPORT    = qw(
  get_url_act
  get_redir_act
  get_code
  get_message
  get_response

  get_redir_max
  get_timeout

  set_redir_max
  set_timeout
);

our %EXPORT_TAGS = (all => [ @EXPORT ]);

our @EXPORT_OK = qw();

use IO::Select;

our $Url_act   = '';
our $Redir_act = 0;

our $Code      = -1;
our $Message   = '?';
our %Response  = ();

our $Redir_max;
$Redir_max = 3 unless defined $Redir_max;

our $TimeOut;
$TimeOut = 10 unless defined $TimeOut;

sub get_url_act   { $Url_act }
sub get_redir_act { $Redir_act }
sub get_code      { $Code }
sub get_message   { $Message }
sub get_response  { \%Response }

sub get_redir_max { $Redir_max }
sub get_timeout   { $TimeOut }

sub set_redir_max { $Redir_max = $_[0] }
sub set_timeout   { $TimeOut   = $_[0] }

sub new {
    shift;
    my ($url) = @_;
    my $hdl;

    $Url_act = '';
    $Redir_act = 0;

    while (defined $url) {
        $Redir_act++;
        if ($Redir_act > $Redir_max) {
            $@ = 'Acme::HTTP - Runaway iterations ('.$Redir_max.')';
            return;
        }

        $Url_act = $url;

        my ($type, $host, $get) =
          $Url_act =~ m{\A ([^:]+) : // ([^/]+)        \z}xms ? ($1, $2, '/') :
          $Url_act =~ m{\A ([^:]+) : // ([^/]+) (/ .*) \z}xms ? ($1, $2, $3)  :
          do {
            $@ = 'Acme::HTTP - Invalid structure)';
            return;
          };

        my $net_http =
          $type eq 'http'  ? 'Net::HTTP::NB'  :
          $type eq 'https' ? 'Net::HTTPS::NB' :
          do { 
            $@ = 'Acme::HTTP - Can\'t identify type';
            return;
          };

        if ($net_http eq 'Net::HTTP::NB') {
            require Net::HTTP::NB;
        }
        elsif ($net_http eq 'Net::HTTPS::NB') {
            require Net::HTTPS::NB;
        }
        else {
            $@ = 'Acme::HTTP - Internal error net_http = \''.$net_http.'\'';
            return;
        }

        $hdl = $net_http->new(Host => $host) or do {
            $@ = 'Acme::HTTP - Can\'t Net::HTTP(S)->new(Host =>...)';
            return;
        };

        $hdl->write_request(GET => $get, 'User-Agent' => 'Mozilla/5.0');

        use IO::Select;
        my $sel = IO::Select->new($hdl);
 
        READ_HEADER: {
            unless ($sel->can_read($TimeOut)) {
                $@ = 'Acme::HTTP - Header timeout('.$TimeOut.')';
                return;
            }

            ($Code, $Message, %Response) = $hdl->read_response_headers;

            redo READ_HEADER unless $Code;
        }

        $url = $Response{'Location'};
    }

    unless (defined $hdl) {
        $@ = 'Acme::HTTP - Internal error, hdl is undefined';
        return;
    }