And here is the patch.
-Martin
diff -Nrup Iterator-Diamond-0.03.orig/Changes Iterator-Diamond-0.03/Changes
--- Iterator-Diamond-0.03.orig/Changes 2008-08-07 22:36:01.000000000 +0200
+++ Iterator-Diamond-0.03/Changes 2012-09-06 19:25:21.000000000 +0200
@@ -1,5 +1,13 @@
Revision history for Iterator-Diamond
+0.03_01 2012-09-06
+ Suggestions by Martin Becker (rt-79486):
+ - read from STDIN if @ARGV is empty
+ - explicitly enable $^I feature
+ - read from pipes (inadequate size check hampered this)
+ - document that suffix must be non-empty
+ - fix failed test rt-56053
+
0.03 2008-08-07
Fixes.
diff -Nrup Iterator-Diamond-0.03.orig/MANIFEST Iterator-Diamond-0.03/MANIFEST
--- Iterator-Diamond-0.03.orig/MANIFEST 2008-08-04 22:32:20.000000000 +0200
+++ Iterator-Diamond-0.03/MANIFEST 2012-09-06 17:54:41.000000000 +0200
@@ -8,7 +8,10 @@ t/00-load.t
t/01-ref.t
t/02-ref.t
t/10-stdin.t
+t/11-pipe.t
+t/12-noargs.t
t/20-user.t
t/30-edit.t
+t/31-i_option.t
Makefile.PL
META.yml
diff -Nrup Iterator-Diamond-0.03.orig/lib/Iterator/Diamond.pm Iterator-Diamond-0.03/lib/Iterator/Diamond.pm
--- Iterator-Diamond-0.03.orig/lib/Iterator/Diamond.pm 2008-08-04 22:32:20.000000000 +0200
+++ Iterator-Diamond-0.03/lib/Iterator/Diamond.pm 2012-09-06 18:53:30.000000000 +0200
@@ -13,7 +13,8 @@ Iterator::Diamond - Iterate through the
=cut
-our $VERSION = '0.02';
+our $VERSION = '0.03_01';
+$VERSION =~ tr/_//d;
=head1 SYNOPSIS
@@ -136,21 +137,37 @@ unsafe again, just like the built-in C<<
Enables in-place editing of files, just as the built-in C<< <> >> operator.
-Using the perl command line option C<-I>I<suffix> has the same effect.
+Unlike the built-in operator semantics, an empty suffix to discard backup
+files is not supported.
+
+=item B<< use_i_option >> I<boolean>
+
+If set to true, and if B<edit> is not specified, the perl command line
+option C<-i>I<suffix> will be used to enable or disable in-place editing.
+By default, perl command line options are ignored.
=item B<< files => >> I<aref>
Use this list of files instead of @ARGV.
+If C<files> are not specified and C<stdin> or C<all> magic is in effect,
+an empty @ARGV will be treated as a list containing a single dash C<< - >>.
+
=back
=cut
sub new {
my ($pkg, %args) = @_;
+ my $use_i_option = delete $args{use_i_option};
+ if ($use_i_option && !exists($args{edit}) && defined $^I) {
+ $args{edit} = $^I;
+ }
my $self = $pkg->SUPER::new( files => \@ARGV, %args );
+ if ( !exists($args{files}) && !@ARGV && $self->_magic_stdin ) {
+ @ARGV = qw(-);
+ }
$self->{_current_file} = \$ARGV;
- $self->{_edit} = $^I unless defined $self->{_edit};
return $self;
}
diff -Nrup Iterator-Diamond-0.03.orig/lib/Iterator/Files.pm Iterator-Diamond-0.03/lib/Iterator/Files.pm
--- Iterator-Diamond-0.03.orig/lib/Iterator/Files.pm 2008-08-07 22:36:32.000000000 +0200
+++ Iterator-Diamond-0.03/lib/Iterator/Files.pm 2012-09-06 18:53:51.000000000 +0200
@@ -12,7 +12,8 @@ Iterator::Files - Iterate through the co
=cut
-our $VERSION = '0.03';
+our $VERSION = '0.03_01';
+$VERSION =~ tr/_//d;
=head1 SYNOPSIS
@@ -135,7 +136,8 @@ unsafe again, just like the built-in C<<
Enables in-place editing of files, just as the built-in C<< <> >> operator.
-Using the perl command line option C<-I>I<suffix> has the same effect.
+Unlike the built-in operator semantics, an empty suffix to discard backup
+files is not supported.
=item B<< files => >> I<aref>
@@ -161,7 +163,7 @@ sub new {
if ( exists $args{edit} ) {
$self->{_edit} = delete $args{edit};
croak($pkg."::new: Value for 'edit' option (backup suffix) may not be empty")
- if $self->{_edit} eq '';
+ if defined($self->{_edit}) && $self->{_edit} eq '';
}
if ( exists $args{files} ) {
$self->{_files} = delete $args{files};
@@ -229,12 +231,18 @@ sub readline {
# called only once and with scalar context.
use overload '<>' => \&readline;
+sub _magic_stdin {
+ my $self = shift;
+ my $magic = $self->{_magic};
+ return 'stdin' eq $magic || 'all' eq $magic;
+}
+
sub _advance {
my $self = shift;
$self->{_init} = 1;
- if ( $self->{_edit} && defined($self->{_rewrite_fh}) ) {
+ if ( defined($self->{_edit}) && defined($self->{_rewrite_fh}) ) {
close($self->{_rewrite_fh})
or croak("Error rewriting $self->current_file: $!");
undef $self->{_rewrite_fh};
@@ -259,7 +267,14 @@ sub _advance {
or croak("$self->current_file: $!");
}
- if ( $self->{_edit} ) {
+ if ( eof($self->{_current_fh}) ) {
+ close $self->{_current_fh};
+ undef $self->{_current_fh};
+ undef ${ $self->{_current_file} };
+ CORE::next;
+ }
+
+ if ( defined $self->{_edit} ) {
my $fname = $self->current_file;
my $backup = $fname;
if ( $self->{_edit} !~ /\*/ ) {
@@ -276,7 +291,7 @@ sub _advance {
$self->{_reset_fh} = select($self->{_rewrite_fh});
}
- return -t $self->{_current_fh} || -s $self->{_current_fh};
+ return 1;
}
}
diff -Nrup Iterator-Diamond-0.03.orig/t/01-ref.t Iterator-Diamond-0.03/t/01-ref.t
--- Iterator-Diamond-0.03.orig/t/01-ref.t 2008-08-04 22:32:20.000000000 +0200
+++ Iterator-Diamond-0.03/t/01-ref.t 2012-09-06 14:58:39.000000000 +0200
@@ -2,7 +2,7 @@
use strict;
use warnings;
-use Test::More tests => 21;
+use Test::More tests => 20;
-d 't' && chdir 't';
@@ -20,8 +20,10 @@ close($f);
ok(!defined $ARGV, "\$ARGV not set yet");
ok(@ARGV != 0, "\@ARGV pristine");
-# Initially, eof is false, $ARGV and @ARGV untouched.
-ok(eof, "eof at start");
+# There used to be a test of eof here, but the state of eof
+# before anything has been read by user code can vary.
+
+# Initially, $ARGV and @ARGV are untouched.
ok(!defined $ARGV, "\$ARGV not set yet");
ok(@ARGV != 0, "\@ARGV pristine");
diff -Nrup Iterator-Diamond-0.03.orig/t/11-pipe.t Iterator-Diamond-0.03/t/11-pipe.t
--- Iterator-Diamond-0.03.orig/t/11-pipe.t 1970-01-01 01:00:00.000000000 +0100
+++ Iterator-Diamond-0.03/t/11-pipe.t 2012-09-06 15:54:46.000000000 +0200
@@ -0,0 +1,42 @@
+#! perl
+
+use strict;
+use warnings;
+use Test::More;
+use File::Spec;
+use Iterator::Diamond;
+
+my @payload = (
+ "This comes from the pipe\n",
+ "Another line from the pipe\n",
+);
+
+my $pipe = undef;
+my $pid = eval { open $pipe, '-|' };
+if (!defined $pid) {
+ plan skip_all => 'fork/pipe not supported here';
+}
+elsif ($pid) {
+ plan tests => 1 + @payload;
+}
+else {
+ open STDIN, '<', File::Spec->devnull;
+ print @payload;
+ exit;
+}
+
+@ARGV = ('-');
+open STDIN, '<&', $pipe or die "cannot redirect STDIN: $!\n";
+
+my $it = Iterator::Diamond->new( magic => "stdin" );
+
+my @lines = ();
+while ( <$it> ) {
+ push(@lines, $_);
+}
+
+is(0+@lines, 0+@payload, 'number of lines');
+for my $i ( 0..$#payload ) {
+ my $j = $i + 1;
+ is($lines[$i], $payload[$i], "line $j");
+}
diff -Nrup Iterator-Diamond-0.03.orig/t/12-noargs.t Iterator-Diamond-0.03/t/12-noargs.t
--- Iterator-Diamond-0.03.orig/t/12-noargs.t 1970-01-01 01:00:00.000000000 +0100
+++ Iterator-Diamond-0.03/t/12-noargs.t 2012-09-06 15:54:55.000000000 +0200
@@ -0,0 +1,42 @@
+#! perl
+
+use strict;
+use warnings;
+use Test::More;
+use File::Spec;
+use Iterator::Diamond;
+
+my @payload = (
+ "This comes from the pipe\n",
+ "Another line from the pipe\n",
+);
+
+my $pipe = undef;
+my $pid = eval { open $pipe, '-|' };
+if (!defined $pid) {
+ plan skip_all => 'fork/pipe not supported here';
+}
+elsif ($pid) {
+ plan tests => 1 + @payload;
+}
+else {
+ open STDIN, '<', File::Spec->devnull;
+ print @payload;
+ exit;
+}
+
+@ARGV = ();
+open STDIN, '<&', $pipe or die "cannot redirect STDIN: $!\n";
+
+my $it = Iterator::Diamond->new( magic => "stdin" );
+
+my @lines = ();
+while ( <$it> ) {
+ push(@lines, $_);
+}
+
+is(0+@lines, 0+@payload, 'number of lines');
+for my $i ( 0..$#payload ) {
+ my $j = $i + 1;
+ is($lines[$i], $payload[$i], "line $j");
+}
diff -Nrup Iterator-Diamond-0.03.orig/t/31-i_option.t Iterator-Diamond-0.03/t/31-i_option.t
--- Iterator-Diamond-0.03.orig/t/31-i_option.t 1970-01-01 01:00:00.000000000 +0100
+++ Iterator-Diamond-0.03/t/31-i_option.t 2012-09-06 17:52:51.000000000 +0200
@@ -0,0 +1,60 @@
+#! perl
+
+use strict;
+use warnings;
+use Test::More tests => 9;
+use File::Spec;
+use Iterator::Diamond;
+
+-d 't' && chdir 't';
+
+my $id = "31-i_option";
+
+unlink( "$id.tmp", "$id.tmp~" );
+
+open(my $f, '>', "$id.tmp")
+ or die("$id.tmp: $!\n");
+print { $f } "Hello, World1!\n";
+print { $f } "Hello, World2!\n";
+print { $f } "Hello, World3!\n";
+ok(close($f), "creating $id.tmp");
+
+@ARGV = ( "$id.tmp" );
+$^I = '~';
+my $it = Iterator::Diamond->new( use_i_option => 1 );
+my @lines = ();
+while ( <$it> ) {
+ s/ll/xx/g;
+ print;
+}
+
+@ARGV = ( "$id.tmp" );
+$it = Iterator::Diamond->new;
+@lines = ();
+while ( <$it> ) {
+ push(@lines, $_);
+}
+
+for my $j ( 1 .. 3 ) {
+ is(shift(@lines), "Hexxo, World$j!\n", "line$j");
+}
+
+@ARGV = ( "$id.tmp~" );
+$it = Iterator::Diamond->new;
+@lines = ();
+while ( <$it> ) {
+ push(@lines, $_);
+}
+
+for my $j ( 1 .. 3 ) {
+ is(shift(@lines), "Hello, World$j!\n", "line$j");
+}
+
+@ARGV = ( "$id.tmp" );
+$^I = '';
+my $msg = q{Value for 'edit' option (backup suffix) may not be empty};
+my $r = eval { Iterator::Diamond->new( use_i_option => 1 ) };
+is($r, undef, 'empty suffix rejected');
+like($@, qr/ \Q$msg\E /, 'diagnostics');
+
+unlink( "$id.tmp", "$id.tmp~" );
