#!perl use warnings; use strict; use Test::More tests => 47; use lib qw( t t/local ); use LocalServer; use HTTP::Daemon; use HTTP::Response; =head1 NAME =head1 SYNOPSIS This tests Mech's Back "button". Tests were converted from t/live/back.t, and subsequently enriched to deal with RT ticket #8109. =cut BEGIN { use Tools; } BEGIN { delete @ENV{ qw( IFS CDPATH ENV BASH_ENV ) }; use_ok( 'WWW::Mechanize' ); } my $mech = WWW::Mechanize->new(cookie_jar => {}); isa_ok( $mech, 'WWW::Mechanize' ); isa_ok( $mech->cookie_jar(), 'HTTP::Cookies', 'this $mech starts with a cookie jar' ); my $html = <<'HTML'; %s Whatever. Images Scripts Ports Modules
HTML my $server = LocalServer->spawn( html => $html ); isa_ok( $server, 'LocalServer' ); ok( !$mech->back(), 'With no stack, no going back' ); $mech->get($server->url); ok( $mech->success, 'Fetched OK' ); my $first_base = $mech->base; my $title = $mech->title; $mech->follow_link( n=>2 ); ok( $mech->success, 'Followed OK' ); ok( $mech->back(), 'Back should succeed' ); is( $mech->base, $first_base, 'Did the base get set back?' ); is( $mech->title, $title, 'Title set back?' ); $mech->follow_link( text => 'Images' ); ok( $mech->success, 'Followed OK' ); ok( $mech->back(), 'Back should succeed' ); is( $mech->base, $first_base, 'Did the base get set back?' ); is( $mech->title, $title, 'Title set back?' ); is( scalar @{$mech->{page_stack}}, 0, 'Pre-search check' ); $mech->submit_form( fields => { 'q' => 'perl' }, ); ok( $mech->success, 'Searched for Perl' ); like( $mech->title, qr/search.cgi/, 'Right page title' ); is( scalar @{$mech->{page_stack}}, 1, 'POST is in the stack' ); $mech->head( $server->url ); ok( $mech->success, 'HEAD succeeded' ); is( scalar @{$mech->{page_stack}}, 1, 'HEAD is not in the stack' ); ok( $mech->back(), 'Back should succeed' ); ok( $mech->success, 'Back' ); is( $mech->base, $first_base, 'Did the base get set back?' ); is( $mech->title, $title, 'Title set back?' ); is( scalar @{$mech->{page_stack}}, 0, 'Post-search check' ); =head2 Back and misc. internal fields RT ticket #8109 reported that back() is broken after reload(), and that the cookie_jar was also damaged by back(). We test for that: reload() should not alter the back() stack, and the cookie jar should not be versioned (once a cookie is set, hitting the back button in a browser does not cause it to go away). =cut $mech->follow_link( text => 'Images' ); $mech->reload(); ok( $mech->back(), 'Back should succeed' ); is($mech->title, $title, 'reload() does not push page to stack' ); ok(defined($mech->cookie_jar()), '$mech still has a cookie jar after a number of back()'); # Now some other weird stuff. Start with a fresh history by recreating # $mech. SKIP: { skip 'Test::Memory::Cycle not installed', 1 unless $canTMC; memory_cycle_ok( $mech, 'No memory cycles found' ); } $mech = WWW::Mechanize->new( autocheck => 0 ); isa_ok( $mech, 'WWW::Mechanize' ); $mech->get( $server->url ); ok( $mech->success, 'Got root URL' ); my @links = qw( /scripts /ports/ modules/ ); is( scalar @{$mech->{page_stack}}, 0, 'Pre-404 check' ); my $server404url = $server->error_notfound('404check'); $mech->get($server404url); is( $mech->status, 404 , '404 check') or diag( qq{\$server404url=$server404url\n\$mech->content="}, $mech->content, qq{"\n} ); is( scalar @{$mech->{page_stack}}, 1, 'Even 404s get on the stack' ); ok( $mech->back(), 'Back should succeed' ); is( $mech->uri, $server->url, 'Back from the 404' ); is( scalar @{$mech->{page_stack}}, 0, 'Post-404 check' ); for my $link ( @links ) { $mech->get( $link ); warn $mech->status() if (! $mech->success()); is( $mech->status, 200, "Get $link" ); ok( $mech->back(), 'Back should succeed' ); is( $mech->uri, $server->url, "Back from $link" ); } SKIP: { skip 'Test::Memory::Cycle not installed', 1 unless $canTMC; memory_cycle_ok( $mech, 'No memory cycles found' ); }