Moved onwards to WWW::Mechanize v0.42_001

Changes

@@ -1,6 +1,9 @@
 Revision history for Perl extension WWW::Mechanize::Shell.
 
 0.22
+  - The module now requires WWW::Mechanize v0.43, as the internal
+    API of WWW::Mechanize changed. Mixing W::M::S 0.21 or below with W::M v0.43+
+    will not work as will mixing W::M::S 0.22+ with W::M v0.41-
   - Added new command "reload", which repeats the last request
     (intended for testing/modifying server side code)
   - Altered fillout command - now _all_ fields that aren't predefined

Makefile.PL

@@ -6,7 +6,7 @@ WriteMakefile(
     'VERSION_FROM'  => 'lib/WWW/Mechanize/Shell.pm', # finds $VERSION
     'PREREQ_PM'    => {'Term::Shell' => 0.01,
     									 'URI::URL' => 0.00,
-                       'WWW::Mechanize' => 0.40,
+                       'WWW::Mechanize' => 0.43,
                        'WWW::Mechanize::FormFiller' => 0.04}, # e.g., Module::Name => 1.1
     ($] >= 5.005 ?    ## Add these new keywords supported since 5.005
       (ABSTRACT_FROM => 'lib/WWW/Mechanize/Shell.pm', # retrieve abstract from module

inc/Test/HTTP/log-server

@@ -16,7 +16,9 @@ if ($filename) {
 my $body = join "", <DATA>;
 
 sub debug($) {
-  warn "#SERVER: $_[0]\n"
+  my $message = $_[0];
+  $message =~ s!\n!\n#SERVER:!g;
+  warn "#SERVER: $message"
     if $ENV{TEST_HTTP_VERBOSE};
 };
 
@@ -49,6 +51,7 @@ SERVERLOOP: {
           $quitserver = 1;
         };
       };
+      debug $res->as_string;
       $c->send_response($res);
       last if $quitserver;
     }

lib/WWW/Mechanize/Shell.pm

@@ -852,8 +852,8 @@ is mostly intended to be used when testing server side code.
 sub run_reload {
   my ($self) = @_;
   eval {
-    $self->agent->_do_request;
-    $self->add_history('$agent->_do_request();');
+    $self->agent->request($self->agent->{req});
+    $self->add_history('$agent->request($agent->{req});');
     $self->sync_browser
       if ($self->option('autosync'));
   };
@@ -1017,20 +1017,20 @@ sub run_auth {
       if ($self->agent->res->www_authenticate =~ /\brealm=(['"]?)(.*)\1/) {
         $realm = $2
       } else {
-        $self->warn_user();
+        #$self->warn_user();
         $realm = "";
       };
-      $authority = $self->agent->req->uri->authority();
+      $authority = $self->agent->{req}->uri->authority();
 
       $self->add_history(          q{($agent->res->www_authenticate =~ /\brealm=(['"]?)(.*)\1/) or die "Couldn't find realm";},
-        						   q{my $realm = $2;},
-                                   q{my $authority = $agent->req->uri->authority();},
-                          sprintf( q{$agent->credentials($authority,$realm,'%s','%s');}, $user,$password ));
+        						               q{my $realm = $2;},
+                                   q{my $authority = $agent->{req}->uri->authority();},
+                          sprintf( q{$agent->credentials($authority,$realm,'%s' => '%s');}, $user,$password ));
     } else {
       ($authority, $realm, $user, $password) = @_;
       $self->add_history( sprintf q{$self->agent->credentials('%s','%s','%s','%s')}, $authority,$realm,$user,$password);
     };
-    $self->agent->credentials($authority,$realm,$user,$password);
+    $self->agent->credentials($authority,$realm,$user => $password);
 };
 
 =head2 table

t/07-history-items.t

@@ -97,7 +97,7 @@ $mock_agent->set_always( res => $mock_result )
            ->set_always( links => [['foo','foo link','foo_link'],['foo2','foo2 link','foo2_link']])
            ->set_always( agent => 'mocked/1.0')
            ->set_always( uri => $mock_uri )
-           ->set_always( _do_request => 1 );
+           ->set_always( request => $mock_result );
 
 use_ok('WWW::Mechanize::Shell');
 my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef, watchfiles => undef );

t/13-command-au.t

@@ -35,21 +35,13 @@ tie *STDOUT, 'Catch', '_STDOUT_' or die $!;
 # Disable all ReadLine functionality
 $ENV{PERL_RL} = 0;
 
-use Test::More tests => 7;
+use Test::More tests => 8;
 SKIP: {
-#skip "Can't load Term::ReadKey without a terminal", 7
-#  unless -t STDIN;
-#eval { require Term::ReadKey; Term::ReadKey::GetTerminalSize(); };
-#if ($@) {
-#  no warnings 'redefine';
-#  *Term::ReadKey::GetTerminalSize = sub {80,24};
-#  diag "Term::ReadKey seems to want a terminal";
-#};
 
 use_ok('WWW::Mechanize::Shell');
 
 eval { require HTTP::Daemon; };
-skip "HTTP::Daemon required to test basic authentication",6
+skip "HTTP::Daemon required to test basic authentication",7
   if ($@);
 
 # We want to be safe from non-resolving local host names
@@ -60,6 +52,8 @@ open SERVER, qq'"$^X" $FindBin::Bin/401-server |'
   or die "Couldn't spawn fake server : $!";
 sleep 1; # give the child some time
 my $url = <SERVER>;
+die unless $url =~ m!^http://([^/]+)/!;
+my $host = $1;
 
 my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef );
 
@@ -76,6 +70,8 @@ is($s->agent->res->code, 401, "Request without credentials gives 401");
 is($s->agent->content, "auth required", "Content requests authentication");
 
 $s->cmd( "auth foo bar" );
+is_deeply( $s->agent->{'basic_authentication'}{$host}{"testing realm"}, ["foo","bar"],"UA stored the authentification");
+
 $s->cmd( "get $url" );
 diag $s->agent->res->message
   unless is($s->agent->res->code, 200, "Request with credentials gives 200");

t/14-command-identity.t

@@ -89,7 +89,7 @@ BEGIN {
     									location => '%sformsubmit' },
     get => { requests => 1, lines => [ 'get %s' ], location => '%s' },
     get_content => { requests => 1, lines => [ 'get %s', 'content' ], location => '%s' },
-    get_redirect => { requests => 1, lines => [ 'get %sredirect/startpage' ], location => '%sstartpage' },
+    get_redirect => { requests => 2, lines => [ 'get %sredirect/startpage' ], location => '%sstartpage' },
     get_save => { requests => 4, lines => [ 'get %s','save "/\.save_log_server_test\.tmp$/"' ], location => '%s' },
     get_value_click => { requests => 2, lines => [ 'get %s','value query foo', 'click submit' ], location => '%sformsubmit' },
     get_value_submit => { requests => 2, lines => [ 'get %s','value query foo', 'submit' ], location => '%sformsubmit' },
@@ -129,7 +129,7 @@ BEGIN {
 
   # To ease zeroing in on tests
   #for (sort keys %tests) {
-  #  delete $tests{$_} unless /^e/;
+  #  delete $tests{$_} unless /^get_red/;
   #};
 };
 
@@ -152,10 +152,10 @@ delete $ENV{HTTP_PROXY};
 my $actual_requests;
 {
   no warnings 'redefine';
-  my $old_do_request = *WWW::Mechanize::_do_request{CODE};
-  *WWW::Mechanize::_do_request = sub {
+  my $old_request = *WWW::Mechanize::request{CODE};
+  *WWW::Mechanize::request = sub {
     $actual_requests++;
-    goto &$old_do_request;
+    goto &$old_request;
   };
 
   *WWW::Mechanize::Shell::status = sub {};

t/16-form-fillout.t

@@ -41,13 +41,13 @@ BEGIN {
   %tests = (
     interactive_script_creation => { requests => 2,
     									lines => [ 'eval @::list=qw(1 2 3 4 5 6 7 8 9 10 foo NY 11 DE 13 V 15 16 2038-01-01)',
-    														 'eval 
+    														 'eval
     														    no warnings "once";
     														    *WWW::Mechanize::FormFiller::Value::Ask::ask_value = sub {
-    														      #warn "Filled out ",$_[1]->name; 
-    														      my $value=shift @::list || "empty"; 
-    														      push @{$_[0]->{shell}->{answers}}, [ $_[1]->name, $value ]; 
-    														      $value 
+    														      #warn "Filled out ",$_[1]->name;
+    														      my $value=shift @::list || "empty";
+    														      push @{$_[0]->{shell}->{answers}}, [ $_[1]->name, $value ];
+    														      $value
     														    }',
     														 'get %s',
     														 'fillout',
@@ -78,10 +78,10 @@ delete $ENV{HTTP_PROXY};
 my $actual_requests;
 {
   no warnings 'redefine';
-  my $old_do_request = *WWW::Mechanize::_do_request{CODE};
-  *WWW::Mechanize::_do_request = sub {
+  my $old_request = *WWW::Mechanize::request{CODE};
+  *WWW::Mechanize::request = sub {
     $actual_requests++;
-    goto &$old_do_request;
+    goto &$old_request;
   };
 
   *WWW::Mechanize::Shell::status = sub {};

t/401-server

@@ -1,24 +1,34 @@
 # Thanks to merlyn for nudging me and giving me this snippet!
-
+use strict;
 use HTTP::Daemon;
 
 $|++;
 
 my $d = HTTP::Daemon->new or die;
 print $d->url, "\n";
 
-$counter = 4;
+my $counter = 4;
 while ($counter-- and my $c = $d->accept) {
-  while (my $r = $c->get_request) {
-    if (my ($user, $pass) = $r->authorization_basic) {
-      $c->send_response(HTTP::Response->new(200, "OK", undef,
-					    "user = '$user' pass = '$pass'"));
+  while (my $req = $c->get_request) {
+    if ($ENV{TEST_HTTP_VERBOSE}) {
+      my @lines = split "\n",$req->as_string;
+      warn "# $_\n" for @lines;
+    };
+    my $res;
+    if (my ($user, $pass) = $req->authorization_basic) {
+      $res = HTTP::Response->new(200, "OK", undef,
+					    "user = '$user' pass = '$pass'");
     } else {
-      my $res = HTTP::Response->new(401, "Auth Required", undef,
+      $res = HTTP::Response->new(401, "Auth Required", undef,
 				    "auth required");
       $res->www_authenticate("Basic realm=\"testing realm\"");
-      $c->send_response($res);
     }
+    if ($ENV{TEST_HTTP_VERBOSE}) {
+      warn "---\n";
+      my @lines = split "\n",$res->as_string;
+      warn "# $_\n" for @lines;
+    };
+    $c->send_response($res);
   }
   $c->close;
   undef($c);