view release on metacpan or  search on metacpan

lib/App/cpanminus/fatscript.pm  view on Meta::CPAN

  #pod are sorted on key and value for consistency.  See documentation for the
  #pod C<www_form_urlencode> method for details on the encoding.
  #pod
  #pod The URL must have unsafe characters escaped and international domain names
  #pod encoded.  See C<request()> for valid options and a description of the response.
  #pod Any C<content-type> header or content in the options hashref will be ignored.
  #pod
  #pod The C<success> field of the response will be true if the status code is 2XX.
  #pod
  #pod =cut
  
  sub post_form {
      my ($self, $url, $data, $args) = @_;
      (@_ == 3 || @_ == 4 && ref $args eq 'HASH')
          or Carp::croak(q/Usage: $http->post_form(URL, DATAREF, [HASHREF])/ . "\n");
  
      my $headers = {};
      while ( my ($key, $value) = each %{$args->{headers} || {}} ) {
          $headers->{lc $key} = $value;
      }
      delete $args->{headers};
  
      return $self->request('POST', $url, {
              %$args,
              content => $self->www_form_urlencode($data),
              headers => {
                  %$headers,
                  'content-type' => 'application/x-www-form-urlencoded'
              },
          }
      );
  }
  
  #pod =method mirror
  #pod
  #pod     $response = $http->mirror($url, $file, \%options)
  #pod     if ( $response->{success} ) {
  #pod         print "$file is up to date\n";
  #pod     }
  #pod
  #pod Executes a C<GET> request for the URL and saves the response body to the file
  #pod name provided.  The URL must have unsafe characters escaped and international
  #pod domain names encoded.  If the file already exists, the request will include an
  #pod C<If-Modified-Since> header with the modification timestamp of the file.  You
  #pod may specify a different C<If-Modified-Since> header yourself in the C<<
  #pod $options->{headers} >> hash.
  #pod
  #pod The C<success> field of the response will be true if the status code is 2XX
  #pod or if the status code is 304 (unmodified).
  #pod
  #pod If the file was modified and the server response includes a properly
  #pod formatted C<Last-Modified> header, the file modification time will
  #pod be updated accordingly.
  #pod
  #pod =cut
  
  sub mirror {
      my ($self, $url, $file, $args) = @_;
      @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
        or Carp::croak(q/Usage: $http->mirror(URL, FILE, [HASHREF])/ . "\n");
      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));
  
      require Fcntl;
      sysopen my $fh, $tempfile, Fcntl::O_CREAT()|Fcntl::O_EXCL()|Fcntl::O_WRONLY()
         or Carp::croak(qq/Error: Could not create temporary file $tempfile for downloading: $!\n/);
      binmode $fh;
      $args->{data_callback} = sub { print {$fh} $_[0] };
      my $response = $self->request('GET', $url, $args);
      close $fh
          or Carp::croak(qq/Error: Caught error closing temporary file $tempfile: $!\n/);
  
      if ( $response->{success} ) {
          rename $tempfile, $file
              or Carp::croak(qq/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;
  }
  
  #pod =method request
  #pod
  #pod     $response = $http->request($method, $url);
  #pod     $response = $http->request($method, $url, \%options);
  #pod
  #pod Executes an HTTP request of the given method type ('GET', 'HEAD', 'POST',
  #pod 'PUT', etc.) on the given URL.  The URL must have unsafe characters escaped and
  #pod international domain names encoded.
  #pod
  #pod If the URL includes a "user:password" stanza, they will be used for Basic-style
  #pod authorization headers.  (Authorization headers will not be included in a
  #pod redirected request.) For example:
  #pod
  #pod     $http->request('GET', 'http://Aladdin:open sesame@example.com/');
  #pod
  #pod If the "user:password" stanza contains reserved characters, they must
  #pod be percent-escaped:
  #pod
  #pod     $http->request('GET', 'http://john%40example.com:password@example.com/');
  #pod
  #pod A hashref of options may be appended to modify the request.
  #pod
  #pod Valid options are:
  #pod
  #pod =for :list
  #pod * C<headers> —
  #pod     A hashref containing headers to include with the request.  If the value for
  #pod     a header is an array reference, the header will be output multiple times with
  #pod     each value in the array.  These headers over-write any default headers.
  #pod * C<content> —
  #pod     A scalar to include as the body of the request OR a code reference
  #pod     that will be called iteratively to produce the body of the request
  #pod * C<trailer_callback> —
  #pod     A code reference that will be called if it exists to provide a hashref