view release on metacpan or  search on metacpan

lib/HTTP/Request/FromWget.pm  view on Meta::CPAN

        @post_raw_data = $self->_maybe_read_data_file( $build_options{ read_files }, $file );
        $method ||= 'POST';
    };
                    ;
    my @form_args = @{ $options->{form} || []};

    # expand the URI here if wanted
    my @uris = ($uri);
    if( ! $options->{ globoff }) {
        @uris = map { $_->{url} } generate_requests( pattern => shift @uris, limit => $build_options{ limit } );
    }

    my @res;
    for my $uri (@uris) {
        $uri = URI->new( $uri );
        $uri = $self->squash_uri( $uri );

        my $host = $uri->can( 'host_port' ) ? $uri->host_port : "$uri";

        # Stuff we use unless nothing else hits
        my %request_default_headers = %default_headers;

        my $data;
        if( @post_raw_data ) {
            $data = join "&",
                @post_raw_data,
                ;
        };

        if( @form_args) {
            $method ||= 'POST';

            my $req = HTTP::Request::Common::POST(
                'https://example.com',
                Content_Type => 'form-data',
                Content => [ map { /^([^=]+)=(.*)$/ ? ($1 => $2) : () } @form_args ],
            );
            $body = $req->content;
            $request_default_headers{ 'Content-Type' } = join "; ", $req->headers->content_type;

        } elsif( defined $data ) {
            $method ||= 'POST';
            $body = $data;
            $request_default_headers{ 'Content-Type' } = 'application/x-www-form-urlencoded';

        } else {
            $method ||= 'GET';
        };

        if( defined $body ) {
            $request_default_headers{ 'Content-Length' } = length $body;
        };

        if( $options->{ 'user' } || $options->{'http-user'} ) {
            if(    $options->{anyauth}
                || $options->{ntlm}
                || $options->{negotiate}
                ) {
                # Nothing to do here, just let LWP::UserAgent do its thing
                # This means one additional request to fetch the appropriate
                # 401 response asking for credentials, but ...
            } else {
                # $options->{basic} or none at all
                my $info = delete $options->{'user'} || delete $options->{'http-user'};
                # We need to bake this into the header here?!
                push @headers, sprintf 'Authorization: Basic %s', encode_base64( $info );
            }
        };

        my %headers;
        for my $kv (
            (map { /^\s*([^:\s]+)\s*:\s*(.*)$/ ? [$1 => $2] : () } @headers),) {
                $self->_add_header( \%headers, @$kv );
        };

        if( defined $options->{ 'user-agent' }) {
            $self->_set_header( \%headers, "User-Agent", $options->{ 'user-agent' } );
        };

        if( exists $options->{ 'cache' }) {
            if(! $options->{ 'cache' } ) {
                $self->_maybe_set_header( \%headers, "Cache-Control" => 'no-cache' );
                $self->_maybe_set_header( \%headers, "Pragma" => 'no-cache' );
            };
        };

        if( exists $options->{ 'http-keep-alive' }) {
            if(! $options->{ 'http-keep-alive' } ) {
                $self->_set_header( \%headers, "Connection" => 'Close' );
            };
        };

        if( defined $options->{ referer }) {
            $self->_set_header( \%headers, "Referer" => $options->{ 'referer' } );
        };

        # We want to compare the headers case-insensitively
        my %headers_lc = map { lc $_ => 1 } keys %headers;

        for my $k (keys %request_default_headers) {
            if( ! $headers_lc{ lc $k }) {
                $self->_add_header( \%headers, $k, $request_default_headers{ $k });
            };
        };
        $self->_maybe_set_header( \%headers, 'Host' => $host );

        if( defined $options->{ 'cookie-jar' }) {
                $options->{'cookie-jar-options'}->{ 'write' } = 1;
        };

        if( defined( my $c = $options->{ cookie })) {
            if( $c =~ /=/ ) {
                $headers{ Cookie } = $options->{ 'cookie' };
            } else {
                $options->{'cookie-jar'} = $c;
                $options->{'cookie-jar-options'}->{ 'read' } = 1;
            };
        };

        if( my $c = $options->{ compression }) {
            if( $c =~ /^(gzip|auto)$/ ) {
                # my $compressions = HTTP::Message::decodable();
                $self->_set_header( \%headers, 'Accept-Encoding' => 'gzip' );
            };
        };

        push @res, HTTP::Request::CurlParameters->new({
            method => $method,
            uri    => $uri,
            headers => \%headers,
            body   => $body,
            maybe local_address => $options->{local_address},
            maybe cert => $options->{certificate},
            maybe capath => $options->{'ca-directory'},
            maybe credentials => $options->{ user },
            maybe output => $options->{ output },
            maybe timeout => $options->{ 'max-time' },
            maybe cookie_jar => $options->{'cookie-jar'},
            maybe cookie_jar_options => $options->{'cookie-jar-options'},
            maybe insecure => !$options->{'check-certificate'},
            maybe show_error => $options->{'show_error'},
            maybe fail => $options->{'fail'},
        });
    }

    return @res
};

1;

=head1 LIVE DEMO

L<https://corion.net/wget2lwp.psgi>

=head1 KNOWN DIFFERENCES

=head2 Incompatible cookie jar formats

Until somebody writes a robust Netscape cookie file parser and proper loading
and storage for L<HTTP::CookieJar>, this module will not be able to load and
save files in the format that wget uses.

=head2 Loading/saving cookie jars is the job of the UA

You're expected to instruct your UA to load/save cookie jars:

  use Path::Tiny;
  use HTTP::CookieJar::LWP;

  if( my $cookies = $r->cookie_jar ) {
      $ua->cookie_jar( HTTP::CookieJar::LWP->new()->load_cookies(
          path($cookies)->lines
      ));
  };

=head2 Different Content-Length for POST requests

=head2 Different delimiter for form data

The delimiter is built by L<HTTP::Message>, and C<wget> uses a different
mechanism to come up with a unique data delimiter. This results in differences
in the raw body content and the C<Content-Length> header.

=head1 MISSING FUNCTIONALITY

=over 4

=item *

File uploads / content from files

While file uploads and reading POST data from files are supported, the content
is slurped into memory completely. This can be problematic for large files
and little available memory.