| Subject: | [PATCH] file level errors are not properly propagated |
Johan,
File level errors, such as failure to open or rename a file, should lead to comprehensible error messages.
There is already code in place to propagate such messages to the user, but Iterator::Files crashes when executing this code due to an impossible attempt to extrapolate a message call into a quoted string.
Thus the user, instead of being told that a file "foobar" could not be opened, gets a message like:
Operation """": no method found, argument in overloaded package Iterator::Diamond at /opt/perl520/lib/site_perl/5.20.0/Iterator/Files.pm line 266.
Here is a simple patch to fix this, together with some tests for diagnostic messages in general. Feel free to use any of it as you like.
-Martin
| Subject: | Iterator-Diamond-0.04-MHASCH-01.patch |
diff -Nrup Iterator-Diamond-0.04.orig/lib/Iterator/Files.pm Iterator-Diamond-0.04/lib/Iterator/Files.pm
--- Iterator-Diamond-0.04.orig/lib/Iterator/Files.pm 2012-10-02 14:22:36.000000000 +0200
+++ Iterator-Diamond-0.04/lib/Iterator/Files.pm 2015-05-13 23:58:49.000000000 +0200
@@ -244,7 +244,7 @@ sub _advance {
if ( defined($self->{_edit}) && defined($self->{_rewrite_fh}) ) {
close($self->{_rewrite_fh})
- or croak("Error rewriting $self->current_file: $!");
+ or croak('Error rewriting '.$self->current_file.": $!");
undef $self->{_rewrite_fh};
select($self->{_reset_fh});
}
@@ -260,11 +260,11 @@ sub _advance {
if ( $self->{_magic} eq 'all'
|| $self->{_magic} eq 'stdin' && $self->current_file eq '-' ) {
open($self->{_current_fh}, $self->current_file)
- or croak("$self->current_file: $!");
+ or croak("Can't open ".$self->current_file.": $!");
}
else {
open($self->{_current_fh}, '<', $self->current_file)
- or croak("$self->current_file: $!");
+ or croak("Can't open ".$self->current_file.": $!");
}
if ( eof($self->{_current_fh}) ) {
diff -Nrup Iterator-Diamond-0.04.orig/t/32-diagnostics.t Iterator-Diamond-0.04/t/32-diagnostics.t
--- Iterator-Diamond-0.04.orig/t/32-diagnostics.t 1970-01-01 01:00:00.000000000 +0100
+++ Iterator-Diamond-0.04/t/32-diagnostics.t 2015-05-14 00:10:35.000000000 +0200
@@ -0,0 +1,53 @@
+#! perl
+
+use strict;
+use warnings;
+use Test::More tests => 12;
+use Iterator::Diamond;
+
+-d 't' && chdir 't';
+
+my $id = "32-diagnostics";
+
+unlink( "$id.tmp", "$id-empty.tmp", "$id-nil.tmp" );
+
+open(my $f, '>', "$id.tmp")
+ or die("$id.tmp: $!\n");
+print { $f } "Line 1\n";
+print { $f } "Line 2\n";
+print { $f } "Line 3\n";
+ok(close($f), "creating $id.tmp");
+
+undef $f;
+open($f, '>', "$id-empty.tmp")
+ or die("$id-empty.tmp: $!\n");
+ok(close($f), "creating $id-empty.tmp");
+
+@ARGV = ( "$id-nil.tmp" );
+my $it = Iterator::Diamond->new;
+my $first = eval { <$it> };
+is($first, undef, 'nonexistent file not opened');
+like($@, qr/^Can't open \Q$id-nil.tmp: /, 'error message');
+
+@ARGV = ( "$id-empty.tmp", "$id.tmp", "$id-empty.tmp", "$id-nil.tmp" );
+$it = Iterator::Diamond->new;
+foreach my $nr ( 1 .. 3 ) {
+ my $line = eval { <$it> };
+ is($line, "Line $nr\n", "file content ($nr/3)");
+}
+my $nothing = eval { <$it> };
+is($nothing, undef, 'nonexistent file not opened');
+like($@, qr/^\QCan't open $id-nil.tmp: /, 'error message');
+
+@ARGV = ( "$id-empty.tmp", "$id-empty.tmp" );
+$it = Iterator::Diamond->new;
+my $result = eval { [scalar <$it>] };
+is_deeply($result, [undef], 'empty files only');
+
+@ARGV = ( "$id.tmp" );
+$it = eval { Iterator::Diamond->new( _x_x_x_ => '_y_y_y_' ) };
+is($it, undef, 'unknown options rejected');
+like($@, qr/^Iterator::Diamond::new: Unhandled options: _x_x_x_/,
+ 'error message');
+
+unlink( "$id.tmp", "$id-empty.tmp", "$id-nil.tmp" );