WWW-Mechanize-2.19/0000775000175000017500000000000014672047002012462 5ustar olafolafWWW-Mechanize-2.19/perlcriticrc0000644000175000017500000000127714672047002015077 0ustar olafolaf[-CodeLayout::ProhibitParensWithBuiltins] [CodeLayout::ProhibitHardTabs] allow_leading_tabs = 0 [-CodeLayout::RequireTidyCode] [-ControlStructures::ProhibitPostfixControls] [-Documentation::RequirePodAtEnd] [-Documentation::RequirePodSections] [-Editor::RequireEmacsFileVariables] [-ErrorHandling::RequireCarping] [-InputOutput::ProhibitInteractiveTest] [-InputOutput::ProhibitBacktickOperators] [-Miscellanea::RequireRcsKeywords] [-Modules::RequireVersionVar] [-RegularExpressions::RequireExtendedFormatting] [-RegularExpressions::RequireLineBoundaryMatching] [-ValuesAndExpressions::ProhibitConstantPragma] [-ValuesAndExpressions::ProhibitEmptyQuotes] [-Variables::ProhibitPunctuationVars] WWW-Mechanize-2.19/tidyall.ini0000644000175000017500000000110514672047002014620 0ustar olafolaf[PerlCritic non-auto-generated xt] select = xt/author/live/wikipedia.t argv = --profile=$ROOT/perlcriticrc [PerlTidy non-auto-generated xt] select = xt/author/live/wikipedia.t [PerlTidy] select = lib/**/*.pm select = t/**/*.{pm,t} select = t/local/log-server select = t/local/referer-server select = script/* ; ignore autogenerated files ignore = t/00-report-prereqs.t ; ignore build artefacts ignore = blib/**/* ignore = .build/**/* ignore = WWW-Mechanize*/**/* argv = --profile=$ROOT/perltidyrc [SortLines::Naturally] select = .gitignore [UniqueLines] select = .gitignore WWW-Mechanize-2.19/t/0000775000175000017500000000000014672047002012725 5ustar olafolafWWW-Mechanize-2.19/t/history_2.html0000644000175000017500000000053414672047002015535 0ustar olafolaf Testing the history_2
WWW-Mechanize-2.19/t/find_link_xhtml.t0000644000175000017500000000353214672047002016264 0ustar olafolaf#!perl -T use warnings; use strict; use Test::More; use URI::file (); BEGIN { use_ok('WWW::Mechanize'); } my $mech = WWW::Mechanize->new( cookie_jar => undef ); isa_ok( $mech, 'WWW::Mechanize' ); my $uri = URI::file->new_abs('t/find_link_xhtml.html')->as_string; $mech->get($uri); ok( $mech->success, "Fetched $uri" ) or die q{Can't get test page}; my @links = map { [ $_->text, $_->url ] } $mech->links(); my @expected = ( [ 'One', 'http://www.example.com/1' ], [ 'Five', 'http://www.example.com/5' ], [ 'Seven', 'http://www.example.com/7' ], ); is_deeply \@links, \@expected, "We find exactly the valid links"; # now, test with explicit marked_sections => 1 $mech = WWW::Mechanize->new( cookie_jar => undef, marked_sections => 1 ); isa_ok( $mech, 'WWW::Mechanize' ); $uri = URI::file->new_abs('t/find_link_xhtml.html')->as_string; $mech->get($uri); ok( $mech->success, "Fetched $uri" ) or die q{Can't get test page}; @links = map { [ $_->text, $_->url ] } $mech->links(); @expected = ( [ 'One', 'http://www.example.com/1' ], [ 'Five', 'http://www.example.com/5' ], [ 'Seven', 'http://www.example.com/7' ], ); is_deeply \@links, \@expected, "We find exactly the valid links, explicitly"; # now, test with marked_sections => 0, giving us legacy results $mech = WWW::Mechanize->new( cookie_jar => undef, marked_sections => undef ); isa_ok( $mech, 'WWW::Mechanize' ); $uri = URI::file->new_abs('t/find_link_xhtml.html')->as_string; $mech->get($uri); ok( $mech->success, "Fetched $uri" ) or die q{Can't get test page}; @links = map { [ $_->text, $_->url ] } $mech->links(); @expected = ( [ 'One', 'http://www.example.com/1' ], [ 'Five', 'http://www.example.com/5' ], [ 'Six', 'http://www.example.com/6' ], # yeah... ); is_deeply \@links, \@expected, "We can enable the legacy behaviour"; done_testing(); WWW-Mechanize-2.19/t/aliases.t0000644000175000017500000000053514672047002014534 0ustar olafolaf#!perl -T use warnings; use strict; use Test::More tests => 8; BEGIN { use_ok('WWW::Mechanize'); } my @aliases = WWW::Mechanize::known_agent_aliases(); is( scalar @aliases, 6, 'All aliases accounted for' ); for my $alias (@aliases) { like( $alias, qr/^(Mac|Windows|Linux) /, 'We only know Mac, Windows or Linux' ); } WWW-Mechanize-2.19/t/credentials-api.t0000644000175000017500000000226614672047002016162 0ustar olafolafuse strict; use warnings; use Test::More tests => 4; use LWP::UserAgent (); use WWW::Mechanize (); use URI (); =pod The monkeypatch introduced since at least WWW::Mechanize 1.34 only ever allows one instance of every LWP::UserAgent descendant to have credentials. This test checks that this buggy behaviour is gone. =cut my $uri = URI->new('http://localhost'); my $realm = 'myrealm'; my $ua = LWP::UserAgent->new(); $ua->credentials( $uri, $realm, 'user', 'pass' ); my $mech1 = WWW::Mechanize->new(); my $mech2 = WWW::Mechanize->new(); my $mech3 = WWW::Mechanize->new(); $mech1->credentials( 'mech1', 'mech1' ); $mech2->credentials( 'mech2', 'mech2' ); is_deeply( [ $ua->credentials( $uri, $realm ) ], [ 'user', 'pass' ], 'LWP::UserAgent instance retains its old credentials' ); is_deeply( [ $mech1->get_basic_credentials( $realm, $uri ) ], [ 'mech1', 'mech1' ], 'First instance retains its credentials' ); is_deeply( [ $mech2->get_basic_credentials( $realm, $uri ) ], [ 'mech2', 'mech2' ], 'Second instance retains its credentials' ); is_deeply( [ $mech3->get_basic_credentials( $realm, $uri ) ], [], 'Untouched instance retains its credentials' ); WWW-Mechanize-2.19/t/mech-dump/0000775000175000017500000000000014672047002014604 5ustar olafolafWWW-Mechanize-2.19/t/mech-dump/file_not_found.t0000644000175000017500000000153514672047002017765 0ustar olafolaf#!perl use warnings; use strict; use Test::More; use Test::Output qw( output_like ); use File::Spec (); # See https://stackoverflow.com/a/32054866/1331451 plan skip_all => 'capturing output from system() is broken in 5.14 and 5.16 on Windows' if $^O eq 'MSWin32' && ( $] >= 5.014 && $] < 5.017 ); plan skip_all => 'Not installing mech-dump' if -e File::Spec->catfile(qw( t SKIP-MECH-DUMP )); my $exe = File::Spec->catfile(qw( script mech-dump )); if ( $^O eq 'VMS' ) { $exe = qq[mcr $^X -Ilib $exe]; } my $perl; $perl = $1 if $^X =~ /^(.+)$/; # The following file should not exist. my $source = 'file:not_found.404'; my $command = "$perl -Ilib $exe $source"; output_like( sub { system $command; }, undef, qr/file:not_found.404 returns status 404/, 'Errors when a local file is not found' ); done_testing; WWW-Mechanize-2.19/t/mech-dump/mech-dump.t0000644000175000017500000000746014672047002016655 0ustar olafolaf#!perl -T use warnings; use strict; use Test::More; use File::Spec (); use LWP (); BEGIN { delete @ENV{qw( IFS CDPATH ENV BASH_ENV PATH )}; } plan skip_all => 'Not installing mech-dump' if -e File::Spec->catfile(qw( t SKIP-MECH-DUMP )); my $exe = File::Spec->catfile(qw( script mech-dump )); if ( $^O eq 'VMS' ) { $exe = qq[mcr $^X -Ilib $exe]; } my $perl; $perl = $1 if $^X =~ /^(.+)$/; subtest 'Success' => sub { # Simply use a file: uri instead of the filename to make this test # more independent of what URI::* thinks. my $source = 'file:t/google.html t/find_inputs.html t/html_file.txt'; my $command = "$perl -Ilib $exe --forms --images --links $source"; my $actual = `$command`; my $expected; if ( $LWP::VERSION < 5.800 ) { $expected = <<'EOF'; GET file:/target-page [bob-the-form] hl=en (hidden) ie=ISO-8859-1 (hidden) notgoogle= (hidden readonly) q= btnG=Google Search (submit) btnI=I'm Feeling Lucky (submit) /images/logo.gif /imghp?hl=en&tab=wi&ie=UTF-8 /grphp?hl=en&tab=wg&ie=UTF-8 /dirhp?hl=en&tab=wd&ie=UTF-8 /nwshp?hl=en&tab=wn&ie=UTF-8 /advanced_search?hl=en /preferences?hl=en /language_tools?hl=en /tour/services/query.html /ads/ /services/ /options/ /about.html POST http://localhost/ (multipart/form-data) [1st_form] 1a= (text) submit1=Submit (image) submit2=Submit (submit) POST http://localhost/ [2nd_form] YourMom= (text) opt[2]= (text) 1b= (text) submit=Submit (submit) POST http://localhost/ [3rd_form] YourMom= (text) YourDad= (text) YourSister= (text) YourSister= (text) submit=Submit (submit) GET http://localhost [text-form] one= (text) EOF } else { $expected = <<'EOF'; GET file:/target-page [bob-the-form] hl=en (hidden readonly) ie=ISO-8859-1 (hidden readonly) notgoogle= (hidden readonly) q= (text) btnG=Google Search (submit) btnI=I'm Feeling Lucky (submit) /images/logo.gif /imghp?hl=en&tab=wi&ie=UTF-8 /grphp?hl=en&tab=wg&ie=UTF-8 /dirhp?hl=en&tab=wd&ie=UTF-8 /nwshp?hl=en&tab=wn&ie=UTF-8 /advanced_search?hl=en /preferences?hl=en /language_tools?hl=en /tour/services/query.html /ads/ /services/ /options/ /about.html POST http://localhost/ (multipart/form-data) [1st_form] 1a= (text) submit1=Submit (image) submit2=Submit (submit) POST http://localhost/ [2nd_form] YourMom= (text) opt[2]= (text) 1b= (text) submit=Submit (submit) POST http://localhost/ [3rd_form] YourMom= (text) YourDad= (text) YourSister= (text) YourSister= (text) submit=Submit (submit) GET http://localhost [text-form] one= (text) EOF } my @actual = split /\s*\n/, $actual; my @expected = split /\s*\n/, $expected; # First line is platform-dependent, so handle it accordingly. shift @expected; my $first = shift @actual; like( $first, qr/^GET file:.*\/target-page \[bob-the-form\]/, 'First line matches' ); cmp_ok( @expected, '>', 0, 'Still some expected' ); cmp_ok( @actual, '>', 0, 'Still some actual' ); is_deeply( \@actual, \@expected, 'Rest of the lines match' ); }; done_testing; WWW-Mechanize-2.19/t/field.t0000644000175000017500000000302414672047002014172 0ustar olafolaf#!perl -T use warnings; use strict; use Test::More; use URI::file (); BEGIN { use_ok('WWW::Mechanize'); } my $mech = WWW::Mechanize->new( cookie_jar => undef ); isa_ok( $mech, 'WWW::Mechanize' ); my $uri = URI::file->new_abs('t/field.html')->as_string; my $response = $mech->get($uri); ok( $response->is_success, "Fetched $uri" ); $mech->field( 'dingo', 'Modified!' ); is( $mech->value('dingo'), 'Modified!', 'dingo got changed' ); $mech->set_visible( 'bingo', 'bango' ); is( $mech->value('dingo'), 'bingo', 'dingo changed' ); is( $mech->value('bongo'), 'bango', 'bongo changed' ); $mech->set_visible( [ radio => 'wongo!' ], 'boingo' ); is( $mech->value('wango'), 'wongo!', 'wango changed' ); is( $mech->value( 'dingo', 2 ), 'boingo', 'dingo changed' ); ok( !$mech->value('textarea_name'), 'textarea is empty' ); $mech->field( 'textarea_name' => 'foobar' ); is( $mech->value('textarea_name'), 'foobar', 'textarea has been populated' ); for my $name (qw/__no_value __value_empty/) { ok( !$mech->value($name), "$name is empty" ) or diag $mech->field($name); $mech->field( $name, 'foo' ); is( $mech->value($name), 'foo', "$name changed" ); } for my $name (qw/__value/) { TODO: { local $TODO = 'HTML::TokeParser does not understand how to parse this and returns a value where it should not have one'; ok( !$mech->value($name), "$name is empty" ) or diag $mech->field($name); } $mech->field( $name, 'foo' ); is( $mech->value($name), 'foo', "$name changed" ); } done_testing; WWW-Mechanize-2.19/t/find_inputs.t0000644000175000017500000000247714672047002015444 0ustar olafolaf#!perl -T use warnings; use strict; use Test::More tests => 11; use URI::file (); BEGIN { use_ok('WWW::Mechanize'); } my $mech = WWW::Mechanize->new( cookie_jar => undef ); isa_ok( $mech, 'WWW::Mechanize' ); my $uri = URI::file->new_abs('t/find_inputs.html')->as_string; $mech->get($uri); ok( $mech->success, "Fetched $uri" ) or die q{Can't get test page}; FIRST_FORM: { my @inputs = $mech->find_all_inputs(); is( scalar @inputs, 3, 'Exactly three inputs' ); my @submits = $mech->find_all_submits(); is( scalar @submits, 2, 'Exactly two submits' ); } SECOND_FORM: { $mech->form_number(2); my @inputs = $mech->find_all_inputs(); is( scalar @inputs, 4, 'Exactly four inputs' ); my @submits = $mech->find_all_submits(); is( scalar @submits, 1, 'Exactly one submit' ); } THIRD_FORM: { $mech->form_number(3); my @inputs = $mech->find_all_inputs(); is( scalar @inputs, 5, 'Exactly five inputs' ); my @relatives = $mech->find_all_inputs( name_regex => qr/^Your/ ); is( scalar @relatives, 4, 'Found four relatives' ); my @sisters = $mech->find_all_inputs( name => 'YourSister' ); is( scalar @sisters, 2, 'Found two sisters' ); my @submit_sisters = $mech->find_all_inputs( name => 'YourSister' ); is( scalar @submit_sisters, 2, 'But no sisters are submits' ); } WWW-Mechanize-2.19/t/uri.t0000644000175000017500000000026314672047002013710 0ustar olafolafuse strict; use warnings; use Test::More; use WWW::Mechanize (); my $mech = WWW::Mechanize->new; is( $mech->uri, undef, 'undef uri() with a pristine object' ); done_testing(); WWW-Mechanize-2.19/t/upload.html0000644000175000017500000000035014672047002015073 0ustar olafolaf
WWW-Mechanize-2.19/t/select.t0000644000175000017500000000551714672047002014377 0ustar olafolaf#!perl -T use warnings; use strict; use Test::More; use Test::Warnings qw(warning :no_end_test); use URI::file (); BEGIN { use_ok('WWW::Mechanize'); } my $mech = WWW::Mechanize->new( cookie_jar => undef ); isa_ok( $mech, 'WWW::Mechanize' ); my $uri = URI::file->new_abs('t/select.html')->as_string; my $response = $mech->get($uri); ok( $response->is_success, "Fetched $uri" ); my ( $sendsingle, @sendmulti, %sendsingle, %sendmulti, $rv, $return, @return, @singlereturn, $form ); # possible values are: aaa, bbb, ccc, ddd $sendsingle = 'aaa'; @sendmulti = qw(bbb ccc); @singlereturn = ( $sendmulti[0] ); %sendsingle = ( n => 1 ); %sendmulti = ( n => [ 2, 3 ] ); ok( $mech->form_number(1), 'set form to number 1' ); $form = $mech->current_form(); # Multi-select # pass multiple values to a multi select $form->param( 'multilist', undef ); $mech->select( 'multilist', \@sendmulti ); @return = $form->param('multilist'); is_deeply( \@return, \@sendmulti, 'multi->multi value is ' . join( ' ', @return ) ); $form->param( 'multilist', undef ); $mech->select( 'multilist', \%sendmulti ); @return = $form->param('multilist'); is_deeply( \@return, \@sendmulti, 'multi->multi value is ' . join( ' ', @return ) ); # pass a single value to a multi select $form->param( 'multilist', undef ); $mech->select( 'multilist', $sendsingle ); $return = $form->param('multilist'); is( $return, $sendsingle, "single->multi value is '$return'" ); $form->param( 'multilist', undef ); $mech->select( 'multilist', \%sendsingle ); $return = $form->param('multilist'); is( $return, $sendsingle, "single->multi value is '$return'" ); # Single select # pass multiple values to a single select (only the _first_ should be set) $form->param( 'singlelist', undef ); $mech->select( 'singlelist', \@sendmulti ); @return = $form->param('singlelist'); is_deeply( \@return, \@singlereturn, 'multi->single value is ' . join( ' ', @return ) ); $form->param( 'singlelist', undef ); $mech->select( 'singlelist', \%sendmulti ); @return = $form->param('singlelist'); is_deeply( \@return, \@singlereturn, 'multi->single value is ' . join( ' ', @return ) ); # pass a single value to a single select $form->param( 'singlelist', undef ); $rv = $mech->select( 'singlelist', $sendsingle ); $return = $form->param('singlelist'); is( $return, $sendsingle, "single->single value is '$return'" ); $form->param( 'singlelist', undef ); $rv = $mech->select( 'singlelist', \%sendsingle ); $return = $form->param('singlelist'); is( $return, $sendsingle, "single->single value is '$return'" ); # test return value from $mech->select is( $rv, 1, 'return 1 after successful select' ); like warning { $rv = $mech->select( 'missing_list', 1 ) }, qr/not found/, 'warning when field is not found'; is( $rv, undef, 'return undef after failed select' ); done_testing; WWW-Mechanize-2.19/t/cookies.t0000644000175000017500000000603714672047002014552 0ustar olafolaf# XXX add cookie reading on the server side to the test BEGIN { delete @ENV{qw( http_proxy HTTP_PROXY )}; } use warnings; use strict; use Test::More; if ( $^O =~ /Win32/ ) { plan skip_all => 'HTTP::Server::Simple does not support Windows yet.'; } else { plan tests => 14; } use WWW::Mechanize (); use URI::Escape qw( uri_escape uri_unescape ); use lib 't/'; use TestServer (); my $ncookies = 0; sub send_cookies { my $req = shift; ++$ncookies; my $cvalue = uri_escape("Cookie #$ncookies"); HTTP::Response->new( 200, 'OK', [ 'Content-Type' => 'text/html', 'Set-Cookie' => "my_cookie=$cvalue; Path=/; Domain=127.0.0.1; Expires=+1h;", ], <<"END_HTML", Home of Cookie #$ncookies

Here is Cookie #$ncookies

END_HTML ); } sub nosend_cookies { HTTP::Response->new( 200, 'OK', [ 'Content-Type' => 'text/html' ], <<"END_HTML", No cookies sent

No cookies sent

END_HTML ); } my $server = TestServer->new(); $server->set_dispatch( { '/feedme' => \&send_cookies, '/nocookie' => \&nosend_cookies, } ); my $pid = $server->background(); my $root = $server->root; my $cookiepage_url = $root . 'feedme'; my $nocookiepage_url = $root . 'nocookie'; my $mech = WWW::Mechanize->new( autocheck => 0 ); isa_ok( $mech, 'WWW::Mechanize' ); FIRST_COOKIE: { $mech->get($cookiepage_url); is( $mech->status, 200, 'First fetch works' ); my $cookieval = cookieval($mech); is( $cookieval, 'Cookie #1', 'First cookie matches' ); is( $mech->title, 'Home of Cookie #1', 'Right title' ); } SECOND_COOKIE: { $mech->get($cookiepage_url); is( $mech->status, 200, 'Second fetch works' ); my $cookieval = cookieval($mech); is( $cookieval, 'Cookie #2', 'Second cookie matches' ); is( $mech->title, 'Home of Cookie #2', 'Right title' ); } BACK_TO_FIRST_PAGE: { $mech->back(); my $cookieval = cookieval($mech); is( $cookieval, 'Cookie #2', 'Cookie did not change...' ); is( $mech->title, 'Home of Cookie #1', '... but back to the first page title' ); } FORWARD_TO_NONCOOKIE_PAGE: { $mech->get($nocookiepage_url); my $cookieval = cookieval($mech); is( $cookieval, 'Cookie #2', 'Cookie did not change...' ); is( $mech->title, 'No cookies sent', 'On the proper 3rd page' ); } GET_A_THIRD_COOKIE: { $mech->get($cookiepage_url); my $cookieval = cookieval($mech); is( $cookieval, 'Cookie #3', 'Got the third cookie' ); is( $mech->title, 'Home of Cookie #3', 'Title is correct' ); } my $signal = ( $^O eq 'MSWin32' ) ? 9 : 15; my $nprocesses = kill $signal, $pid; is( $nprocesses, 1, 'Signaled the child process' ); sub cookieval { my $mech = shift; return uri_unescape( $mech->cookie_jar->{COOKIES}{'127.0.0.1'}{'/'}{'my_cookie'}[1] ); } WWW-Mechanize-2.19/t/image-new.t0000644000175000017500000000310414672047002014757 0ustar olafolaf#!perl -T use warnings; use strict; use Test::More tests => 15; BEGIN { use_ok('WWW::Mechanize::Image'); } # test new style API my $img = WWW::Mechanize::Image->new( { url => 'url.html', base => 'http://base.example.com/', name => 'name', alt => 'alt', tag => 'a', height => 2112, width => 5150, attrs => { id => 'id', class => 'foo bar' }, } ); is( $img->url, 'url.html', 'url() works' ); is( $img->base, 'http://base.example.com/', 'base() works' ); is( $img->name, 'name', 'name() works' ); is( $img->alt, 'alt', 'alt() works' ); is( $img->tag, 'a', 'tag() works' ); is( $img->height, 2112, 'height works' ); is( $img->width, 5150, 'width works' ); is( $img->attrs->{id}, 'id', 'attrs/id works' ); is( $img->attrs->{class}, 'foo bar', 'attrs/class works' ); is( $img->url_abs, 'http://base.example.com/url.html', 'url_abs works' ); isa_ok( $img->URI, 'URI::URL', 'Returns an object' ); my $img_no_src = WWW::Mechanize::Image->new( { url => undef, base => 'http://base.example.com/', tag => 'img', height => 123, width => 321, } ); isa_ok( $img_no_src, 'WWW::Mechanize::Image' ); is( $img_no_src->url, undef, 'url() without url is undef' ); isa_ok( $img_no_src->URI, 'URI::URL', 'Returns an object' ); WWW-Mechanize-2.19/t/find_inputs.html0000644000175000017500000000161514672047002016136 0ustar olafolaf