Обнаружение открытости ручек
Как указывает Аксеман, $handle->opened() сообщает вам, открыта ли она.
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);
производит
NULL is opened.
NULL is not openhandled.
NULL is fd 3.
Как вы видите, вы не можете использовать Scalar::Util::openhandle(), потому что это слишком глупо и глючит.
Стресс-тест с открытой ручкой
Правильный подход, , если вы не использовали IO::Handle->opened, продемонстрировано в следующем простом небольшом трехъязычном скрипте:
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;
}
, который при запуске выдает:
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
То, что - это способ проверки дескрипторов открытого файла!
Но это даже не ваш вопрос, я полагаю.
Тем не менее, я чувствовал, что необходимо решить, так как здесь слишком много неверных решений этой проблемы.Люди должны открыть глаза на то, как эти вещи на самом деле работают.Обратите внимание, что две функции из Symbol используют пакет caller, если это необходимо - что, безусловно, часто бывает.
Определение режима чтения / записи для открытого дескриптора
Это является ответом на ваш вопрос:
#!/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;
Который при запуске выдает такой вывод:
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
Счастлив теперь, Шверн?10