view release on metacpan or  search on metacpan

bin/cpant  view on Meta::CPAN

$fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
  # vim: ts=4 sts=4 sw=4 et:
  #
  # This file is part of HTTP-Tiny
  #
  # This software is copyright (c) 2011 by Christian Hansen.
  #
  # This is free software; you can redistribute it and/or modify it under
  # the same terms as the Perl 5 programming language system itself.
  #
  package HTTP::Tiny;
  BEGIN {
    $HTTP::Tiny::VERSION = '0.009';
  }
  use strict;
  use warnings;
  # ABSTRACT: A small, simple, correct HTTP/1.1 client
  
  use Carp ();
  
  
  my @attributes;
  BEGIN {
      @attributes = qw(agent default_headers max_redirect max_size proxy timeout);
      no strict 'refs';
      for my $accessor ( @attributes ) {
          *{$accessor} = sub {
              @_ > 1 ? $_[0]->{$accessor} = $_[1] : $_[0]->{$accessor};
          };
      }
  }
  
  sub new {
      my($class, %args) = @_;
      (my $agent = $class) =~ s{::}{-}g;
      my $self = {
          agent        => $agent . "/" . ($class->VERSION || 0),
          max_redirect => 5,
          timeout      => 60,
      };
      for my $key ( @attributes ) {
          $self->{$key} = $args{$key} if exists $args{$key}
      }
      return bless $self, $class;
  }
  
  
  sub get {
      my ($self, $url, $args) = @_;
      @_ == 2 || (@_ == 3 && ref $args eq 'HASH')
        or Carp::croak(q/Usage: $http->get(URL, [HASHREF])/);
      return $self->request('GET', $url, $args || {});
  }
  
  
  sub mirror {
      my ($self, $url, $file, $args) = @_;
      @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
        or Carp::croak(q/Usage: $http->mirror(URL, FILE, [HASHREF])/);
      if ( -e $file and my $mtime = (stat($file))[9] ) {
          $args->{headers}{'if-modified-since'} ||= $self->_http_date($mtime);
      }
      my $tempfile = $file . int(rand(2**31));
      open my $fh, ">", $tempfile
          or Carp::croak(qq/Error: Could not open temporary file $tempfile for downloading: $!/);
      $args->{data_callback} = sub { print {$fh} $_[0] };
      my $response = $self->request('GET', $url, $args);
      close $fh
          or Carp::croak(qq/Error: Could not close temporary file $tempfile: $!/);
      if ( $response->{success} ) {
          rename $tempfile, $file
              or Carp::croak "Error replacing $file with $tempfile: $!\n";
          my $lm = $response->{headers}{'last-modified'};
          if ( $lm and my $mtime = $self->_parse_http_date($lm) ) {
              utime $mtime, $mtime, $file;
          }
      }
      $response->{success} ||= $response->{status} eq '304';
      unlink $tempfile;
      return $response;
  }
  
  
  my %idempotent = map { $_ => 1 } qw/GET HEAD PUT DELETE OPTIONS TRACE/;
  
  sub request {
      my ($self, $method, $url, $args) = @_;
      @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
        or Carp::croak(q/Usage: $http->request(METHOD, URL, [HASHREF])/);
      $args ||= {}; # we keep some state in this during _request
  
      # RFC 2616 Section 8.1.4 mandates a single retry on broken socket
      my $response;
      for ( 0 .. 1 ) {
          $response = eval { $self->_request($method, $url, $args) };
          last unless $@ && $idempotent{$method}
              && $@ =~ m{^(?:Socket closed|Unexpected end)};
      }
  
      if (my $e = "$@") {
          $response = {
              success => q{},
              status  => 599,
              reason  => 'Internal Exception',
              content => $e,
              headers => {
                  'content-type'   => 'text/plain',
                  'content-length' => length $e,
              }
          };
      }
      return $response;
  }
  
  my %DefaultPort = (
      http => 80,
      https => 443,
  );
  
  sub _request {