-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
Hello,
Here is my renewed patch on the same issue, please ignore the previous
one. I've taken Andy's comment into account, by removing the
- ->{inhibit_page_stack} flag and refactoring ->request() into
- ->_push_page_stack() followed by ->_update_page() (new method).
Best regards,
- --
Dominique QUATRAVAUX Ingénieur senior
01 44 42 00 08 IDEALX
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.2.4 (GNU/Linux)
Comment: Using GnuPG with Thunderbird -
http://enigmail.mozdev.org
iD8DBQFBh7YYMJAKAU3mjcsRAmXjAJ9BDj/OkdEVKLn9wC9n7EcOf/MVuwCfS37n
Rh/UQcvkIZW8aHrh7B4wpIU=
=gvXY
-----END PGP SIGNATURE-----
diff -Nr -U3 --exclude=CVS www-mechanize.WALK-TREE-CONTEXT/lib/WWW/Mechanize.pm www-mechanize/lib/WWW/Mechanize.pm
--- www-mechanize.WALK-TREE-CONTEXT/lib/WWW/Mechanize.pm Tue Nov 2 13:24:48 2004
+++ www-mechanize/lib/WWW/Mechanize.pm Tue Nov 2 17:09:24 2004
@@ -324,8 +320,8 @@
=head2 $mech->reload()
-Acts like the reload button in a browser: Reperforms the current
-request.
+Acts like the reload button in a browser: reperforms the current
+request. The history (as per the L</back> method) is not altered.
Returns the L<HTTP::Response> object from the reload, or C<undef>
if there's no current request.
@@ -335,9 +331,9 @@
sub reload {
my $self = shift;
- return unless $self->{req};
+ return unless defined(my $request = $self->{req});
- return $self->request( $self->{req} );
+ $self->_update_page($request, $self->_make_request( $request, @_ ));
}
=head2 $mech->back()
@@ -1686,35 +1866,8 @@
$self->_push_page_stack();
}
- $self->{req} = $request;
- $self->{redirected_uri} = $request->uri->as_string;
-
- my $res = $self->{res} = $self->_make_request( $request, @_ );
-
- # These internal hash elements should be dropped in favor of
- # the accessors soon. -- 1/19/03
- $self->{status} = $res->code;
- $self->{base} = $res->base;
- $self->{ct} = $res->content_type || "";
-
- if ( $res->is_success ) {
- $self->{uri} = $self->{redirected_uri};
- $self->{last_uri} = $self->{uri};
- } else {
- if ( $self->{autocheck} ) {
- $self->die( "Error ", $request->method, "ing ", $request->uri, ": ", $res->message );
- }
- }
-
- $self->_reset_page;
- if ($self->is_html) {
- $self->update_html($res->content);
- } else {
- $self->{content} = $res->content;
- }
-
- return $res;
-} # request
+ $self->_update_page($request, $self->_make_request( $request, @_ ));
+}
=head2 $mech->update_html( $html )
@@ -1926,6 +2103,48 @@
return;
}
+=head2 $mech->_update_page($request, $response)
+
+Updates all internal variables in $mech as if $request was just
+performed, and returned $response. The page stack is B<not> altered by
+this method, it is up to caller (e.g. L</request>) to do that.
+
+=cut
+
+sub _update_page {
+ my ($self, $request, $res) = @_;
+
+ $self->{req} = $request;
+ $self->{redirected_uri} = $request->uri->as_string;
+
+ $self->{res} = $res;
+
+ # These internal hash elements should be dropped in favor of
+ # the accessors soon. -- 1/19/03
+ $self->{status} = $res->code;
+ $self->{base} = $res->base;
+ $self->{ct} = $res->content_type || "";
+
+ if ( $res->is_success ) {
+ $self->{uri} = $self->{redirected_uri};
+ $self->{last_uri} = $self->{uri};
+ } else {
+ if ( $self->{autocheck} ) {
+ $self->die( "Error ", $request->method, "ing ", $request->uri, ": ", $res->message );
+ }
+ }
+
+ $self->_reset_page;
+ if ($self->is_html) {
+ $self->update_html($res->content);
+ } else {
+ $self->{content} = $res->content;
+ }
+
+ return $res;
+} # _update_state
+
+
=head2 $mech->_extract_links()
Extracts links from the content of a webpage, and populates the C<{links}>
@@ -2029,7 +2248,11 @@
my $save_stack = $self->{page_stack};
$self->{page_stack} = [];
- push( @$save_stack, $self->clone );
+ my $clone = $self->clone;
+ # Huh, LWP::UserAgent->clone() ditches cookie_jar? Copy it over now.
+ $clone->{cookie_jar} = $self->cookie_jar;
+ push( @$save_stack, $clone );
+
if ( $self->stack_depth > 0 ) {
while ( @$save_stack > $self->stack_depth ) {
shift @$save_stack;
diff -Nr -U3 --exclude=CVS www-mechanize.WALK-TREE-CONTEXT/t/local/back.t www-mechanize/t/local/back.t
--- www-mechanize.WALK-TREE-CONTEXT/t/local/back.t Thu Jan 1 01:00:00 1970
+++ www-mechanize/t/local/back.t Tue Nov 2 12:38:39 2004
@@ -0,0 +1,168 @@
+#!perl
+
+use strict;
+use Test::More tests => 38;
+use lib '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_ok( 'WWW::Mechanize' );
+ delete @ENV{ qw( http_proxy HTTP_PROXY PATH IFS
+ CDPATH ENV BASH_ENV) };
+
+}
+
+my $mech = WWW::Mechanize->new(cookie_jar => {});
+isa_ok( $mech, "WWW::Mechanize" );
+ok(defined($mech->cookie_jar()),
+ 'this $mech starts with a cookie jar');
+
+isa_ok((my $server = LocalServer->spawn(html => <<'HTML')), "LocalServer");
+<html>
+<head><title>%s</title></head>
+<body>Whatever.
+<a href="images/">Images</a>
+<a href="/scripts">Scripts</a>
+<a href="/ports/">Ports</a>
+<a href="modules/">Modules</a>
+<form action="/search.cgi">
+<input type="text" name="q">
+<input type="submit">
+</form>
+</body>
+</html>
+HTML
+
+$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' );
+
+$mech->back();
+is( $mech->base, $first_base, "Did the base get set back?" );
+is( $mech->title, $title, "Title set back?" );
+
+$mech->follow( "Images" );
+ok( $mech->success, 'Followed OK' );
+
+$mech->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, "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" );
+
+$mech->back();
+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( "Images" );
+$mech->reload();
+$mech->back();
+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: {
+ eval "use Test::Memory::Cycle";
+ skip "Test::Memory::Cycle not installed", 1 if $@;
+
+ memory_cycle_ok( $mech, "No memory cycles found" );
+}
+
+$mech = WWW::Mechanize->new();
+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 $server404 = HTTP::Daemon->new or die;
+
+die "Cannot fork" if (! defined (my $pid404 = fork()));
+END {
+ local $?;
+ kill KILL => $pid404; # Extreme prejudice intended, because we do not
+ # want the global cleanup to be done twice.
+}
+
+if (! $pid404) { # Fake HTTP server code: a true 404-compliant server!
+ while(my $c = $server404->accept()) {
+ while($c->get_request()) {
+ $c->send_response(new HTTP::Response(404));
+ $c->close();
+ }
+ }
+}
+
+$mech->get($server404->url);
+is( $mech->status, 404 , "404 check");
+
+is( scalar @{$mech->{page_stack}}, 1, "Even 404s get on the stack" );
+
+$mech->back();
+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" );
+
+ $mech->back();
+ is( $mech->uri, $server->url, "Back from $link" );
+}
+
+SKIP: {
+ eval "use Test::Memory::Cycle";
+ skip "Test::Memory::Cycle not installed", 1 if $@;
+
+ memory_cycle_ok( $mech, "No memory cycles found" );
+}
+
+
