Я пытаюсь определить, содержит ли данный скаляр дескриптор файла. Это, возможно, было передано мне от bareword дескриптора файла (т.е. \*FH
), лексический дескриптор файла, IO:: Дескриптор, IO:: Файл, и т.д. До сих пор, единственная вещь, которая, кажется, последовательна среди различных разновидностей, - то, что у них всех есть a reftype
из "GLOB"
.
Помните, что вы можете сделать это:
$ perl -le '$fh = "STDOUT"; print $fh "Hi there"' Hi there
Это обычная строка, но все же полезно как дескриптор файла.
Если посмотреть на источник IO :: Handle
, то его открытый
представляет собой тонкую оболочку вокруг fileno
, которая имеет удобное свойство:
Возвращает дескриптор файла для дескриптора файла или undefined, если дескриптор файла не открыт.
Но есть одно предостережение:
Дескрипторы файлов, подключенные к объектам памяти с помощью новых функций open, могут возвращать undefined, даже если они открыты.
Похоже, что тест, подобный
$@ = "";
my $fd = eval { fileno $maybefh };
my $valid = !$@ && defined $fd;
, сделает то, что вы хотите.
Приведенный ниже код проверяет представителей
FileHandle
экземпляров IO :: File
экземпляры Запускайте сами:
#! /usr/bin/perl
use warnings;
use strict;
use Fatal qw/ open /;
use FileHandle;
use IO::File;
use IO::Socket::INET;
my $SLEEP = 5;
my $FIFO = "/tmp/myfifo";
unlink $FIFO;
my $pid = fork;
die "$0: fork" unless defined $pid;
if ($pid == 0) {
system("mknod", $FIFO, "p") == 0 or die "$0: mknod failed";
open my $fh, ">", $FIFO;
sleep $SLEEP;
exit 0;
}
else {
sleep 1 while !-e $FIFO;
}
my @ignored = (\*FH1,\*FH2);
my @handles = (
[0, "1", 1],
[0, "hashref", {}],
[0, "arrayref", []],
[0, "globref", \*INC],
[1, "in-memory", do {{ my $buf; open my $fh, "<", \$buf; $fh }}],
[1, "FH1 glob", do {{ open FH1, "<", "/dev/null"; *FH1 }}],
[1, "FH2 globref", do {{ open FH2, "<", "/dev/null"; \*FH2 }}],
[1, "FH3 string", do {{ open FH3, "<", "/dev/null"; "FH3" }}],
[1, "STDIN glob", \*STDIN],
[1, "plain read", do {{ open my $fh, "<", "/dev/null"; $fh }}],
[1, "plain write", do {{ open my $fh, ">", "/dev/null"; $fh }}],
[1, "FH read", FileHandle->new("< /dev/null")],
[1, "FH write", FileHandle->new("> /dev/null")],
[1, "I::F read", IO::File->new("< /dev/null")],
[1, "I::F write", IO::File->new("> /dev/null")],
[1, "pipe read", do {{ open my $fh, "sleep $SLEEP |"; $fh }}],
[1, "pipe write", do {{ open my $fh, "| sleep $SLEEP"; $fh }}],
[1, "FIFO read", do {{ open my $fh, "<", $FIFO; $fh }}],
[1, "socket", IO::Socket::INET->new(PeerAddr => "localhost:80")],
);
sub valid {
local $@;
my $fd = eval { fileno $_[0] };
!$@ && defined $fd;
}
for (@handles) {
my($expect,$desc,$fh) = @$_;
print "$desc: ";
my $valid = valid $fh;
if (!$expect) {
print $valid ? "FAIL\n" : "PASS\n";
next;
}
if ($valid) {
close $fh;
$valid = valid $fh;
print $valid ? "FAIL\n" : "PASS\n";
}
else {
print "FAIL\n";
}
}
print "Waiting for sleeps to finish...\n";
Все проходит через систему Ubuntu 9.10, поэтому предостережение относительно объектов в памяти не действует похоже, по крайней мере, на этой платформе.
1: PASS hashref: PASS arrayref: PASS globref: PASS in-memory: PASS FH1 glob: PASS FH2 globref: PASS FH3 string: PASS STDIN glob: PASS plain read: PASS plain write: PASS FH read: PASS FH write: PASS I::F read: PASS I::F write: PASS pipe read: PASS pipe write: PASS FIFO read: PASS socket: PASS
Вот выдержка из File::Copy, определяющего, является ли переменная дескриптором файла:
my $from_a_handle = (ref($from)
? (ref($from) eq 'GLOB'
|| UNIVERSAL::isa($from, 'GLOB')
|| UNIVERSAL::isa($from, 'IO::Handle'))
: (ref(\$from) eq 'GLOB'));