view release on metacpan or  search on metacpan

bin/cpant  view on Meta::CPAN

      @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 {
      my ($self, $method, $url, $args) = @_;
  
      my ($scheme, $host, $port, $path_query) = $self->_split_url($url);
  
      my $request = {
          method    => $method,
          scheme    => $scheme,
          host_port => ($port == $DefaultPort{$scheme} ? $host : "$host:$port"),
          uri       => $path_query,
          headers   => {},
      };
  
      my $handle  = HTTP::Tiny::Handle->new(timeout => $self->{timeout});
  
      if ($self->{proxy}) {
          $request->{uri} = "$scheme://$request->{host_port}$path_query";
          croak(qq/HTTPS via proxy is not supported/)
              if $request->{scheme} eq 'https';
          $handle->connect(($self->_split_url($self->{proxy}))[0..2]);
      }
      else {
          $handle->connect($scheme, $host, $port);
      }