| Subject: | Correctly check PerlIO for open filehandle |
Currently Scalar::Util's openhandle checks by checking for the
definedness. This is not correct: fileno's documentation mentions
«Filehandles connected to memory objects via new features of "open" may
return undefined even though they are open.» This happens to work
correctly on current versions of perl because of a bug that causes
fileno to return -1 instead of undef on some occasions, but that will
hopefully be fixed before the release of 5.14. This however will break
the openhandle, so I've attached a patch that will check if a handle is
open in the correct PerlIO way.
Regards,
Leon
| Subject: | openhandle.patch |
diff --git a/lib/Scalar/Util.pm b/lib/Scalar/Util.pm
index 24138ca..5086150 100644
--- a/lib/Scalar/Util.pm
+++ b/lib/Scalar/Util.pm
@@ -8,6 +8,7 @@ package Scalar::Util;
use strict;
use vars qw(@ISA @EXPORT_OK $VERSION @EXPORT_FAIL);
+use Config;
require Exporter;
require List::Util; # List::Util loads the XS
@@ -45,22 +46,33 @@ sub export_fail {
@_;
}
+sub _is_openhandle;
+
+*_is_openhandle = ($] >= 5.008 and $Config{useperlio})
+ ? sub {
+ my $fh = shift;
+ my $flags = (PerlIO::get_layers(*$fh, details => 1))[2];
+ return defined $flags and $flags & 0x00200000;
+ }
+ : sub {
+ my $fh = shift;
+ return defined fileno $fh;
+ };
+
sub openhandle ($) {
my $fh = shift;
my $rt = reftype($fh) || '';
- return defined(fileno($fh)) ? $fh : undef
- if $rt eq 'IO';
+ return _is_openhandle($fh) ? $fh : undef if $rt eq 'IO';
if (reftype(\$fh) eq 'GLOB') { # handle openhandle(*DATA)
- $fh = \(my $tmp=$fh);
+ $fh = \(my $tmp=$fh);
}
elsif ($rt ne 'GLOB') {
- return undef;
+ return undef;
}
- (tied(*$fh) or defined(fileno($fh)))
- ? $fh : undef;
+ return (tied(*$fh) or _is_openhandle($fh)) ? $fh : undef;
}
1;
diff --git a/t/openhan.t b/t/openhan.t
index bf4e6c1..8fab7d5 100644
--- a/t/openhan.t
+++ b/t/openhan.t
@@ -35,16 +35,15 @@ ok(defined &openhandle, 'defined');
SKIP: {
skip "3-arg open only on 5.6 or later", 1 if $]<5.006;
- open my $fh, "<", $0;
- skip "could not open $0 for reading: $!", 1 unless $fh;
+ # Can't open $0 like that after a chdir
+ open my $fh, "<", $0 or skip "could not open $0 for reading: $!", 1;
is(openhandle($fh), $fh, "works with indirect filehandles");
}
SKIP: {
skip "in-memory files only on 5.8 or later", 1 if $]<5.008;
- open my $fh, "<", \"in-memory file";
- skip "could not open in-memory file: $!", 1 unless $fh;
+ open my $fh, "<", \"in-memory file" or skip "could not open in-memory file: $!", 1;
is(openhandle($fh), $fh, "works with in-memory files");
}
@@ -61,11 +60,11 @@ ok(openhandle(*DATA{IO}), "works for *DATA{IO}");
ok(!openhandle(IO::Handle->new), "unopened IO::Handle");
}
-{
+SKIP: {
require IO::File;
my $fh = IO::File->new;
$fh->open("< $0")
- or skip "could not open $0: $!", 1;
+ or skip "could not open $0: $!", 2;
ok(openhandle($fh), "works for IO::File objects");
ok(!openhandle(IO::File->new), "unopened IO::File" );