Что состоит в том, чтобы определить лучший способ, содержит ли скаляр дескриптор файла?

Я пытаюсь определить, содержит ли данный скаляр дескриптор файла. Это, возможно, было передано мне от bareword дескриптора файла (т.е. \*FH), лексический дескриптор файла, IO:: Дескриптор, IO:: Файл, и т.д. До сих пор, единственная вещь, которая, кажется, последовательна среди различных разновидностей, - то, что у них всех есть a reftype из "GLOB".

29
задан Chas. Owens 15 November 2010 в 12:30
поделиться

2 ответа

Помните, что вы можете сделать это:

$ 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 экземпляры
  • каналы
  • FIFOs
  • сокеты

Запускайте сами:

#! /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
13
ответ дан 28 November 2019 в 01:42
поделиться

Вот выдержка из 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'));
2
ответ дан 28 November 2019 в 01:42
поделиться
Другие вопросы по тегам:

Похожие вопросы: