Detecting Openness of Handles
As Axeman points out, $handle->opened()
tells you whether it is open.
use strict;
use autodie;
use warnings qw< FATAL all >;
use IO::Handle;
use Scalar::Util qw< openhandle >;
our $NULL = "/dev/null";
open NULL;
printf "NULL is %sopened.\n", NULL->opened() ? "" : "not ";
printf "NULL is %sopenhandled.\n", openhandle("NULL") ? "" : "not ";
printf "NULL is fd %d.\n", fileno(NULL);
produces
NULL is opened.
NULL is not openhandled.
NULL is fd 3.
As you see, you cannot use Scalar::Util::openhandle()
, because it is just too stupid and buggy.
Open Handle Stress Test
The correct approach, if you were not using IO::Handle->opened
, is demonstrated in the following simple little trilingual script:
eval 'exec perl $0 ${1+"$@"}'
if 0;
use 5.010_000;
use strict;
use autodie;
use warnings qw[ FATAL all ];
use Symbol;
use IO::Handle;
#define exec(arg)
BEGIN { exec("cpp $0 | $^X") } #!/usr/bin/perl -P
#undef exec
#define SAY(FN, ARG) printf("%6s %s => %s\n", short("FN"), q(ARG), FN(ARG))
#define STRING(ARG) SAY(qual_string, ARG)
#define GLOB(ARG) SAY(qual_glob, ARG)
#define NL say ""
#define TOUGH "hard!to!type"
sub comma(@);
sub short($);
sub qual($);
sub qual_glob(*);
sub qual_string($);
$| = 1;
main();
exit();
sub main {
our $GLOBAL = "/dev/null";
open GLOBAL;
my $new_fh = new IO::Handle;
open(my $null, $GLOBAL);
for my $str ($GLOBAL, TOUGH) {
no strict "refs";
*$str = *GLOBAL{IO};
}
STRING( *stderr );
STRING( "STDOUT" );
STRING( *STDOUT );
STRING( *STDOUT{IO} );
STRING( \*STDOUT );
STRING( "sneezy" );
STRING( TOUGH );
STRING( $new_fh );
STRING( "GLOBAL" );
STRING( *GLOBAL );
STRING( $GLOBAL );
STRING( $null );
NL;
GLOB( *stderr );
GLOB( STDOUT );
GLOB( "STDOUT" );
GLOB( *STDOUT );
GLOB( *STDOUT{IO} );
GLOB( \*STDOUT );
GLOB( sneezy );
GLOB( "sneezy" );
GLOB( TOUGH );
GLOB( $new_fh );
GLOB( GLOBAL );
GLOB( $GLOBAL );
GLOB( *GLOBAL );
GLOB( $null );
NL;
}
sub comma(@) { join(", " => @_) }
sub qual_string($) {
my $string = shift();
return qual($string);
}
sub qual_glob(*) {
my $handle = shift();
return qual($handle);
}
sub qual($) {
my $thingie = shift();
my $qname = qualify($thingie);
my $qref = qualify_to_ref($thingie);
my $fnum = do { no autodie; fileno($qref) };
$fnum = "undef" unless defined $fnum;
return comma($qname, $qref, "fileno $fnum");
}
sub short($) {
my $name = shift();
$name =~ s/.*_//;
return $name;
}
Which when run produces:
string *stderr => *main::stderr, GLOB(0x8368f7b0), fileno 2
string "STDOUT" => main::STDOUT, GLOB(0x8868ffd0), fileno 1
string *STDOUT => *main::STDOUT, GLOB(0x84ef4750), fileno 1
string *STDOUT{IO} => IO::Handle=IO(0x8868ffe0), GLOB(0x84ef4750), fileno 1
string \*STDOUT => GLOB(0x8868ffd0), GLOB(0x8868ffd0), fileno 1
string "sneezy" => main::sneezy, GLOB(0x84169f10), fileno undef
string "hard!to!type" => main::hard!to!type, GLOB(0x8868f1d0), fileno 3
string $new_fh => IO::Handle=GLOB(0x8868f0b0), IO::Handle=GLOB(0x8868f0b0), fileno undef
string "GLOBAL" => main::GLOBAL, GLOB(0x899a4840), fileno 3
string *GLOBAL => *main::GLOBAL, GLOB(0x84ef4630), fileno 3
string $GLOBAL => main::/dev/null, GLOB(0x7f20ec00), fileno 3
string $null => GLOB(0x86f69bb0), GLOB(0x86f69bb0), fileno 4
glob *stderr => GLOB(0x84ef4050), GLOB(0x84ef4050), fileno 2
glob STDOUT => main::STDOUT, GLOB(0x8868ffd0), fileno 1
glob "STDOUT" => main::STDOUT, GLOB(0x8868ffd0), fileno 1
glob *STDOUT => GLOB(0x8868ffd0), GLOB(0x8868ffd0), fileno 1
glob *STDOUT{IO} => IO::Handle=IO(0x8868ffe0), GLOB(0x84ef4630), fileno 1
glob \*STDOUT => GLOB(0x8868ffd0), GLOB(0x8868ffd0), fileno 1
glob sneezy => main::sneezy, GLOB(0x84169f10), fileno undef
glob "sneezy" => main::sneezy, GLOB(0x84169f10), fileno undef
glob "hard!to!type" => main::hard!to!type, GLOB(0x8868f1d0), fileno 3
glob $new_fh => IO::Handle=GLOB(0x8868f0b0), IO::Handle=GLOB(0x8868f0b0), fileno undef
glob GLOBAL => main::GLOBAL, GLOB(0x899a4840), fileno 3
glob $GLOBAL => main::/dev/null, GLOB(0x7f20ec00), fileno 3
glob *GLOBAL => GLOB(0x899a4840), GLOB(0x899a4840), fileno 3
glob $null => GLOB(0x86f69bb0), GLOB(0x86f69bb0), fileno 4
That is how you test for open file handles!
But that wasn’t even your question, I believe.
Still, I felt it needed addressing, as there are too many incorrect solutions to that problem floating around here. People need to open their eyes to how these things actually work. Note that the two functions from Symbol
use the caller
’s package if necessary—which it certainly often is.
Determining Read/Write Mode of Open Handle
This is the answer to your question:
#!/usr/bin/env perl
use 5.10.0;
use strict;
use autodie;
use warnings qw< FATAL all >;
use Fcntl;
my (%flags, @fh);
my $DEVICE = "/dev/null";
my @F_MODES = map { $_ => "+$_" } qw[ < > >> ];
my @O_MODES = map { $_ | O_WRONLY }
O_SYNC ,
O_NONBLOCK ,
O_SYNC | O_APPEND ,
O_NONBLOCK | O_APPEND ,
O_SYNC | O_NONBLOCK | O_APPEND ,
;
open($fh[++$#fh], $_, $DEVICE) for @F_MODES;
sysopen($fh[++$#fh], $DEVICE, $_) for @O_MODES;
eval { $flags{$_} = main->$_ } for grep /^O_/, keys %::;
for my $fh (@fh) {
printf("fd %2d: " => fileno($fh));
my ($flags => @flags) = 0+fcntl($fh, F_GETFL, my $junk);
while (my($_, $flag) = each %flags) {
next if $flag == O_ACCMODE;
push @flags => /O_(.*)/ if $flags & $flag;
}
push @flags => "RDONLY" unless $flags & O_ACCMODE;
printf("%s\n", join(", " => map{lc}@flags));
}
close $_ for reverse STDOUT => @fh;
Which, when run, produces this output:
fd 3: rdonly
fd 4: rdwr
fd 5: wronly
fd 6: rdwr
fd 7: wronly, append
fd 8: rdwr, append
fd 9: wronly, sync
fd 10: ndelay, wronly, nonblock
fd 11: wronly, sync, append
fd 12: ndelay, wronly, nonblock, append
fd 13: ndelay, wronly, nonblock, sync, append
Happy now, Schwern? ☺