libwww-perl-6.78/0000775000175000017500000000000014755474015012373 5ustar olafolaflibwww-perl-6.78/README.SSL0000644000175000017500000000057714755474015013722 0ustar olafolafAs of libwww-perl v6.02 you need to install the LWP::Protocol::https module from its own separate distribution to enable support for https://... URLs for LWP::UserAgent. This makes it possible for that distribution to state the required dependencies as non-optional. See for further discussion why we ended up with this solution. libwww-perl-6.78/t/0000775000175000017500000000000014755474015012636 5ustar olafolaflibwww-perl-6.78/t/leak/0000775000175000017500000000000014755474015013552 5ustar olafolaflibwww-perl-6.78/t/leak/no_leak.t0000644000175000017500000000122314755474015015343 0ustar olafolafuse strict; use warnings; # To ensure "no leak" in real LWP code, we should test it against HTTP servers. # However, HTTPS is not required here, so let's use an HTTP site neverssl.com. use Test::RequiresInternet 'neverssl.com' => 80; use Test::More; use Test::Needs 'Test::LeakTrace'; use File::Temp (); use LWP::UserAgent (); plan skip_all => 'skip leak test in COVERAGE' if $ENV{COVERAGE}; my ($tempfh, $tempfile) = File::Temp::tempfile(UNLINK => 0); close $tempfh; Test::LeakTrace::no_leaks_ok(sub { my $ua = LWP::UserAgent->new; my $res = $ua->get("http://neverssl.com/", ':content_file' => $tempfile); }); unlink $tempfile; done_testing; libwww-perl-6.78/t/base/0000775000175000017500000000000014755474015013550 5ustar olafolaflibwww-perl-6.78/t/base/default_content_type.t0000644000175000017500000000660614755474015020162 0ustar olafolafuse strict; use warnings; use Test::More; use LWP::UserAgent (); use HTTP::Request (); plan tests => 18; # Prevent environment from interfering with test: delete $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME}; delete $ENV{HTTPS_CA_FILE}; delete $ENV{HTTPS_CA_DIR}; delete $ENV{PERL_LWP_SSL_CA_FILE}; delete $ENV{PERL_LWP_SSL_CA_PATH}; delete $ENV{PERL_LWP_ENV_PROXY}; # default_header 'Content-Type' should be honored in POST/PUT # if the "Content => 'string'" form is used. Otherwise, x-www-form-urlencoded # will be used my $url = "http://www.example.com"; my $ua = LWP::UserAgent->new; $ua->default_header('Content-Type' => 'application/json'); $ua->proxy(http => "loopback:"); $ua->agent("foo/0.1"); # These forms will all be x-www-form-urlencoded subtest 'PATCH x-www-form-urlencoded' => sub { plan tests => 4; for my $arg ( [{cat => 'dog'}], [[cat => 'dog']], [Content => {cat => 'dog'},], [Content => [cat => 'dog'],], ) { is($ua->patch($url, @$arg)->content, <<"EOT", "patch @$arg"); PATCH http://www.example.com User-Agent: foo/0.1 Content-Length: 7 Content-Type: application/x-www-form-urlencoded cat=dog EOT } }; # These forms will all be x-www-form-urlencoded subtest 'PUT x-www-form-urlencoded' => sub { plan tests => 4; for my $arg ( [{cat => 'dog'}], [[cat => 'dog']], [Content => {cat => 'dog'},], [Content => [cat => 'dog'],], ) { is($ua->put($url, @$arg)->content, <<"EOT", "put @$arg"); PUT http://www.example.com User-Agent: foo/0.1 Content-Length: 7 Content-Type: application/x-www-form-urlencoded cat=dog EOT } }; # These forms will all be x-www-form-urlencoded subtest 'POST x-www-form-urlencoded' => sub { plan tests => 4; for my $arg ( [{cat => 'dog'}], [[cat => 'dog']], [Content => {cat => 'dog'},], [Content => [cat => 'dog'],], ) { is($ua->post($url, @$arg)->content, <<"EOT", "post @$arg"); POST http://www.example.com User-Agent: foo/0.1 Content-Length: 7 Content-Type: application/x-www-form-urlencoded cat=dog EOT } }; # These should all use the default for my $call (qw(post put patch)) { my $ucall = uc $call; my $arg = [Content => '{"cat":"dog"}']; is($ua->$call($url, @$arg)->content, <<"EOT", "$call @$arg"); $ucall http://www.example.com User-Agent: foo/0.1 Content-Length: 13 Content-Type: application/json {"cat":"dog"} EOT } # Provided Content-Type overrides default for my $call (qw(post put patch)) { my $ucall = uc $call; my $arg = ['Content-Type' => 'text/plain', Content => '{"cat":"dog"}']; is($ua->$call($url, @$arg)->content, <<"EOT", "$call @$arg with override CT"); $ucall http://www.example.com User-Agent: foo/0.1 Content-Length: 13 Content-Type: text/plain {"cat":"dog"} EOT } # Any non-true content type means use default for my $ct (0, "", undef) { for my $call (qw(post put patch)) { my $ucall = uc $call; my $arg = ['Content-Type' => $ct, Content => '{"cat":"dog"}']; my $desc = defined($ct) ? $ct : ""; my @desc_arg = map { defined $_ ? $_ : "" } @$arg; is($ua->$call($url, @$arg)->content, <<"EOT", "$call @desc_arg with false override CT '$desc' uses default"); $ucall http://www.example.com User-Agent: foo/0.1 Content-Length: 13 Content-Type: application/json {"cat":"dog"} EOT } } libwww-perl-6.78/t/base/proxy.t0000644000175000017500000000542014755474015015115 0ustar olafolafuse strict; use warnings; use Test::More; use Test::Fatal qw( exception ); use LWP::UserAgent (); plan tests => 8; # in case already defined in user's environment delete $ENV{$_} for qw(REQUEST_METHOD HTTP_PROXY http_proxy CGI_HTTP_PROXY NO_PROXY no_proxy); for my $varname ( qw(ABSURDLY_NAMED_PROXY MY_PROXY) ) { $ENV{ $varname } = "foobar"; my $ua = LWP::UserAgent->new; is(exception{ $ua->env_proxy(); }, undef, "proxy: with env: $varname: no errors"); delete $ENV{$varname}; } # simulate CGI environment { local $ENV{REQUEST_METHOD} = 'GET'; local $ENV{HTTP_PROXY} = 'something'; my $ua = LWP::UserAgent->new; $ua->env_proxy(); is $ua->proxy('http'), undef, 'HTTP_PROXY ignored in CGI environment'; } { local $ENV{REQUEST_METHOD} = 'GET'; local $ENV{CGI_HTTP_PROXY} = 'http://proxy.example.org:3128/'; my $ua = LWP::UserAgent->new; $ua->env_proxy(); is $ua->proxy('http'), 'http://proxy.example.org:3128/', 'substitute CGI_HTTP_PROXY used in CGI environment'; } SKIP: { skip "Environment variables are case-sensitive on this platform", 1 if do { local $ENV{TEST_CASE_SENSITIVITY} = "a"; local $ENV{test_case_sensitivity} = "b"; $ENV{TEST_CASE_SENSITIVITY} eq $ENV{test_case_sensitivity}; }; my @warnings; local $SIG{__WARN__} = sub { push @warnings, @_ }; local $ENV{HTTP_PROXY} = 'http://uppercase-proxy.example.org:3128/'; local $ENV{http_proxy} = 'http://lowercase-proxy.example.org:3128/'; my $ua = LWP::UserAgent->new; $ua->env_proxy(); (my $warnings = "@warnings") =~ s{ at .*\n}{}; is $warnings, qq{Environment contains multiple differing definitions for 'http_proxy'.\nUsing value from 'HTTP_PROXY' (http://uppercase-proxy.example.org:3128/) and ignoring 'http_proxy' (http://lowercase-proxy.example.org:3128/)}, 'expected warning on multiple definitions'; } { my @warnings; local $SIG{__WARN__} = sub { push @warnings, @_ }; local $ENV{HTTP_PROXY} = 'http://proxy.example.org:3128/'; local $ENV{http_proxy} = 'http://proxy.example.org:3128/'; my $ua = LWP::UserAgent->new; $ua->env_proxy(); is_deeply \@warnings, [], "No warnings if multiple definitions for 'http_proxy' exist, but with the same value"; } { local $ENV{NO_PROXY} = 'localhost,example.com'; my $ua = LWP::UserAgent->new; $ua->env_proxy(); is_deeply $ua->{no_proxy}, [qw(localhost example.com)], 'no_proxy from environment'; } { local $TODO = "Test case for GH #372"; my @warnings; local $SIG{__WARN__} = sub { push @warnings, @_ }; local $ENV{FOO} = 'BAR'; local $ENV{foo} = 'bar'; my $ua = LWP::UserAgent->new; $ua->env_proxy(); is_deeply \@warnings, [], "No warnings for unrelated environment variables"; } libwww-perl-6.78/t/base/protocols/0000775000175000017500000000000014755474015015574 5ustar olafolaflibwww-perl-6.78/t/base/protocols/nntp.t0000644000175000017500000000056314755474015016742 0ustar olafolafuse strict; use warnings; use LWP::UserAgent (); use Test::More skip_all => 'nntp.perl.org is unstable and Test::RequiresInternet is not catching it'; use Test::RequiresInternet ( 'nntp.perl.org' => 119 ); plan tests => 1; my $ua = LWP::UserAgent->new; my $res = $ua->get('nntp://nntp.perl.org/blahblahblah@blahblahblah'); is($res->code, 404, '404 on fake nntp url'); libwww-perl-6.78/t/base/protocols.t0000644000175000017500000000130614755474015015757 0ustar olafolafuse strict; use warnings; use Test::More; use LWP::UserAgent (); plan tests => 7; my $ua = LWP::UserAgent->new(); $ua->protocols_forbidden(['hTtP']); is(scalar(@{$ua->protocols_forbidden()}), 1,'$ua->protocols_forbidden'); is($ua->protocols_forbidden()->[0], 'hTtP', '$ua->protocols_forbidden->[0]'); my $response = $ua->get('http://www.cpan.org/'); isa_ok($response, 'HTTP::Response', 'Proper response object'); ok($response->is_error(), '$response->is_error'); ok(!$ua->is_protocol_supported('http'), '! $ua->is_protocol_supported("http")'); ok(!$ua->protocols_allowed(), '! $ua->protocols_allowed'); $ua->protocols_forbidden(undef); ok(!$ua->protocols_forbidden(), '$ua->protocols_forbidden(undef)'); libwww-perl-6.78/t/base/ua_handlers.t0000644000175000017500000000363614755474015016230 0ustar olafolafuse strict; use warnings; use Test::More; use LWP::UserAgent (); use HTTP::Request (); use HTTP::Response (); # Prevent environment from interfering with test: delete $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME}; delete $ENV{HTTPS_CA_FILE}; delete $ENV{HTTPS_CA_DIR}; delete $ENV{PERL_LWP_SSL_CA_FILE}; delete $ENV{PERL_LWP_SSL_CA_PATH}; delete $ENV{PERL_LWP_ENV_PROXY}; sub ua { my $ua = LWP::UserAgent->new; $ua->add_handler( request_send => sub { my ($request, $ua, $handler) = @_; return HTTP::Response->new(200,'OK',[],'ok'); } ); return $ua; } subtest 'request_send' => sub { my $ua = ua; my $res = $ua->get('http://www.example.com'); ok($res->is_success, 'handler should succeed'); is($res->content,'ok','handler-provided response should be used'); }; subtest 'request_prepare' => sub { my $ua = ua; $ua->add_handler( request_prepare => sub { # the docs say this is the way to replace the request $_[0] = HTTP::Request->new(POST=>'http://mmm.example.com/'); } ); my $res = $ua->get('http://www.example.com'); my $effective_request = $res->request; is($effective_request->method,'POST', 'the request should have been modified by the handler'); is($effective_request->uri,'http://mmm.example.com/', 'the request should have been modified by the handler'); }; subtest 'response_redirect' => sub { my $ua = ua; $ua->add_handler( response_redirect => sub { return HTTP::Request->new(PUT => 'http://put.example.com'); } ); my $res = $ua->get('http://www.example.com'); my $effective_request = $res->request; is($effective_request->method,'PUT', 'the request should have been replaced by the handler'); is($effective_request->uri,'http://put.example.com', 'the request should have been replaced by the handler'); }; done_testing; libwww-perl-6.78/t/base/proxy_request.t0000644000175000017500000000333614755474015016671 0ustar olafolafuse strict; use warnings; use Test::More; use LWP::UserAgent (); # Prevent environment from interfering with test: delete $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME}; delete $ENV{HTTPS_CA_FILE}; delete $ENV{HTTPS_CA_DIR}; delete $ENV{PERL_LWP_SSL_CA_FILE}; delete $ENV{PERL_LWP_SSL_CA_PATH}; delete $ENV{PERL_LWP_ENV_PROXY}; my $ua = LWP::UserAgent->new; $ua->default_header( 'Content-Type' => 'application/json' ); $ua->proxy( http => "loopback:" ); $ua->agent("foo/0.1"); is( $ua->get("http://www.example.org")->content, <no_proxy('ample.org'); is_deeply( $ua->{no_proxy}, ['ample.org'], "no_proxy with partial domain got set" ); is( $ua->get("http://www.example.org")->content, <no_proxy(); is_deeply( $ua->{no_proxy}, [], "no_proxy was cleared" ); $ua->no_proxy('example.org'); is_deeply( $ua->{no_proxy}, ['example.org'], "no_proxy with base domain got set" ); isnt( $ua->get("http://www.example.org")->content, <no_proxy(); is_deeply( $ua->{no_proxy}, [], "no_proxy was cleared" ); $ua->no_proxy('.example.org'); is_deeply( $ua->{no_proxy}, ['.example.org'], "no_proxy with dot-prefixed base domain got set" ); isnt( $ua->get("http://www.example.org")->content, < sub { plan tests => 4; my $ua = LWP::UserAgent->new( proxy => [ ftp => 'http://www.sol.no', ['http', 'https'] => 'http://www.sol2.no', ], no_proxy => ['test.com'], ); is($ua->proxy('ftp'), 'http://www.sol.no', q{$ua->proxy("ftp")}); is($ua->proxy($_), 'http://www.sol2.no', qq{\$ua->proxy("$_)}) for qw( http https ); is_deeply($ua->{no_proxy}, ['test.com'], q{no_proxy set to ['test.com']}); }; my $ua = LWP::UserAgent->new; my $clone = $ua->clone; like($ua->agent, qr/^libwww-perl/, '$ua->agent'); ok(!defined $ua->proxy(ftp => "http://www.sol.no"), '$ua->proxy(ftp => "http://www.sol.no")'); is($ua->proxy("ftp"), "http://www.sol.no", '$ua->proxy("ftp")'); my @a = $ua->proxy([qw(ftp http wais)], "http://proxy.foo.com"); for (@a) { $_ = "undef" unless defined; } is("@a", "http://www.sol.no undef undef", '$ua->proxy([qw(ftp http wais)], "http://proxy.foo.com")'); is($ua->proxy("http"), "http://proxy.foo.com", '$ua->proxy("http")'); is(ref($ua->default_headers), "HTTP::Headers", 'ref($ua->default_headers)'); $ua->default_header("Foo" => "bar", "Multi" => [1, 2]); is($ua->default_headers->header("Foo"), "bar", '$ua->default_headers->header("Foo")'); is($ua->default_header("Foo"), "bar", '$ua->default_header("Foo")'); # error on malformed request { my $req = HTTP::Request->new('', 'unknown:www.example.com'); my $res = $ua->simple_request($req); like($res->content(), qr/Method missing/, "simple_request: Method Missing: invalid request"); $req = HTTP::Request->new('HAHAHA', 'unknown:www.example.com'); $res = $ua->simple_request($req); like($res->content(), qr/Protocol scheme 'unknown'/, "simple_request: Invalid Protocol: invalid request"); $req = HTTP::Request->new('HAHAHA', 'www.example.com'); $res = $ua->simple_request($req); like($res->content(), qr/URL must be absolute/, "simple_request: Invalid Scheme: invalid request"); } # Try it $ua->proxy(http => "loopback:"); $ua->agent("foo/0.1"); is($ua->get("http://www.example.com", x => "y")->content, <get->content"); GET http://www.example.com User-Agent: foo/0.1 Foo: bar Multi: 1 Multi: 2 X: y EOT ok($ua->post("http://www.example.com", {x => "y", f => "ff"})->content, <put("http://www.example.com", [x => "y", f => "ff"])->content, <patch("http://www.example.com", [x => "y", f => "ff"])->content, <{proxy}), 'HASH', 'ref($clone->{proxy})'); is($ua->proxy(http => undef), "loopback:", '$ua->proxy(http => undef)'); is($ua->proxy('http'), undef, "\$ua->proxy('http')"); my $res = $ua->get("data:text/html,%3Chtml%3E%3Chead%3E%3Cmeta%20http-equiv%3D%22Content-Script-Type%22%20content%3D%22text%2Fjavascript%22%3E%3Cmeta%20http-equiv%3D%22Content-Style-Type%22%20content%3D%22text%2Fcss%22%3E%3C%2Fhead%3E%3C%2Fhtml%3E"); ok($res->header("Content-Style-Type", "text/css"), '$res->header("Content-Style-Type", "text/css")'); ok($res->header("Content-Script-Type", "text/javascript"), '$res->header("Content-Script-Type", "text/javascript")'); is(join(":", $ua->ssl_opts), "verify_hostname", '$ua->ssl_opts'); is($ua->ssl_opts("verify_hostname"), 1, '$ua->ssl_opts("verify_hostname")'); is($ua->ssl_opts("verify_hostname" => 0), 1, '$ua->ssl_opts("verify_hostname" => 0)'); is($ua->ssl_opts("verify_hostname"), 0, '$ua->ssl_opts("verify_hostname")'); is($ua->ssl_opts("verify_hostname" => undef), 0, '$ua->ssl_opts("verify_hostname" => undef)'); is($ua->ssl_opts("verify_hostname"), undef, '$ua->ssl_opts("verify_hostname")'); is(join(":", $ua->ssl_opts), "", '$ua->ssl_opts'); $ua = LWP::UserAgent->new(ssl_opts => {}); is($ua->ssl_opts("verify_hostname"), 1, '$ua->ssl_opts("verify_hostname")'); $ua = LWP::UserAgent->new(ssl_opts => { verify_hostname => 0 }); is($ua->ssl_opts("verify_hostname"), 0, '$ua->ssl_opts("verify_hostname")'); $ua = LWP::UserAgent->new(ssl_opts => { SSL_ca_file => 'cert.dat'}); is($ua->ssl_opts("verify_hostname"), 1, '$ua->ssl_opts("verify_hostname")'); is($ua->ssl_opts("SSL_ca_file"), 'cert.dat', '$ua->ssl_opts("SSL_ca_file")'); $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = 1; $ua = LWP::UserAgent->new(); is($ua->ssl_opts("verify_hostname"), 1, '$ua->ssl_opts("verify_hostname")'); $ua = LWP::UserAgent->new(ssl_opts => {}); is($ua->ssl_opts("verify_hostname"), 1, '$ua->ssl_opts("verify_hostname")'); $ua = LWP::UserAgent->new(ssl_opts => { verify_hostname => 0 }); is($ua->ssl_opts("verify_hostname"), 0, '$ua->ssl_opts("verify_hostname")'); $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = 0; $ua = LWP::UserAgent->new(); is($ua->ssl_opts("verify_hostname"), 0, '$ua->ssl_opts("verify_hostname")'); $ua = LWP::UserAgent->new(ssl_opts => {}); is($ua->ssl_opts("verify_hostname"), 0, '$ua->ssl_opts("verify_hostname")'); $ua = LWP::UserAgent->new(ssl_opts => { verify_hostname => 1 }); is($ua->ssl_opts("verify_hostname"), 1, '$ua->ssl_opts("verify_hostname")'); delete @ENV{grep /_proxy$/i, keys %ENV}; # clean out any proxy vars SKIP: { skip 'case insensitive ENV on Windows makes this fail', 3, if $^O eq 'MSWin32'; $ENV{HTTP_PROXY}= "http://example.com"; $ENV{http_proxy}= "http://otherexample.com"; my @warn; local $SIG{__WARN__}= sub { my ($msg)= @_; $msg=~s/ at .*\z//s; push @warn, $msg }; # test that we get "HTTP_PROXY" when it is set and differs from "http_proxy". $ua = LWP::UserAgent->new; is($ua->proxy('http'), undef); $ua = LWP::UserAgent->new(env_proxy => 1); is($ua->proxy('http'), "http://example.com", q{proxy('http') returns URL}); is($warn[0],"Environment contains multiple differing definitions for 'http_proxy'.\n" ."Using value from 'HTTP_PROXY' (http://example.com) and ignoring 'http_proxy' (http://otherexample.com)"); } # test that if only one of the two is set we can handle either. for my $type ('http_proxy', 'HTTP_PROXY') { delete $ENV{HTTP_PROXY}; delete $ENV{http_proxy}; $ENV{$type} = "http://example.com"; $ua = LWP::UserAgent->new; is($ua->proxy('http'), undef, q{proxy('http') returns undef} ); $ua = LWP::UserAgent->new(env_proxy => 1); is($ua->proxy('http'), "http://example.com", q{proxy('http') returns URL}); } $ENV{PERL_LWP_ENV_PROXY} = 1; $ua = LWP::UserAgent->new(); is($ua->proxy('http'), "http://example.com", "\$ua->proxy('http')"); $ua = LWP::UserAgent->new(env_proxy => 0); is($ua->proxy('http'), undef, "\$ua->proxy('http')"); $ua = LWP::UserAgent->new(); is($ua->conn_cache, undef, "\$ua->conn_cache"); $ua = LWP::UserAgent->new(keep_alive => undef); is($ua->conn_cache, undef, "\$ua->conn_cache"); $ua = LWP::UserAgent->new(keep_alive => 0); is($ua->conn_cache, undef, "\$ua->conn_cache"); $ua = LWP::UserAgent->new(keep_alive => 1); is($ua->conn_cache->total_capacity, 1, "\$ua->conn_cache->total_capacity"); done_testing(); libwww-perl-6.78/t/base/simple.t0000644000175000017500000000030214755474015015217 0ustar olafolafuse strict; use warnings; use Test::More; use LWP::Simple qw( RC_NOT_MODIFIED ); plan tests => 1; is( RC_NOT_MODIFIED, 304, 'Some HTTP::Status functions are being exported' ); done_testing; libwww-perl-6.78/t/00-report-prereqs.dd0000644000175000017500000001175514755474015016365 0ustar olafolafdo { my $x = { 'configure' => { 'requires' => { 'ExtUtils::MakeMaker' => '0', 'File::Copy' => '0', 'Getopt::Long' => '0' }, 'suggests' => { 'JSON::PP' => '2.27300' } }, 'develop' => { 'recommends' => { 'Dist::Zilla::PluginBundle::Git::VersionManager' => '0.007' }, 'requires' => { 'Authen::NTLM' => '1.02', 'File::Spec' => '0', 'IO::Handle' => '0', 'IPC::Open3' => '0', 'Pod::Coverage::TrustPod' => '0', 'Pod::Spell' => '1.25', 'Test::EOL' => '2.00', 'Test::LeakTrace' => '0.16', 'Test::MinimumVersion' => '0', 'Test::Mojibake' => '0', 'Test::More' => '0.94', 'Test::Pod' => '1.41', 'Test::Pod::Coverage' => '1.08', 'Test::Portability::Files' => '0', 'Test::Spelling' => '0.17', 'Test::Version' => '1' } }, 'runtime' => { 'requires' => { 'Digest::MD5' => '0', 'Encode' => '2.12', 'Encode::Locale' => '0', 'File::Copy' => '0', 'File::Listing' => '6', 'File::Temp' => '0', 'Getopt::Long' => '0', 'HTML::Entities' => '0', 'HTML::HeadParser' => '3.71', 'HTTP::Cookies' => '6', 'HTTP::Date' => '6', 'HTTP::Negotiate' => '6', 'HTTP::Request' => '6.18', 'HTTP::Request::Common' => '6.18', 'HTTP::Response' => '6.18', 'HTTP::Status' => '6.18', 'IO::Select' => '0', 'IO::Socket' => '0', 'LWP::MediaTypes' => '6', 'MIME::Base64' => '2.1', 'Module::Load' => '0', 'Net::FTP' => '2.58', 'Net::HTTP' => '6.18', 'Scalar::Util' => '0', 'Try::Tiny' => '0', 'URI' => '1.10', 'URI::Escape' => '0', 'WWW::RobotRules' => '6', 'parent' => '0.217', 'perl' => '5.008001', 'strict' => '0', 'warnings' => '0' }, 'suggests' => { 'Authen::NTLM' => '1.02', 'Data::Dump' => '1.13', 'IO::Socket::INET' => '0', 'LWP::Protocol::https' => '6.02' } }, 'test' => { 'recommends' => { 'CPAN::Meta' => '2.120900', 'Test::LeakTrace' => '0' }, 'requires' => { 'ExtUtils::MakeMaker' => '0', 'File::Spec' => '0', 'FindBin' => '0', 'HTTP::CookieJar::LWP' => '0', 'HTTP::Daemon' => '6.12', 'Test::Fatal' => '0', 'Test::More' => '0.96', 'Test::Needs' => '0', 'Test::RequiresInternet' => '0' } } }; $x; }libwww-perl-6.78/t/local/0000775000175000017500000000000014755474015013730 5ustar olafolaflibwww-perl-6.78/t/local/cookie_jar.t0000644000175000017500000000220214755474015016214 0ustar olafolaf#!perl use strict; use warnings; use Test::More; use Test::Fatal qw( exception ); use_ok 'LWP::UserAgent'; my $ua = LWP::UserAgent->new( cookie_jar => {} ); isa_ok $ua->cookie_jar, 'HTTP::Cookies'; $ua = LWP::UserAgent->new; is $ua->cookie_jar, undef, 'no cookie_jar by default'; $ua->cookie_jar( {} ); note '... but setting one from hash uses default cookie_jar_class'; isa_ok $ua->cookie_jar, 'HTTP::Cookies'; $ua = LWP::UserAgent->new( cookie_jar_class => 'HTTP::CookieJar::LWP' ); $ua->cookie_jar( {} ); isa_ok $ua->cookie_jar, 'HTTP::CookieJar::LWP'; $ua = LWP::UserAgent->new( cookie_jar_class => 'HTTP::CookieJar::LWP' ); is $ua->cookie_jar, undef, 'no cookie jar by default despite cookie_jar_class being set'; $ua = LWP::UserAgent->new( cookie_jar_class => 'HTTP::CookieJar::LWP', cookie_jar => {} ); note 'cookie_jar and cookie_jar_class can be ued together'; isa_ok $ua->cookie_jar, 'HTTP::CookieJar::LWP'; ok exception { LWP::UserAgent->new( cookie_jar_class => 'HTTP::CookieMonster::WasHere', cookie_jar => {}, ) }, 'dies when the cookie_jar_class cannot be loaded'; done_testing(); libwww-perl-6.78/t/local/httpsub.t0000644000175000017500000000323214755474015015604 0ustar olafolafuse strict; use warnings; use Test::More; use HTTP::Request (); use LWP::UserAgent (); use LWP::Protocol (); plan tests => 2; LWP::Protocol::implementor(http => 'myhttp'); my $ua = LWP::UserAgent->new(keep_alive => 1); $ua->proxy('http' => "http://proxy.activestate.com"); my $req = HTTP::Request->new(GET => 'http://gisle:aas@www.activestate.com'); my $res = $ua->request($req); isa_ok($res, 'HTTP::Response', 'activeState: got a response'); ok($res->as_string, 'activeState: has content'); exit; { package myhttp; use parent 'LWP::Protocol::http'; sub _conn_class { "myconn"; } } { package myconn; sub new { my $class = shift; return bless {}, $class; } sub format_request { my $self = shift; return "REQ"; } sub syswrite { my $self = shift; return length($_[0]); } sub read_response_headers { my $self = shift; return (302, "OK", "Content-type", "text/plain"); } sub read_entity_body { my $self = shift; return 0; } sub peer_http_version { my $self = shift; return "1.1"; } sub increment_response_count { my $self = shift; ++$self->{count}; } sub get_trailers { my $self = shift; return (); } } { package myhttp::SocketMethods; sub ping { my $self = shift; !$self->can_read(0); } sub increment_response_count { my $self = shift; return ++${*$self}{'myhttp_response_count'}; } } { package myhttp::Socket; use parent -norequire => qw(myhttp::SocketMethods); use parent qw(Net::HTTP); } libwww-perl-6.78/t/local/download_to_fh.t0000644000175000017500000000200414755474015017075 0ustar olafolafuse strict; use warnings; use Test::More; use File::Temp (); use LWP::UserAgent (); use LWP::Simple qw( $ua ); my $src = File::Temp->new("src-XXXXXXXXX"); my $dst = File::Temp->new("dst-XXXXXXXXX"); $src->printflush("Test\n"); $src->close; is LWP::Simple::getstore("file:$src", $dst), 200, "Successful getstore into a File::Temp object"; $dst->seek(0,0); is $dst->getline, "Test\n", "getstore mirrored into the \$dst filehandle"; TODO: { local $TODO = "mirror should support filehandles"; $dst = File::Temp->new("dst-XXXXXXXXX"); $src->printflush(''); # update timestamp is LWP::Simple::mirror("file:$src", $dst), 200, "Successful getstore into a File::Temp object"; $dst->seek(0,0); is $dst->getline, "Test\n", "getstore mirrored into the \$dst filehandle"; } $dst = File::Temp->new("dst-XXXXXXXXX"); my $res = LWP::UserAgent->new ->get("file:$src", ':content_file' => $dst); $dst->seek(0,0); is $dst->getline, "Test\n", "\$ua->get with :content_file into the \$dst filehandle"; done_testing; libwww-perl-6.78/t/local/http.t0000644000175000017500000007056214755474015015104 0ustar olafolafuse strict; use warnings; use Test::More; use Test::Fatal qw( exception ); use Config qw( %Config ); use FindBin qw( $Bin ); use HTTP::Cookies (); use HTTP::Daemon (); use HTTP::Request (); use LWP::UserAgent (); use URI (); use utf8; delete $ENV{PERL_LWP_ENV_PROXY}; $| = 1; # autoflush my $DAEMON; # allow developer to manually run the daemon and the tests # separately. Particularly useful for running with the perl # debugger. # # Run the server like this, # # PERL_LWP_ENV_HTTP_TEST_SERVER_TIMEOUT=10000 perl -I lib t/local/http.t daemon # # Then the tests like this, # # PERL_LWP_ENV_HTTP_TEST_URL=http://127.0.0.1:56957/ perl -I lib t/local/http.t my $base; if($ENV{PERL_LWP_ENV_HTTP_TEST_URL}) { $base = URI->new($ENV{PERL_LWP_ENV_HTTP_TEST_URL}); $DAEMON = 1; } my $CAN_TEST = (0==system($^X, "$Bin/../../talk-to-ourself"))? 1: 0; my $D = shift(@ARGV) || ''; if ($D eq 'daemon') { daemonize(); } else { # start the daemon and the testing if ( $^O ne 'MacOS' and $CAN_TEST and !$base ) { my $perl = $Config{'perlpath'}; $perl = $^X if $^O eq 'VMS' or -x $^X and $^X =~ m,^([a-z]:)?/,i; open($DAEMON, "$perl $0 daemon |") or die "Can't exec daemon: $!"; my $greeting = <$DAEMON> || ''; if ( $greeting =~ /(<[^>]+>)/ ) { $base = URI->new($1); } } _test(); } exit(0); sub _test { # First we make ourself a daemon in another process # listen to our daemon return plan skip_all => "Can't test on this platform" if $^O eq 'MacOS'; return plan skip_all => 'We cannot talk to ourselves' unless $CAN_TEST; return plan skip_all => 'We could not talk to our daemon' unless $DAEMON; return plan skip_all => 'No base URI' unless $base; plan tests => 136; my $ua = LWP::UserAgent->new; $ua->agent("Mozilla/0.01 " . $ua->agent); $ua->from('gisle@aas.no'); { # bad request my $req = HTTP::Request->new(GET => url("/not_found", $base)); $req->header(X_Foo => "Bar"); my $res = $ua->request($req); isa_ok($res, 'HTTP::Response', 'bad: got a response'); ok($res->is_error, 'bad: is_error'); is($res->code, 404, 'bad: code 404'); like($res->message, qr/not\s+found/i, 'bad: 404 message'); # we also expect a few headers ok($res->server, 'bad: got server header'); ok($res->date, 'bad: got date header'); } { # simple echo my $req = HTTP::Request->new(GET => url("/echo/path_info?query", $base)); $req->push_header(Accept => 'text/html'); $req->push_header(Accept => 'text/plain; q=0.9'); $req->push_header(Accept => 'image/*'); $req->push_header(':foo_bar' => 1); $req->if_modified_since(time - 300); $req->header(Long_text => "This is a very long header line which is broken between more than one line." ); $req->header(X_Foo => "Bar"); my $res = $ua->request($req); isa_ok($res, 'HTTP::Response', 'simple echo: got a response'); ok($res->is_success, 'simple echo: is_success'); is($res->code, 200, 'simple echo: code 200'); is($res->message, "OK", 'simple echo: message OK'); my $content = $res->content; my @accept = ($content =~ /^Accept:\s*(.*)/mg); like($content, qr/^From:\s*gisle\@aas\.no\n/m, 'simple echo: From good'); like($content, qr/^Host:/m, 'simple echo: Host good'); is(@accept, 3, 'simple echo: 3 Accepts'); like($content, qr/^Accept:\s*text\/html/m, 'simple echo: Accept text/html good'); like($content, qr/^Accept:\s*text\/plain/m, 'simple echo: Accept text/plain good'); like($content, qr/^Accept:\s*image\/\*/m, 'simple echo: Accept image good'); like($content, qr/^If-Modified-Since:\s*\w{3},\s+\d+/m, 'simple echo: modified good'); like($content, qr/^Long-Text:\s*This.*broken between/m, 'simple echo: long-text good'); like($content, qr/^Foo-Bar:\s*1\n/m, 'simple echo: Foo-Bar good'); like($content, qr/^X-Foo:\s*Bar\n/m, 'simple echo: X-Foo good'); like($content, qr/^User-Agent:\s*Mozilla\/0.01/m, 'simple echo: UserAgent good'); } { # echo with higher level 'get' interface my $res = $ua->get(url("/echo/path_info?query", $base), Accept => 'text/html', Accept => 'text/plain; q=0.9', Accept => 'image/*', X_Foo => "Bar", ); isa_ok($res, 'HTTP::Response', 'simple echo 2: good response object'); is($res->code, 200, 'simple echo 2: code 200'); } { # patch my $res = $ua->patch(url("/echo/path_info?query", $base), Accept => 'text/html', Accept => 'text/plain; q=0.9', Accept => 'image/*', X_Foo => "Bar", ); isa_ok($res, 'HTTP::Response', 'patch: good response object'); is($res->code, 200, 'put: code 200'); like($res->content, qr/^From: gisle\@aas.no$/m, 'patch: good From'); } { # put my $res = $ua->put(url("/echo/path_info?query", $base), Accept => 'text/html', Accept => 'text/plain; q=0.9', Accept => 'image/*', X_Foo => "Bar", ); isa_ok($res, 'HTTP::Response', 'put: good response object'); is($res->code, 200, 'put: code 200'); like($res->content, qr/^From: gisle\@aas.no$/m, 'put: good From'); } { # delete my $res = $ua->delete(url("/echo/path_info?query", $base), Accept => 'text/html', Accept => 'text/plain; q=0.9', Accept => 'image/*', X_Foo => "Bar", ); isa_ok($res, 'HTTP::Response', 'delete: good response object'); is($res->code, 200, 'delete: code 200'); like($res->content, qr/^From: gisle\@aas.no$/m, 'delete: good From'); } { # send file my $file = "test-$$.html"; open(my $fh, '>', $file) or die "Can't create $file: $!"; binmode $fh or die "Can't binmode $file: $!"; print {$fh} qq(En prøve\n

Dette er en testfil

\nJeg vet ikke hvor stor fila behøver å være heller, men dette\ner sikkert nok i massevis.\n); close($fh); my $req = HTTP::Request->new(GET => url("/file?name=$file", $base)); my $res = $ua->request($req); isa_ok($res, 'HTTP::Response', 'get file: good response object'); ok($res->is_success, 'get file: is_success'); is($res->content_type, 'text/html', 'get file: content type text/html'); is($res->content_length, 147, 'get file: 147 content length'); is($res->title, 'En prøve', 'get file: good title'); like($res->content, qr/å være/, 'get file: good content'); # A second try on the same file, should fail because we unlink it $res = $ua->request($req); isa_ok($res, 'HTTP::Response', 'get file 2nd: good response object'); ok($res->is_error, 'get file 2nd: is_error'); is($res->code, 404, 'get file 2nd: code 404'); # not found } { # try to list current directory my $req = HTTP::Request->new(GET => url("/file?name=.", $base)); my $res = $ua->request($req); isa_ok($res, 'HTTP::Response', 'dir list .: good response object'); # NYI is($res->code, 501, 'dir list .: code 501'); } { # redirect my $req = HTTP::Request->new(GET => url("/redirect/foo", $base)); my $res = $ua->request($req); isa_ok($res, 'HTTP::Response', 'redirect: good response object'); ok($res->is_success, 'redirect: is_success'); like($res->content, qr|/echo/redirect|, 'redirect: content good'); ok($res->previous->is_redirect, 'redirect: is_redirect'); is($res->previous->code, 301, 'redirect: code 301'); # Let's test a redirect loop too $req->uri(url("/redirect2", $base)); $ua->max_redirect(5); is($ua->max_redirect(), 5, 'redirect loop: max redirect 5'); $res = $ua->request($req); isa_ok($res, 'HTTP::Response', 'redirect loop: good response object'); ok($res->is_redirect, 'redirect loop: is_redirect'); like($res->header("Client-Warning"), qr/loop detected/i, 'redirect loop: client warning'); is($res->redirects, 5, 'redirect loop: 5 redirects'); $ua->max_redirect(0); is($ua->max_redirect(), 0, 'redirect loop: max redirect 0'); $res = $ua->request($req); isa_ok($res, 'HTTP::Response', 'redirect loop: good response object'); is($res->previous, undef, 'redirect loop: undefined previous'); is($res->redirects, 0, 'redirect loop: zero redirects'); $ua->max_redirect(5); is($ua->max_redirect(), 5, 'redirect loop: max redirects set back to 5'); # Test that redirects without a Location header work and don't loop $req->uri(url("/redirect4", $base)); $ua->max_redirect(5); is($ua->max_redirect(), 5, 'redirect loop: max redirect 5'); $res = $ua->request($req); isa_ok($res, 'HTTP::Response', 'redirect loop: good response object'); } { # basic auth my $req = HTTP::Request->new(GET => url("/basic", $base)); my $res = MyUA->new->request($req); isa_ok($res, 'HTTP::Response', 'basicAuth: good response object'); ok($res->is_success, 'basicAuth: is_success'); # Let's try with a $ua that does not pass out credentials $res = $ua->request($req); isa_ok($res, 'HTTP::Response', 'basicAuth: good response object'); is($res->code, 401, 'basicAuth: code 401'); # Let's try to set credentials for this realm $ua->credentials($req->uri->host_port, "libwww-perl", "ok 12", "xyzzy"); $res = $ua->request($req); isa_ok($res, 'HTTP::Response', 'basicAuth: good response object'); ok($res->is_success, 'basicAuth: is_success'); # Then illegal credentials $ua->credentials($req->uri->host_port, "libwww-perl", "user", "passwd"); $res = $ua->request($req); isa_ok($res, 'HTTP::Response', 'basicAuth: good response object'); is($res->code, 401, 'basicAuth: code 401'); } { # basic auth, UTF-8 for my $charset (qw(UTF-8 utf-8)) { my $ident = "basicAuth, charset=$charset"; my $req = HTTP::Request->new(GET => url("/basic_utf8?$charset", $base)); my $res = MyUA4->new->request($req); isa_ok($res, 'HTTP::Response', "$ident: good response object"); ok($res->is_success, "$ident: is_success"); # Let's try with a $ua that does not pass out credentials $ua->{basic_authentication} = undef; $res = $ua->request($req); isa_ok($res, 'HTTP::Response', "$ident: good response object"); is($res->code, 401, "$ident: code 401"); # Let's try to set credentials for this realm $ua->credentials($req->uri->host_port, "libwww-perl-utf8", "ök 12", "xyzzy ÅK€j!"); $res = $ua->request($req); isa_ok($res, 'HTTP::Response', "$ident: good response object"); ok($res->is_success, "$ident: is_success"); # Then illegal credentials $ua->credentials($req->uri->host_port, "libwww-perl-utf8", "user", "passwd"); $res = $ua->request($req); isa_ok($res, 'HTTP::Response', "$ident: good response object"); is($res->code, 401, "$ident: code 401"); } } { # digest my $req = HTTP::Request->new(GET => url("/digest", $base)); my $res = MyUA2->new->request($req); isa_ok($res, 'HTTP::Response', 'digestAuth: good response object'); ok($res->is_success, 'digestAuth: is_success'); # Let's try with a $ua that does not pass out credentials $ua->{basic_authentication}=undef; $res = $ua->request($req); isa_ok($res, 'HTTP::Response', 'digestAuth: good response object'); is($res->code, 401, 'digestAuth: code 401'); # Let's try to set credentials for this realm $ua->credentials($req->uri->host_port, "libwww-perl-digest", "ok 23", "xyzzy"); $res = $ua->request($req); isa_ok($res, 'HTTP::Response', 'digestAuth: good response object'); ok($res->is_success, 'digestAuth: is_success'); # Now check expired nonce # - get the right request_prepare handler my ($digest) = grep { $$_{realm} eq "libwww-perl-digest" } @{$$ua{handlers}{request_prepare}}; # - and force the next request to send the wrongnonce first $$digest{auth_param}{nonce} = "my_stale_nonce"; # - set up the nonce count for the stale nonce and lose it for the real nonce (to make it match later (server expects 1)) $$ua{authen_md5_nonce_count} = {my_stale_nonce => 3}; # - perform the request with the stale nonce $ua->credentials($req->uri->host_port, "libwww-perl-digest", "ok 23", "xyzzy"); $res = $ua->request($req); isa_ok($res, 'HTTP::Response', 'digestAuth: good response object'); ok($res->is_success, 'digestAuth: is_success'); is($$ua{authen_md5_nonce_count}{12345}, 1, 'The nonce count is recorded for the new nonce'); ok( !defined $$ua{authen_md5_nonce_count}{my_stale_nonce}, 'The nonce count is deleted for the stale nonce' ); is(@{$$digest{m_path_prefix}}, 1, 'The path prefix list is not clobbered with extra copies of the path' ); # - perform the request with a wrong nonce $$digest{auth_param}{nonce} = "my_wrong_nonce"; # - lose the nonce count, to make it match later (server expects 1) $$ua{authen_md5_nonce_count} = {}; # - perform the request with the wrong nonce $ua->credentials($req->uri->host_port, "libwww-perl-digest", "ok 23", "xyzzy"); $res = $ua->request($req); isa_ok($res, 'HTTP::Response', 'digestAuth: good response object'); is($res->code, 401, 'No retry if the nonce is not marked stale'); # Then illegal credentials $ua->credentials($req->uri->host_port, "libwww-perl-digest", "user2", "passwd"); $res = $ua->request($req); isa_ok($res, 'HTTP::Response', 'digestAuth: good response object'); is($res->code, 401, 'digestAuth: code 401'); } { # basic and digest both allowed my $req = HTTP::Request->new(GET => url("/multi_auth", $base)); my $res = MyUA3->new->request($req); isa_ok($res, 'HTTP::Response', 'multiAuth: good response object'); ok($res->is_success, 'multiAuth: is_success with digestAuth'); is($res->header('X-Basic-Called'), 1, 'multiAuth: basicAuth was tried first'); } { # proxy $ua->proxy(ftp => $base); my $req = HTTP::Request->new(GET => "ftp://ftp.perl.com/proxy"); my $res = $ua->request($req); isa_ok($res, 'HTTP::Response', 'proxy: good response object'); ok($res->is_success, 'proxy: is_success'); } { # post my $req = HTTP::Request->new(POST => url("/echo/foo", $base)); $req->content_type("application/x-www-form-urlencoded"); $req->content("foo=bar&bar=test"); my $res = $ua->request($req); isa_ok($res, 'HTTP::Response', 'post: good response object'); my $content = $res->content; ok($res->is_success, 'post: is_success'); like($content, qr/^Content-Length:\s*16$/mi, 'post: content length good'); like($content, qr/^Content-Type:\s*application\/x-www-form-urlencoded$/mi, 'post: application/x-www-form-urlencoded'); like($content, qr/^foo=bar&bar=test$/m, 'post: foo=bar&bar=test'); $req = HTTP::Request->new(POST => url("/echo/foo", $base)); $req->content_type("multipart/form-data"); $req->add_part(HTTP::Message->new(["Content-Type" => "text/plain"], "Hi\n")); $req->add_part(HTTP::Message->new(["Content-Type" => "text/plain"], "there\n")); $res = $ua->request($req); isa_ok($res, 'HTTP::Response', 'post: good response object'); ok($res->is_success, 'post: is_success'); ok($res->content =~ /^Content-Type: multipart\/form-data; boundary=/m, 'post: multipart good'); } { # mirror ok(exception { $ua->mirror(url("/echo/foo", $base)) }, 'mirror: filename required'); ok(exception { $ua->mirror(url("/echo/foo", $base), q{}) }, 'mirror: non empty filename required'); my $copy = "lwp-base-test-$$"; # downloaded copy my $res = $ua->mirror(url("/echo/foo", $base), $copy); isa_ok($res, 'HTTP::Response', 'mirror: good response object'); ok($res->is_success, 'mirror: is_success'); ok(-s $copy, 'mirror: file exists and is not empty'); unlink($copy); $ua->mirror(url("/echo/foo", $base),q{0}); ok(1, 'can write to a file called 0'); unlink('0'); } { # partial my $req = HTTP::Request->new( GET => url("/partial", $base) ); my $res = $ua->request($req); isa_ok($res, 'HTTP::Response', 'partial: good response object'); ok($res->is_success, 'partial: is_success'); # "a 206 response is considered successful" $ua->max_size(3); $req = HTTP::Request->new( GET => url("/partial", $base) ); $res = $ua->request($req); isa_ok($res, 'HTTP::Response', 'partial: good response object'); ok($res->is_success, 'partial: is_success'); # "a 206 response is considered successful" # Put max_size back how we found it. $ua->max_size(undef); like($res->as_string, qr/Client-Aborted: max_size/, 'partial: aborted'); # Client-Aborted is returned when max_size is given } { my $jar = HTTP::Cookies->new; $jar->set_cookie( 1.1, "who", "cookie_man", "/", $base->host ); $ua->cookie_jar($jar); my $req = HTTP::Request->new( GET => url("/echo", $base) ); my $res = $ua->request( $req ); # Must have cookie ok($res->is_success); ok($res->decoded_content =~ /Cookie:[^\n]+who\s*=\s*cookie_man/, "request had cookie header" ) or diag( $res->decoded_content ); $res = $ua->request( $req ); # Must have only one cookie is( scalar( () = $res->decoded_content =~ /who\s*=\s*cookie_man/g ), 1, "request had only one cookie header" ) } { # timeouts for cached connections $ua->conn_cache({}); my $conn_cache = $ua->conn_cache; isa_ok($conn_cache, 'LWP::ConnCache', 'connection cache was created'); my $timeout = $ua->timeout; $ua->timeout(30); $ua->get( url( "/echo", $base ) ); # one connection is now cached, the cached connection has a timeout of 30 is( ( $conn_cache->get_connections )[0]->timeout, 30, 'first connection has the right timeout' ); $ua->timeout(40); is( ( $conn_cache->get_connections )[0]->timeout, 40, '... and its timeout gets updated' ); # setting the connection cache to an existing cache object should # update that cache's connections' timeouts $ua->conn_cache(undef); is($ua->conn_cache, undef, 'connection cache can be set back to default value of undef'); $ua->timeout(50); is( ( $conn_cache->get_connections )[0]->timeout, 40, '... and changing the UA timeout does not affect the removed connection cache' ); $ua->conn_cache($conn_cache); is( ( $conn_cache->get_connections )[0]->timeout, 50, 'assigning existing connection cache updates its timeout to our timeout' ); # restore defaults $ua->timeout($timeout); $ua->conn_cache(undef); } { # terminate server my $req = HTTP::Request->new(GET => url("/quit", $base)); my $res = $ua->request($req); isa_ok($res, 'HTTP::Response', 'terminate: good response object'); is($res->code, 503, 'terminate: code is 503'); like($res->content, qr/Bye, bye/, 'terminate: bye bye'); } { my $ua = LWP::UserAgent->new( send_te => 0, ); my $res = $ua->request( HTTP::Request->new( GET => url("/echo", $base) ) ); ok( $res->decoded_content !~ /^TE:/m, "TE header not added" ); } } { package MyUA; use parent 'LWP::UserAgent'; sub get_basic_credentials { my($self, $realm, $uri, $proxy) = @_; if ($realm eq "libwww-perl" && $uri->rel($base) eq "basic") { return ("ok 12", "xyzzy"); } return undef; } } { package MyUA4; use parent 'LWP::UserAgent'; sub get_basic_credentials { my($self, $realm, $uri, $proxy) = @_; if ($realm eq "libwww-perl-utf8" && $uri->rel($base)->path eq "basic_utf8") { return ("ök 12", "xyzzy ÅK€j!"); } return undef; } } { package MyUA2; use parent 'LWP::UserAgent'; sub get_basic_credentials { my($self, $realm, $uri, $proxy) = @_; if ($realm eq "libwww-perl-digest" && $uri->rel($base) eq "digest") { return ("ok 23", "xyzzy"); } return undef; } } { package MyUA3; use parent 'LWP::UserAgent'; sub get_basic_credentials { my($self, $realm, $uri, $proxy) = @_; return ("irrelevant", "xyzzy"); } } sub daemonize { my %router; $router{delete_echo} = sub { my($c, $req) = @_; $c->send_basic_header(200); $c->print("Content-Type: message/http\015\012"); $c->send_crlf; $c->print($req->as_string); }; $router{get_basic} = sub { my($c, $r) = @_; my($u,$p) = $r->authorization_basic; if (defined($u) && $u eq 'ok 12' && $p eq 'xyzzy') { $c->send_basic_header(200); $c->print("Content-Type: text/plain"); $c->send_crlf; $c->send_crlf; $c->print("$u\n"); } else { $c->send_basic_header(401); $c->print("WWW-Authenticate: Basic realm=\"libwww-perl\"\015\012"); $c->send_crlf; } }; $router{get_basic_utf8} = sub { my($c, $r) = @_; my($u,$p) = $r->authorization_basic; if (defined($u) && utf8::decode($u) && utf8::decode($p) && $u eq 'ök 12' && $p eq 'xyzzy ÅK€j!') { $c->send_basic_header(200); $c->print("Content-Type: text/plain"); $c->send_crlf; $c->send_crlf; $c->print("$u\n"); } else { my $charset = $r->uri->query; $c->send_basic_header(401); $c->print("WWW-Authenticate: Basic realm=\"libwww-perl-utf8\", charset=\"$charset\"\015\012"); $c->send_crlf; } }; $router{get_digest} = sub { my($c, $r) = @_; my $auth = $r->authorization; my %auth_params; if ( defined($auth) && $auth =~ /^Digest\s+(.*)$/ ) { %auth_params = map { split /=/ } split /,\s*/, $1; } if ( %auth_params && $auth_params{username} eq q{"ok 23"} && $auth_params{realm} eq q{"libwww-perl-digest"} && $auth_params{qop} eq "auth" && $auth_params{algorithm} eq q{"MD5"} && $auth_params{uri} eq q{"/digest"} && $auth_params{nonce} eq q{"12345"} && $auth_params{nc} eq "00000001" && defined($auth_params{cnonce}) && defined($auth_params{response}) ) { $c->send_basic_header(200); $c->print("Content-Type: text/plain"); $c->send_crlf; $c->send_crlf; $c->print("ok\n"); } else { $c->send_basic_header(401); $c->print( "WWW-Authenticate: Digest realm=\"libwww-perl-digest\", nonce=\"12345\"", defined($auth_params{nonce}) && $auth_params{nonce} eq '"my_stale_nonce"' ? ', stale=true' : '', ", qop=auth\015\012" ); $c->send_crlf; } }; my $multi_auth_basic_was_called = 0; $router{get_multi_auth} = sub { my($c, $r) = @_; my($u,$p) = $r->authorization_basic; $multi_auth_basic_was_called = 1 if $u && $p; my $auth = $r->authorization; my %auth_params; if ( defined($auth) && $auth =~ /^Digest\s+(.*)$/ ) { %auth_params = map { split /=/ } split /,\s*/, $1; } if ( %auth_params && $auth_params{username} eq q{"irrelevant"} && $auth_params{realm} eq q{"libwww-perl-digest"} ) { # We don't care about the correctness of the headers here. # The get_digest test already does that. This one is for # asserting multiple different auth attempts. $c->send_basic_header(200); $c->print("X-Basic-Called: $multi_auth_basic_was_called\015\012"); $c->print("Content-Type: text/plain"); $c->send_crlf; $c->send_crlf; $c->print("ok\n"); } else { $c->send_basic_header(401); $c->print("WWW-Authenticate: Basic realm=\"libwww-perl\"\015\012"); $c->print( "WWW-Authenticate: Digest realm=\"libwww-perl-digest\", nonce=\"12345\"", ", qop=auth\015\012" ); $c->send_crlf; } }; $router{get_echo} = sub { my($c, $req) = @_; $c->send_basic_header(200); print $c "Content-Type: message/http\015\012"; $c->send_crlf; print $c $req->as_string; }; $router{get_file} = sub { my($c, $r) = @_; my %form = $r->uri->query_form; my $file = $form{'name'}; $c->send_file_response($file); unlink($file) if $file =~ /^test-/; }; $router{get_partial} = sub { my($c) = @_; $c->send_basic_header(206); print $c "Content-Type: image/jpeg\015\012"; $c->send_crlf; print $c "some fake JPEG content"; }; $router{get_proxy} = sub { my($c,$r) = @_; if ($r->method eq "GET" and $r->uri->scheme eq "ftp") { $c->send_basic_header(200); $c->send_crlf; } else { $c->send_error; } }; $router{get_quit} = sub { my($c) = @_; $c->send_error(503, "Bye, bye"); exit; # terminate HTTP server }; $router{get_redirect} = sub { my($c) = @_; $c->send_redirect("/echo/redirect"); }; $router{get_redirect2} = sub { shift->send_redirect("/redirect3/") }; $router{get_redirect3} = sub { shift->send_redirect("/redirect2/") }; $router{get_redirect4} = sub { my $r = HTTP::Response->new(303); shift->send_response($r) }; $router{post_echo} = sub { my($c,$r) = @_; $c->send_basic_header; $c->print("Content-Type: text/plain"); $c->send_crlf; $c->send_crlf; # Do it the hard way to test the send_file open(my $fh, '>', "tmp$$") || die; binmode($fh); print {$fh} $r->as_string; close($fh) || die; $c->send_file("tmp$$"); unlink("tmp$$"); }; $router{patch_echo} = sub { my($c, $req) = @_; $c->send_basic_header(200); $c->print("Content-Type: message/http\015\012"); $c->send_crlf; $c->print($req->as_string); }; $router{put_echo} = sub { my($c, $req) = @_; $c->send_basic_header(200); $c->print("Content-Type: message/http\015\012"); $c->send_crlf; $c->print($req->as_string); }; # Note: timeout of 0 is not infinite, so no point in special casing # timeout logic. my $d = HTTP::Daemon->new(Timeout => $ENV{PERL_LWP_ENV_HTTP_TEST_SERVER_TIMEOUT} || 10, LocalAddr => '127.0.0.1') || die $!; print "Pleased to meet you at: url, ">\n"; open(STDOUT, $^O eq 'VMS'? ">nl: " : ">/dev/null"); while (my $c = $d->accept) { while (my $r = $c->get_request) { my $p = ($r->uri->path_segments)[1]; my $func = lc($r->method . "_$p"); if ( $router{$func} ) { $router{$func}->($c, $r); } else { $c->send_error(404); } } $c->close; undef($c); } print STDERR "HTTP Server terminated\n"; exit; } sub url { my $u = URI->new(@_); $u = $u->abs($_[1]) if @_ > 1; $u->as_string; } libwww-perl-6.78/t/local/autoload.t0000644000175000017500000000126114755474015015723 0ustar olafolafuse strict; use warnings; use Test::More; use HTTP::Request (); use LWP::UserAgent (); use URI (); plan tests => 4; # # See if autoloading of protocol schemes work # # note no LWP::Protocol::file; my $url = "file:."; is(URI->new($url)->file, '.', 'URI of file:. is .'); my $ua = LWP::UserAgent->new; # create a useragent to test $ua->timeout(30); is($ua->timeout(), 30, 'timeout: set to 30 seconds'); my $request = HTTP::Request->new(GET => $url); my $response = $ua->request($request); isa_ok($response, 'HTTP::Response', 'Got a proper response'); ok( $response->is_success(), 'Response was successful' ); unless($response->is_success()) { diag $response->error_as_HTML; } libwww-perl-6.78/t/local/protosub.t0000644000175000017500000000262714755474015015777 0ustar olafolafuse strict; use warnings; use Test::More; use HTTP::Request (); use LWP::UserAgent (); use LWP::Protocol (); LWP::Protocol::implementor(http => 'myhttp'); plan tests => 7; # This test tries to make a custom protocol implementation by # subclassing of LWP::Protocol. my $ua = LWP::UserAgent->new; $ua->proxy('ftp' => "http://www.sn.no/"); my $req = HTTP::Request->new(GET => 'ftp://foo/'); $req->header(Cookie => "perl=cool"); my $res = $ua->request($req); isa_ok($res, 'HTTP::Response', 'sn.no: got a response'); #print $res->as_string; is($res->code, 200, 'sn.no: code 200'); is($res->content, "Howdy\n", 'sn.no: content good'); exit; { package myhttp; use parent 'LWP::Protocol'; use Test::More; sub new { my $self = shift->SUPER::new(@_); my($prot) = @_; is($prot, "http", 'protocol: http'); $self; } sub request { my $self = shift; my($request, $proxy, $arg, $size, $timeout) = @_; #print $request->as_string; is($proxy, "http://www.sn.no/", 'protocol request: proxy good'); is($request->uri, "ftp://foo/", 'protocol request: uri good'); is($request->header("cookie"), "perl=cool", 'protocol request: cookie good'); my $res = HTTP::Response->new(200 => "OK"); $res->content_type("text/plain"); $res->date(time); $self->collect_once($arg, $res, "Howdy\n"); $res; } } libwww-perl-6.78/t/local/autoload-get.t0000644000175000017500000000110514755474015016475 0ustar olafolafuse strict; use warnings; use Test::More; use LWP::UserAgent (); use URI (); plan tests => 4; # # See if autoloading of protocol schemes work # # note no LWP::Protocol::file; my $url = "file:."; is(URI->new($url)->file, '.', 'URI of file:. is .'); my $ua = LWP::UserAgent->new; $ua->timeout(30); is($ua->timeout(), 30, 'timeout: set to 30 seconds'); my $response = $ua->get($url); isa_ok($response, 'HTTP::Response', 'Got a proper response'); ok( $response->is_success(), 'Response was successful' ); unless($response->is_success()) { print $response->error_as_HTML; } libwww-perl-6.78/t/local/get.t0000644000175000017500000000413314755474015014673 0ustar olafolafuse strict; use warnings; use Test::More; use File::Temp qw( tempdir ); use LWP::Simple qw( get getprint getstore head ); my $TMPDIR = undef; if ( $^O eq 'MacOS' ) { plan skip_all => 'Cannot test on this platform'; } else { # First locate some suitable tmp-dir. We need an absolute path. for my $dir (tempdir()) { if ( open(my $fh, '>', "$dir/test-$$")) { close($fh); unlink("$dir/test-$$"); $TMPDIR = $dir; last; } } if ( $TMPDIR ) { $TMPDIR =~ tr|\\|/|; plan tests => 7; } else { plan skip_all => 'Cannot test without a suitable TMP Directory'; } } my $orig = "$TMPDIR/lwp-orig-$$"; # local file my $copy = "$TMPDIR/lwp-copy-$$"; # downloaded copy # First we create the original { open(my $fh, '>', $orig) or die "Cannot open $orig: $!"; binmode($fh); for (1..5) { print {$fh} "This is line $_ of $orig\n"; } } # Then we make a test using getprint(), so we need to capture stdout { open(my $fh, '>', $copy) or die "Cannot open $copy: $!"; select($fh); # do the retrieval getprint("file://localhost" . ($orig =~ m|^/| ? $orig : "/$orig")); select(STDOUT); } # read and compare the files my $origtext = slurp( $orig ); ok($origtext, "slurp original yielded text"); my $copytext = slurp( $copy ); ok($copytext, "slurp copy yielded text"); unlink($copy); is($copytext, $origtext, "getprint: Original and copy equal eachother"); # Test getstore() function getstore("file:$orig", $copy); $copytext = slurp( $copy ); is($copytext, $origtext, "getstore: Original and copy equal eachother"); # Test get() function is(get("file:$orig"), $origtext, "get: Returns the content"); # Test head() function is(ref head("file:$orig"), "HTTP::Response", "head: Returns a HTTP::Response object when called in scalar context"); is(@{[head("file:$orig")]}, 5, "head: Returns five headers when called in list context"); unlink($orig); unlink($copy); sub slurp { my $file = shift; open ( my $fh, '<', $file ) or die "Cannot open $file: $!"; local $/; return <$fh>; } libwww-perl-6.78/t/10-attrs.t0000644000175000017500000000342714755474015014402 0ustar olafolafuse strict; use warnings; use Test::More; use LWP::UserAgent (); plan tests => 9; # Prevent environment from interfering with test: delete $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME}; delete $ENV{HTTPS_CA_FILE}; delete $ENV{HTTPS_CA_DIR}; delete $ENV{PERL_LWP_SSL_CA_FILE}; delete $ENV{PERL_LWP_SSL_CA_PATH}; delete $ENV{PERL_LWP_ENV_PROXY}; # credentials { my $ua = LWP::UserAgent->new(); $ua->credentials(undef, 'my realm', 'user', 'pass'); is($ua->credentials(undef, 'my realm'), 'user:pass', 'credentials: undef netloc'); $ua->credentials('example.com:80', undef, 'user', 'pass'); is($ua->credentials('example.com:80', undef), 'user:pass', 'credentials: undef realm'); $ua->credentials('example.com:80', 'my realm', undef, 'pass'); is($ua->credentials('example.com:80', 'my realm'), ':pass', 'credentials: undef username'); $ua->credentials('example.com:80', 'my realm', 'user', undef); is($ua->credentials('example.com:80', 'my realm'), 'user:', 'credentials: undef pass'); $ua->credentials(undef, undef, 'user', 'pass'); is($ua->credentials(undef, undef), 'user:pass', 'credentials: undef netloc and realm'); $ua->credentials(undef, undef, undef, undef); is($ua->credentials(undef, undef), ':', 'credentials: undef all'); $ua->credentials('example.com:80', 'my realm', 'user', 'pass'); is($ua->credentials('example.com:80', 'my realm'), 'user:pass', 'credentials: got proper creds for example:80'); # ask for the credentials incorrectly my $creds = $ua->credentials('example.com'); is($creds, undef, 'credentials: no realm on request for info'); # ask for the credentials incorrectly with bad realm $creds = $ua->credentials('example.com', 'invalid'); is($creds, undef, 'credentials: invalid realm on request for info'); } libwww-perl-6.78/t/redirect.t0000644000175000017500000000316714755474015014631 0ustar olafolafuse strict; use warnings; # This is a regression test for #171 use Test::More; # Test::RequiresInternet is used here basically just to SKIP tests if # NO_NETWORK_TESTING has been enabled. We would want to do this particularly if # there is a badly behaved router on the network where the tests are being run. use Test::RequiresInternet; use LWP::UserAgent (); # Regarding the choice of 234.198.51.100 as a test IP address, please see # https://tools.ietf.org/html/rfc6676 # # RFC 5737 reserves the block 198.51.100.0/24 (TEST-NET-2) for use in # documentation. However, some broken network setups may cause packets # for TEST-NET-2 to be filtered and this test to fail. # # The chosen address 234.198.51.100 is a multicast address derived # from TEST-NET-2. Since adjoining addresses might be valid addresses, # this particular address is less likely to get filtered. my $url = 'http://234.198.51.100/'; my $ua = LWP::UserAgent->new(); # default number of redirects { $ua->timeout(1); my $res = $ua->get($url); like( $res->header("Client-Warning"), qr/Internal Response/i, 'Timeout gives a client warning' ); like( $res->content, qr/Can't connect/i, '... and has tells us about the problem' ); } # no redirects { $ua->timeout(1); $ua->max_redirect(0); my $res = $ua->get($url); like( $res->header("Client-Warning"), qr/Internal Response/i, 'Timeout with no redirects gives a client warning' ); like( $res->content, qr/Can't connect/i, '... and has tells us about the problem' ); } done_testing(); libwww-perl-6.78/t/robot/0000775000175000017500000000000014755474015013763 5ustar olafolaflibwww-perl-6.78/t/robot/ua-get.t0000644000175000017500000001116214755474015015331 0ustar olafolafuse strict; use warnings; use Test::More; use Config qw( %Config ); use FindBin qw( $Bin ); use HTTP::Daemon (); use LWP::RobotUA (); use URI (); use utf8; delete $ENV{PERL_LWP_ENV_PROXY}; $| = 1; # autoflush my $DAEMON; my $base; my $CAN_TEST = (0==system($^X, "$Bin/../../talk-to-ourself"))? 1: 0; my $D = shift(@ARGV) || ''; if ($D eq 'daemon') { daemonize(); } else { # start the daemon and the testing if ( $^O ne 'MacOS' and $CAN_TEST ) { my $perl = $Config{'perlpath'}; $perl = $^X if $^O eq 'VMS' or -x $^X and $^X =~ m,^([a-z]:)?/,i; open($DAEMON, "$perl $0 daemon |") or die "Can't exec daemon: $!"; my $greeting = <$DAEMON> || ''; if ( $greeting =~ /(<[^>]+>)/ ) { $base = URI->new($1); } } _test(); } exit(0); sub _test { # First we make ourself a daemon in another process # listen to our daemon return plan skip_all => "Can't test on this platform" if $^O eq 'MacOS'; return plan skip_all => 'We cannot talk to ourselves' unless $CAN_TEST; return plan skip_all => 'We could not talk to our daemon' unless $DAEMON; return plan skip_all => 'No base URI' unless $base; plan tests => 18; my $ua = LWP::RobotUA->new('lwp-spider/0.1', 'gisle@aas.no'); $ua->delay(0.05); # rather quick robot { # someplace my $res = $ua->get( url("/someplace", $base) ); isa_ok($res, 'HTTP::Response', 'someplace: got a response object'); ok($res->is_success, 'someplace: is_success'); } { # robots my $res = $ua->get( url("/private/place", $base) ); isa_ok($res, 'HTTP::Response', 'robots: got a response object'); is($res->code, 403, 'robots: code: 403'); like($res->message, qr/robots\.txt/, 'robots: msg contains robots.txt'); } { # foo my $res = $ua->get( url("/foo", $base) ); isa_ok($res, 'HTTP::Response', 'foo: got a response object'); is($res->code, 404, 'foo: code: 404'); # Let the robotua generate "Service unavailable/Retry After response"; $ua->delay(1); $ua->use_sleep(0); $res = $ua->get( url("/foo", $base) ); isa_ok($res, 'HTTP::Response', 'foo: got a response object'); is( $res->code, 503, 'foo: code: 503'); ok($res->header("Retry-After"), 'foo: header: retry-after'); } { # quit $ua->delay(0); my $res = $ua->get( url("/quit", $base) ); isa_ok($res, 'HTTP::Response', 'quit: got a response object'); is( $res->code, 503, 'quit: code: 503'); like($res->content, qr/Bye, bye/, 'quit: Content: bye bye'); $ua->delay(1); # host_wait() should be around 60s now ok(abs($ua->host_wait($base->host_port) - 60) < 5, 'quit: host-wait'); # Number of visits to this place should be is($ua->no_visits($base->host_port), 4, 'quit: no_visits 4'); } { # RobotUA used to have problem with mailto URLs. $ENV{SENDMAIL} = "dummy"; my $res = $ua->get("mailto:gisle\@aas.no"); isa_ok($res, 'HTTP::Response', 'mailto: got a response object'); is($res->code, 400, 'mailto: response code: 400'); is($res->message, "Library does not allow method GET for 'mailto:' URLs", "mailto: right message"); } } sub daemonize { my %router; $router{get_robotstxt} = sub { my($c,$r) = @_; $c->send_basic_header; $c->print("Content-Type: text/plain"); $c->send_crlf; $c->send_crlf; $c->print("User-Agent: *\n Disallow: /private\n "); }; $router{get_someplace} = sub { my($c,$r) = @_; $c->send_basic_header; $c->print("Content-Type: text/plain"); $c->send_crlf; $c->send_crlf; $c->print("Okidok\n"); }; $router{get_quit} = sub { my($c) = @_; $c->send_error(503, "Bye, bye"); exit; # terminate HTTP server }; my $d = HTTP::Daemon->new(Timeout => 10, LocalAddr => '127.0.0.1') || die $!; print "Pleased to meet you at: url, ">\n"; open(STDOUT, $^O eq 'VMS'? ">nl: " : ">/dev/null"); while (my $c = $d->accept) { while (my $r = $c->get_request) { my $p = ($r->uri->path_segments)[1]; $p =~ s/\W//g; my $func = lc($r->method . "_$p"); if ( $router{$func} ) { $router{$func}->($c, $r); } else { $c->send_error(404); } } $c->close; undef($c); } print STDERR "HTTP Server terminated\n"; exit; } sub url { my $u = URI->new(@_); $u = $u->abs($_[1]) if @_ > 1; $u->as_string; } libwww-perl-6.78/t/robot/ua.t0000644000175000017500000001067314755474015014562 0ustar olafolafuse strict; use warnings; use Test::More; use Config qw( %Config ); use FindBin qw( $Bin ); use HTTP::Daemon (); use HTTP::Request (); use LWP::RobotUA (); use URI (); use utf8; delete $ENV{PERL_LWP_ENV_PROXY}; $| = 1; # autoflush my $DAEMON; my $base; my $CAN_TEST = (0==system($^X, "$Bin/../../talk-to-ourself"))? 1: 0; my $D = shift(@ARGV) || ''; if ($D eq 'daemon') { daemonize(); } else { # start the daemon and the testing if ( $^O ne 'MacOS' and $CAN_TEST ) { my $perl = $Config{'perlpath'}; $perl = $^X if $^O eq 'VMS' or -x $^X and $^X =~ m,^([a-z]:)?/,i; open($DAEMON, "$perl $0 daemon |") or die "Can't exec daemon: $!"; my $greeting = <$DAEMON> || ''; if ( $greeting =~ /(<[^>]+>)/ ) { $base = URI->new($1); } } _test(); } exit(0); sub _test { # First we make ourself a daemon in another process # listen to our daemon return plan skip_all => "Can't test on this platform" if $^O eq 'MacOS'; return plan skip_all => 'We cannot talk to ourselves' unless $CAN_TEST; return plan skip_all => 'We could not talk to our daemon' unless $DAEMON; return plan skip_all => 'No base URI' unless $base; plan tests => 14; my $ua = LWP::RobotUA->new('lwp-spider/0.1', 'gisle@aas.no'); $ua->delay(0.05); # rather quick robot { # someplace my $req = HTTP::Request->new(GET => url("/someplace", $base)); my $res = $ua->request($req); isa_ok($res, 'HTTP::Response', 'someplace: got a response object'); ok($res->is_success, 'someplace: is_success'); } { # robots my $req = HTTP::Request->new(GET => url("/private/place", $base)); my $res = $ua->request($req); isa_ok($res, 'HTTP::Response', 'robots: got a response object'); is($res->code, 403, 'robots: code 403'); like($res->message, qr/robots\.txt/, 'robots: message robots.txt'); } { # foo my $req = HTTP::Request->new(GET => url("/foo", $base)); my $res = $ua->request($req); isa_ok($res, 'HTTP::Response', 'robots: got a response object'); is($res->code, 404, 'robots: code 404'); # Let the robotua generate "Service unavailable/Retry After response"; $ua->delay(1); $ua->use_sleep(0); $req = HTTP::Request->new(GET => url("/foo", $base)); $res = $ua->request($req); is($res->code, 503, 'foo: code 503'); ok($res->header('Retry-After'), "foo: header Retry-After"); } { # quit $ua->delay(0); my $req = HTTP::Request->new(GET => url("/quit", $base)); my $res = $ua->request($req); isa_ok($res, 'HTTP::Response', 'quit: got a response object'); is($res->code, 503, 'quit: code 503'); like($res->content, qr/Bye, bye/, "quit: content bye bye"); $ua->delay(1); # host_wait() should be around 60s now ok( abs($ua->host_wait($base->host_port) - 60) < 5, 'host_wait good'); # Number of visits to this place should be is( $ua->no_visits($base->host_port), 4, 'no_visits good'); } } sub daemonize { my %router; $router{get_robotstxt} = sub { my($c,$r) = @_; $c->send_basic_header; $c->print("Content-Type: text/plain"); $c->send_crlf; $c->send_crlf; $c->print("User-Agent: *\n Disallow: /private\n "); }; $router{get_someplace} = sub { my($c,$r) = @_; $c->send_basic_header; $c->print("Content-Type: text/plain"); $c->send_crlf; $c->send_crlf; $c->print("Okidok\n"); }; $router{get_quit} = sub { my($c) = @_; $c->send_error(503, "Bye, bye"); exit; # terminate HTTP server }; my $d = HTTP::Daemon->new(Timeout => 10, LocalAddr => '127.0.0.1') || die $!; print "Pleased to meet you at: url, ">\n"; open(STDOUT, $^O eq 'VMS'? ">nl: " : ">/dev/null"); while (my $c = $d->accept) { while (my $r = $c->get_request) { my $p = ($r->uri->path_segments)[1]; $p =~ s/\W//g; my $func = lc($r->method . "_$p"); if ( $router{$func} ) { $router{$func}->($c, $r); } else { $c->send_error(404); } } $c->close; undef($c); } print STDERR "HTTP Server terminated\n"; exit; } sub url { my $u = URI->new(@_); $u = $u->abs($_[1]) if @_ > 1; $u->as_string; } libwww-perl-6.78/t/00-report-prereqs.t0000644000175000017500000001360114755474015016231 0ustar olafolaf#!perl use strict; use warnings; # This test was generated by Dist::Zilla::Plugin::Test::ReportPrereqs 0.029 use Test::More tests => 1; use ExtUtils::MakeMaker; use File::Spec; # from $version::LAX my $lax_version_re = qr/(?: undef | (?: (?:[0-9]+) (?: \. | (?:\.[0-9]+) (?:_[0-9]+)? )? | (?:\.[0-9]+) (?:_[0-9]+)? ) | (?: v (?:[0-9]+) (?: (?:\.[0-9]+)+ (?:_[0-9]+)? )? | (?:[0-9]+)? (?:\.[0-9]+){2,} (?:_[0-9]+)? ) )/x; # hide optional CPAN::Meta modules from prereq scanner # and check if they are available my $cpan_meta = "CPAN::Meta"; my $cpan_meta_pre = "CPAN::Meta::Prereqs"; my $HAS_CPAN_META = eval "require $cpan_meta; $cpan_meta->VERSION('2.120900')" && eval "require $cpan_meta_pre"; ## no critic # Verify requirements? my $DO_VERIFY_PREREQS = 1; sub _max { my $max = shift; $max = ( $_ > $max ) ? $_ : $max for @_; return $max; } sub _merge_prereqs { my ($collector, $prereqs) = @_; # CPAN::Meta::Prereqs object if (ref $collector eq $cpan_meta_pre) { return $collector->with_merged_prereqs( CPAN::Meta::Prereqs->new( $prereqs ) ); } # Raw hashrefs for my $phase ( keys %$prereqs ) { for my $type ( keys %{ $prereqs->{$phase} } ) { for my $module ( keys %{ $prereqs->{$phase}{$type} } ) { $collector->{$phase}{$type}{$module} = $prereqs->{$phase}{$type}{$module}; } } } return $collector; } my @include = qw( ); my @exclude = qw( ); # Add static prereqs to the included modules list my $static_prereqs = do './t/00-report-prereqs.dd'; # Merge all prereqs (either with ::Prereqs or a hashref) my $full_prereqs = _merge_prereqs( ( $HAS_CPAN_META ? $cpan_meta_pre->new : {} ), $static_prereqs ); # Add dynamic prereqs to the included modules list (if we can) my ($source) = grep { -f } 'MYMETA.json', 'MYMETA.yml'; my $cpan_meta_error; if ( $source && $HAS_CPAN_META && (my $meta = eval { CPAN::Meta->load_file($source) } ) ) { $full_prereqs = _merge_prereqs($full_prereqs, $meta->prereqs); } else { $cpan_meta_error = $@; # capture error from CPAN::Meta->load_file($source) $source = 'static metadata'; } my @full_reports; my @dep_errors; my $req_hash = $HAS_CPAN_META ? $full_prereqs->as_string_hash : $full_prereqs; # Add static includes into a fake section for my $mod (@include) { $req_hash->{other}{modules}{$mod} = 0; } for my $phase ( qw(configure build test runtime develop other) ) { next unless $req_hash->{$phase}; next if ($phase eq 'develop' and not $ENV{AUTHOR_TESTING}); for my $type ( qw(requires recommends suggests conflicts modules) ) { next unless $req_hash->{$phase}{$type}; my $title = ucfirst($phase).' '.ucfirst($type); my @reports = [qw/Module Want Have/]; for my $mod ( sort keys %{ $req_hash->{$phase}{$type} } ) { next if grep { $_ eq $mod } @exclude; my $want = $req_hash->{$phase}{$type}{$mod}; $want = "undef" unless defined $want; $want = "any" if !$want && $want == 0; if ($mod eq 'perl') { push @reports, ['perl', $want, $]]; next; } my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required"; my $file = $mod; $file =~ s{::}{/}g; $file .= ".pm"; my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC; if ($prefix) { my $have = MM->parse_version( File::Spec->catfile($prefix, $file) ); $have = "undef" unless defined $have; push @reports, [$mod, $want, $have]; if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) { if ( $have !~ /\A$lax_version_re\z/ ) { push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)"; } elsif ( ! $full_prereqs->requirements_for( $phase, $type )->accepts_module( $mod => $have ) ) { push @dep_errors, "$mod version '$have' is not in required range '$want'"; } } } else { push @reports, [$mod, $want, "missing"]; if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) { push @dep_errors, "$mod is not installed ($req_string)"; } } } if ( @reports ) { push @full_reports, "=== $title ===\n\n"; my $ml = _max( map { length $_->[0] } @reports ); my $wl = _max( map { length $_->[1] } @reports ); my $hl = _max( map { length $_->[2] } @reports ); if ($type eq 'modules') { splice @reports, 1, 0, ["-" x $ml, "", "-" x $hl]; push @full_reports, map { sprintf(" %*s %*s\n", -$ml, $_->[0], $hl, $_->[2]) } @reports; } else { splice @reports, 1, 0, ["-" x $ml, "-" x $wl, "-" x $hl]; push @full_reports, map { sprintf(" %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2]) } @reports; } push @full_reports, "\n"; } } } if ( @full_reports ) { diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports; } if ( $cpan_meta_error || @dep_errors ) { diag "\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n"; } if ( $cpan_meta_error ) { my ($orig_source) = grep { -f } 'MYMETA.json', 'MYMETA.yml'; diag "\nCPAN::Meta->load_file('$orig_source') failed with: $cpan_meta_error\n"; } if ( @dep_errors ) { diag join("\n", "\nThe following REQUIRED prerequisites were not satisfied:\n", @dep_errors, "\n" ); } pass('Reported prereqs'); # vim: ts=4 sts=4 sw=4 et: libwww-perl-6.78/LICENSE0000644000175000017500000004641614755474015013411 0ustar olafolafThis software is copyright (c) 1995 by Gisle Aas. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 1995 by Gisle Aas. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Perl Artistic License 1.0 --- This software is Copyright (c) 1995 by Gisle Aas. This is free software, licensed under: The Perl Artistic License 1.0 The "Artistic License" Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder as specified below. "Copyright Holder" is whoever is named in the copyright or copyrights for the package. "You" is you, if you're thinking about copying or distributing this Package. "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as uunet.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) give non-standard executables non-standard names, and clearly document the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. You may embed this Package's interpreter within an executable of yours (by linking); this shall be construed as a mere form of aggregation, provided that the complete Standard Version of the interpreter is so embedded. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whoever generated them, and may be sold commercially, and may be aggregated with this Package. If such scripts or library files are aggregated with this Package via the so-called "undump" or "unexec" methods of producing a binary executable image, then distribution of such an image shall neither be construed as a distribution of this Package nor shall it fall under the restrictions of Paragraphs 3 and 4, provided that you do not represent such an executable image as a Standard Version of this Package. 7. C subroutines (or comparably compiled subroutines in other languages) supplied by you and linked into this Package in order to emulate subroutines and variables of the language defined by this Package shall not be considered part of this Package, but are the equivalent of input as in Paragraph 6, provided these subroutines do not change the language in any way that would cause it to fail the regression tests for the language. 8. Aggregation of this Package with a commercial distribution is always permitted provided that the use of this Package is embedded; that is, when no overt attempt is made to make this Package's interfaces visible to the end user of the commercial distribution. Such use shall not be construed as a distribution of this Package. 9. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End libwww-perl-6.78/MANIFEST0000644000175000017500000000437414755474015013532 0ustar olafolaf# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.032. CONTRIBUTING.md Changes INSTALL LICENSE MANIFEST META.json META.yml Makefile.PL README.SSL bin/lwp-download bin/lwp-dump bin/lwp-mirror bin/lwp-request codecov.yml cpanfile dist.ini examples/handler-order.pl lib/LWP.pm lib/LWP/Authen/Basic.pm lib/LWP/Authen/Digest.pm lib/LWP/Authen/Ntlm.pm lib/LWP/ConnCache.pm lib/LWP/Debug.pm lib/LWP/Debug/TraceHTTP.pm lib/LWP/DebugFile.pm lib/LWP/MemberMixin.pm lib/LWP/Protocol.pm lib/LWP/Protocol/cpan.pm lib/LWP/Protocol/data.pm lib/LWP/Protocol/file.pm lib/LWP/Protocol/ftp.pm lib/LWP/Protocol/gopher.pm lib/LWP/Protocol/http.pm lib/LWP/Protocol/loopback.pm lib/LWP/Protocol/mailto.pm lib/LWP/Protocol/nntp.pm lib/LWP/Protocol/nogo.pm lib/LWP/RobotUA.pm lib/LWP/Simple.pm lib/LWP/UserAgent.pm lwpcook.pod lwptut.pod perlimports.toml t/00-report-prereqs.dd t/00-report-prereqs.t t/10-attrs.t t/base/default_content_type.t t/base/protocols.t t/base/protocols/nntp.t t/base/proxy.t t/base/proxy_request.t t/base/simple.t t/base/ua.t t/base/ua_handlers.t t/leak/no_leak.t t/local/autoload-get.t t/local/autoload.t t/local/cookie_jar.t t/local/download_to_fh.t t/local/get.t t/local/http.t t/local/httpsub.t t/local/protosub.t t/redirect.t t/robot/ua-get.t t/robot/ua.t talk-to-ourself xt/author/00-compile.t xt/author/eol.t xt/author/live/apache-http10.t xt/author/live/jigsaw/auth-b.t xt/author/live/jigsaw/auth-d.t xt/author/live/jigsaw/chunk.t xt/author/live/jigsaw/md5-get.t xt/author/live/jigsaw/md5.t xt/author/live/jigsaw/neg-get.t xt/author/live/jigsaw/neg.t xt/author/live/jigsaw/redirect-post.t xt/author/live/jigsaw/te.t xt/author/live/online.t xt/author/minimum-version.t xt/author/misc/dbmrobot xt/author/misc/get-callback xt/author/misc/get-file xt/author/mojibake.t xt/author/net/cache-timeouts.t xt/author/net/cgi-bin/moved xt/author/net/cgi-bin/nph-slowdata xt/author/net/cgi-bin/slowread xt/author/net/cgi-bin/test xt/author/net/cgi-bin/timeout xt/author/net/config.pl_dist xt/author/net/http-get.t xt/author/net/http-post.t xt/author/net/http-timeout.t xt/author/net/mirror.t xt/author/net/moved.t xt/author/net/proxy.t xt/author/pod-coverage.t xt/author/pod-spell.t xt/author/pod-syntax.t xt/author/portability.t xt/author/test-version.t xt/dependent-modules.t libwww-perl-6.78/INSTALL0000644000175000017500000000450014755474015013421 0ustar olafolafThis is the Perl distribution libwww-perl. Installing libwww-perl is straightforward. ## Installation with cpanm If you have cpanm, you only need one line: % cpanm LWP If it does not have permission to install modules to the current perl, cpanm will automatically set up and install to a local::lib in your home directory. See the local::lib documentation (https://metacpan.org/pod/local::lib) for details on enabling it in your environment. ## Installing with the CPAN shell Alternatively, if your CPAN shell is set up, you should just be able to do: % cpan LWP ## Manual installation As a last resort, you can manually install it. If you have not already downloaded the release tarball, you can find the download link on the module's MetaCPAN page: https://metacpan.org/pod/LWP Untar the tarball, install configure prerequisites (see below), then build it: % perl Makefile.PL % make && make test Then install it: % make install On Windows platforms, you should use `dmake` or `nmake`, instead of `make`. If your perl is system-managed, you can create a local::lib in your home directory to install modules to. For details, see the local::lib documentation: https://metacpan.org/pod/local::lib The prerequisites of this distribution will also have to be installed manually. The prerequisites are listed in one of the files: `MYMETA.yml` or `MYMETA.json` generated by running the manual build process described above. ## Configure Prerequisites This distribution requires other modules to be installed before this distribution's installer can be run. They can be found under the "configure_requires" key of META.yml or the "{prereqs}{configure}{requires}" key of META.json. ## Other Prerequisites This distribution may require additional modules to be installed after running Makefile.PL. Look for prerequisites in the following phases: * to run make, PHASE = build * to use the module code itself, PHASE = runtime * to run tests, PHASE = test They can all be found in the "PHASE_requires" key of MYMETA.yml or the "{prereqs}{PHASE}{requires}" key of MYMETA.json. ## Documentation libwww-perl documentation is available as POD. You can run `perldoc` from a shell to read the documentation: % perldoc LWP For more information on installing Perl modules via CPAN, please see: https://www.cpan.org/modules/INSTALL.html libwww-perl-6.78/bin/0000775000175000017500000000000014755474015013143 5ustar olafolaflibwww-perl-6.78/bin/lwp-dump0000755000175000017500000000522714755474015014642 0ustar olafolaf#!/usr/bin/perl use strict; use warnings; use LWP::UserAgent (); use Getopt::Long qw(GetOptions); use Encode; use Encode::Locale; GetOptions(\my %opt, 'parse-head', 'max-length=n', 'keep-client-headers', 'method=s', 'agent=s', 'request',) || usage(); my $url = shift || usage(); @ARGV && usage(); sub usage { (my $progname = $0) =~ s,.*/,,; die <<"EOT"; Usage: $progname [options] Recognized options are: --agent --keep-client-headers --max-length --method --parse-head --request EOT } my $ua = LWP::UserAgent->new( parse_head => $opt{'parse-head'} || 0, keep_alive => 1, env_proxy => 1, agent => $opt{agent} || "lwp-dump/$LWP::UserAgent::VERSION ", ); my $req = HTTP::Request->new($opt{method} || 'GET' => decode(locale => $url)); my $res = $ua->simple_request($req); $res->remove_header(grep /^Client-/, $res->header_field_names) unless $opt{'keep-client-headers'} or ($res->header("Client-Warning") || "") eq "Internal response"; if ($opt{request}) { $res->request->dump; print "\n"; } $res->dump(maxlength => $opt{'max-length'}); __END__ =head1 NAME lwp-dump - See what headers and content is returned for a URL =head1 SYNOPSIS B [ I ] I =head1 DESCRIPTION The B program will get the resource identified by the URL and then dump the response object to STDOUT. This will display the headers returned and the initial part of the content, escaped so that it's safe to display even binary content. The escapes syntax used is the same as for Perl's double quoted strings. If there is no content the string "(no content)" is shown in its place. The following options are recognized: =over =item B<--agent> I Override the user agent string passed to the server. =item B<--keep-client-headers> LWP internally generate various C headers that are stripped by B in order to show the headers exactly as the server provided them. This option will suppress this. =item B<--max-length> I How much of the content to show. The default is 512. Set this to 0 for unlimited. If the content is longer then the string is chopped at the limit and the string "...\n(### more bytes not shown)" appended. =item B<--method> I Use the given method for the request instead of the default "GET". =item B<--parse-head> By default B will not try to initialize headers by looking at the head section of HTML documents. This option enables this. This corresponds to L. =item B<--request> Also dump the request sent. =back =head1 SEE ALSO L, L, L libwww-perl-6.78/bin/lwp-request0000755000175000017500000003757114755474015015374 0ustar olafolaf#!/usr/bin/perl # Simple user agent using LWP library. =head1 NAME lwp-request - Simple command line user agent =head1 SYNOPSIS B [B<-afPuUsSedvhx>] [B<-m> I] [B<-b> I] [B<-t> I] [B<-i> I] [B<-c> I] [B<-C> I] [B<-p> I] [B<-o> I] I... =head1 DESCRIPTION This program can be used to send requests to WWW servers and your local file system. The request content for POST, PUT and PATCH methods is read from stdin. The content of the response is printed on stdout. Error messages are printed on stderr. The program returns a status value indicating the number of URLs that failed. The options are: =over 4 =item -m Set which method to use for the request. If this option is not used, then the method is derived from the name of the program. =item -f Force request through, even if the program believes that the method is illegal. The server might reject the request eventually. =item -b This URI will be used as the base URI for resolving all relative URIs given as argument. =item -t Set the timeout value for the requests. The timeout is the amount of time that the program will wait for a response from the remote server before it fails. The default unit for the timeout value is seconds. You might append "m" or "h" to the timeout value to make it minutes or hours, respectively. The default timeout is '3m', i.e. 3 minutes. =item -i