mech-dump errors when a request failed #292

Note the output capturing seems to not work properly on Windows for
Perls 5.14 and possibly 5.16. While I found a source claiming the weird
error message 'Can't spawn "cmd.exe": No such file or directory'
captured from STDOUT after calling system() has to do with $? being -1
and only occurs in 5.14 (and maybe later, but had subsequently been
fixed) I have not found anything in any perldeltas following 5.14. I
have decided to simply exclude this test on these Perl versions until we
know more.

Author: simbabque

Changes

@@ -4,6 +4,8 @@ Revision history for WWW::Mechanize
     [ENHANCEMENTS]
     - Add autocheck() to enable or disable autochecking at run time in
       addition to setting it at object creation (GH#232) (Julien Fiegehenn)
+    - mech_dump now errors appropriately when it cannot open a URL or file
+      instead of claiming it has the wrong MIME type (GH#292) (Julien Fiegehenn)
 
 2.13      2022-07-29 09:44:46Z
     [ENHANCEMENTS]

script/mech-dump

@@ -113,13 +113,19 @@ foreach my $uri (@uris) {
   }
 
   my $response = $mech->get( $uri );
-  if (!$response->is_success and defined ($response->www_authenticate)) {
-      if (!defined $user or !defined $pass) {
-          die("Page requires username and password, but none specified.\n");
+  if ( !$response->is_success ) {
+    if ( defined( $response->www_authenticate ) ) {
+      if ( !defined $user or !defined $pass ) {
+        die("Page requires username and password, but none specified.\n");
       }
-      $mech->credentials($user,$pass);
-      $response = $mech->get( $uri );
-      $response->is_success or die "Can't fetch $uri with username and password\n", $response->status_line, "\n";
+      $mech->credentials( $user, $pass );
+      $response = $mech->get($uri);
+      $response->is_success
+          or die "Can't fetch $uri with username and password\n",
+          $response->status_line, "\n";
+    } else {
+        die "$uri returns status ", $response->code, "\n";
+    }
   }
 
   unless ($no_ct_check) {

t/mech-dump/mech-dump.t

@@ -4,33 +4,37 @@ use warnings;
 use strict;
 
 use Test::More;
-use File::Spec ();
-use LWP ();
+use Test::Output qw( output_like );
+use File::Spec   ();
+use LWP          ();
 
 BEGIN {
-    delete @ENV{ qw( IFS CDPATH ENV BASH_ENV PATH ) };
+  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 ) );
-plan tests => 4;
+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 ) );
+my $exe = File::Spec->catfile(qw( script mech-dump ));
 if ( $^O eq 'VMS' ) {
-    $exe = qq[mcr $^X -Ilib $exe];
+  $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 $source = 'file:t/google.html t/find_inputs.html t/html_file.txt';
 
-my $perl;
-$perl = $1 if $^X =~ /^(.+)$/;
-my $command = "$perl -Ilib $exe --forms --images --links $source";
+  my $command = "$perl -Ilib $exe --forms --images --links $source";
 
-my $actual = `$command`;
+  my $actual = `$command`;
 
-my $expected;
-if ( $LWP::VERSION < 5.800 ) {
+  my $expected;
+  if ( $LWP::VERSION < 5.800 ) {
     $expected = <<'EOF';
 GET file:/target-page [bob-the-form]
   hl=en                           (hidden)
@@ -78,7 +82,8 @@ POST http://localhost/ [3rd_form]
 GET http://localhost [text-form]
   one=                           (text)
 EOF
-} else {
+  }
+  else {
     $expected = <<'EOF';
 GET file:/target-page [bob-the-form]
   hl=en                          (hidden readonly)
@@ -126,18 +131,43 @@ POST http://localhost/ [3rd_form]
 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' );
-
+  }
+
+  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' );
+};
+
+subtest 'Local file not found' => sub {
+  SKIP: {
+    # See https://stackoverflow.com/a/32054866/1331451
+    skip 'capturing output from system() is broken in 5.14 and 5.16 on Windows', 1
+      if $^O eq 'MSWin32' && ( $] >= 5.014 && $] < 5.017 );
+
+  # 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;