¿Cuál es la mejor manera de determinar si un escalar contiene un identificador de archivo?

Question

Estoy tratando de determinar si un escalar dado contiene un identificador de archivo. Podría haberme pasado de una manejador de archivos (es decir, \*FH), manejador de archivos léxico, IO :: Handle, IO :: File, etc. Hasta ahora, lo único que parece ser consistente entre los diversos sabores es que todos tienen un reftype de "GLOB".

Answer 1

Utilice la función openhandle de Scalar::Util:

openhandle FH

Devuelve FH si FH se puede usar como identificador de archivo y está abierto, o FH es un identificador vinculado . De lo contrario, undef es devuelto.

$fh = openhandle(*STDIN);   # \*STDIN 
    $fh = openhandle(\*STDIN);   # \*STDIN 
    $fh = openhandle(*NOTOPEN);   # undef 
    $fh = openhandle("scalar");   # undef 

La implementación actual es similar a Greg Bacon's answer, pero tiene algunas pruebas adicionales.

Answer 2

Recuerde que usted puede hacer esto:

$ perl -le '$fh = "STDOUT"; print $fh "Hi there"' 
Hi there

Eso es una cadena normal, pero sigue siendo útil como un gestor de archivo.

Mirando el source of IO::Handle, su opened es una envoltura delgada alrededor fileno, que tiene una propiedad muy útil:

Devuelve el descriptor de archivo para un gestor de archivo, o indefinido si el gestor de archivo no está abierto.

Pero hay una advertencia:

Controladores de archivo conectados a los objetos de memoria a través de las nuevas características de abierto puede volver indefinido a pesar de que están abiertas.

Parece entonces que una prueba en la línea de

$@ = ""; 
my $fd = eval { fileno $maybefh }; 
my $valid = !$@ && defined $fd; 

va a hacer lo que quiere.

El código siguiente cheques representantes de

• en memoria objetos
• filehandles nombrados
• pegotes
• nombres glob
• la entrada estándar
• FileHandle instancias
• referencias glob
• IO::File casos
• tuberías
• FIFOs
• zócalos

Run usted mismo:

#! /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"; 

Todo pasa en una caja de Ubuntu 9.10, por lo que la salvedad respecto a objetos en memoria no parece ser una preocupación en esa plataforma al menos.

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

Answer 3

He aquí un extracto de File::Copy determinar si existe o no una variable es un identificador de archivo:

my $from_a_handle = (ref($from) 
    ? (ref($from) eq 'GLOB' 
     || UNIVERSAL::isa($from, 'GLOB') 
     || UNIVERSAL::isa($from, 'IO::Handle')) 
    : (ref(\$from) eq 'GLOB')); 

Answer 4

io_from_any from IO::Handle::Util se ocupa de actualizar algo a algo sensato.

Answer 5

Pero cualquiera escalar contiene algo que podría usarse como manejador de archivos. Las cadenas pueden ser manejadores de archivos: son manejadores de paquetes, entonces.

Siempre hemos usado Symbol::qualify() para esto. No sé si esa es todavía "la" manera en que se abogó comúnmente, pero funcionará si se le pasan identificadores de palabras simples (que son solo cadenas). Comprueba el paquete caller, calificándolo adecuadamente. aquí también está Symbol::qualify_to_ref(), que quizás esté más cerca de lo que está buscando.

Así es como funcionan ambos. En el resultado a continuación:

1. El primer elemento de la => Lista es lo que se hace por qualify
2. El segundo elemento de la lista => es lo que se hizo por qualify_to_ref
3. El tercer elemento de la => lista es presentar fileno retornos sobre el segundo punto

el guión que produce este se incluye a continuación:

off to NotMain 
string "stderr"  => main::stderr, GLOB(0x811720), fileno 2 
string *stderr  => *NotMain::stderr, GLOB(0x879ec0), fileno undef 
string *sneeze  => *NotMain::sneeze, GLOB(0x811e90), fileno undef 
string *STDERR  => *main::STDERR, GLOB(0x835260), fileno 2 
back to main 
string *stderr  => *main::stderr, GLOB(0x879ec0), fileno 2 
string "STDOUT"  => main::STDOUT, GLOB(0x8116c0), fileno 1 
string *STDOUT  => *main::STDOUT, GLOB(0x811e90), fileno 1 
string *STDOUT{IO} => IO::File=IO(0x8116d0), GLOB(0x811e90), fileno 1 
string \*STDOUT  => GLOB(0x8116c0), GLOB(0x8116c0), fileno 1 
string "sneezy"  => main::sneezy, GLOB(0x879ec0), fileno undef 
string "hard to type" => main::hard to type, GLOB(0x8039e0), fileno 3 
string $new_fh   => IO::Handle=GLOB(0x8046c0), IO::Handle=GLOB(0x8046c0), fileno undef 
string "GLOBAL"  => main::GLOBAL, GLOB(0x891ff0), fileno 3 
string *GLOBAL   => *main::GLOBAL, GLOB(0x835260), fileno 3 
string $GLOBAL   => main::/dev/null, GLOB(0x817320), fileno 3 
string $null   => GLOB(0x8907d0), GLOB(0x8907d0), fileno 4 

off to NotMain 
    glob "stderr"  => main::stderr, GLOB(0x811720), fileno 2 
    glob  stderr  => main::stderr, GLOB(0x811720), fileno 2 
    glob  sneeze  => main::sneeze, GLOB(0x81e490), fileno undef 
    glob *sneeze  => GLOB(0x892b90), GLOB(0x892b90), fileno undef 
    glob *stderr  => GLOB(0x892710), GLOB(0x892710), fileno undef 
    glob *STDERR  => GLOB(0x811700), GLOB(0x811700), fileno 2 
back to main 
    glob *stderr  => GLOB(0x811720), GLOB(0x811720), fileno 2 
    glob  STDOUT  => main::STDOUT, GLOB(0x8116c0), fileno 1 
    glob "STDOUT"  => main::STDOUT, GLOB(0x8116c0), fileno 1 
    glob *STDOUT  => GLOB(0x8116c0), GLOB(0x8116c0), fileno 1 
    glob *STDOUT{IO} => IO::File=IO(0x8116d0), GLOB(0x811d50), fileno 1 
    glob \*STDOUT  => GLOB(0x8116c0), GLOB(0x8116c0), fileno 1 
    glob sneezy   => main::sneezy, GLOB(0x879ec0), fileno undef 
    glob "sneezy"  => main::sneezy, GLOB(0x879ec0), fileno undef 
    glob "hard to type" => main::hard to type, GLOB(0x8039e0), fileno 3 
    glob $new_fh   => IO::Handle=GLOB(0x8046c0), IO::Handle=GLOB(0x8046c0), fileno undef 
    glob GLOBAL   => main::GLOBAL, GLOB(0x891ff0), fileno 3 
    glob $GLOBAL   => main::/dev/null, GLOB(0x817320), fileno 3 
    glob *GLOBAL   => GLOB(0x891ff0), GLOB(0x891ff0), fileno 3 
    glob $null   => GLOB(0x8907d0), GLOB(0x8907d0), fileno 4 

Y aquí está el script que genera que la producción:

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") } # nyah nyah nyah-NYAH nhah!! 
#undef exec 

#define CPP(FN, ARG) printf(" %6s %s => %s\n", main::short("FN"), q(ARG), FN(ARG)) 
#define QS(ARG)  CPP(main::qual_string, ARG) 
#define QG(ARG)  CPP(main::qual_glob, ARG) 
#define NL   say "" 

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, "/dev/null"); 

    for my $str ($GLOBAL, "hard to type") { 
     no strict "refs"; 
     *$str = *GLOBAL{IO}; 
    } 

    fake_qs(); 

    QS( *stderr  ); 
    QS( "STDOUT"  ); 
    QS( *STDOUT  ); 
    QS( *STDOUT{IO} ); 
    QS(\*STDOUT  ); 
    QS("sneezy"  ); 
    QS("hard to type"); 
    QS($new_fh  ); 
    QS("GLOBAL"  ); 
    QS(*GLOBAL  ); 
    QS($GLOBAL  ); 
    QS($null   ); 

    NL; 

    fake_qg(); 

    QG( *stderr  ); 
    QG( STDOUT  ); 
    QG( "STDOUT"  ); 
    QG( *STDOUT  ); 
    QG( *STDOUT{IO} ); 
    QG(\*STDOUT  ); 
    QG( sneezy  ); 
    QG("sneezy"  ); 
    QG("hard to type"); 
    QG($new_fh  ); 
    QG( GLOBAL  ); 
    QG($GLOBAL  ); 
    QG(*GLOBAL  ); 
    QG($null   ); 

    NL; 

} 

package main; 

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; 
} 


sub fake_qg { &NotMain::fake_qg } 
sub fake_qs { &NotMain::fake_qs } 

package NotMain; # this is just wicked 

sub fake_qg { 
    say "off to NotMain"; 
    QG( "stderr"  ); 
    QG( stderr  ); 
    QG( sneeze  ); 
    QG( *sneeze  ); 
    QG( *stderr  ); 
    QG( *STDERR  ); 
    say "back to main"; 
} 

sub fake_qs { 
    say "off to NotMain"; 
    package NotMain; 
    QS( "stderr"  ); 
    QS( *stderr  ); 
    QS( *sneeze  ); 
    QS( *STDERR  ); 
    say "back to main"; 
} 

¿Qué puedo decir? A veces echo de menos el preprocesador C.

Yo solo sé me va a hablar de esto. ☺

Answer 6

que tienden a utilizar:

eval { $fh->can('readline') } 

O puedo ('imprimir') en el caso de los mangos tengo la intención de escribir a. Esto se debe principalmente a que realmente solo quiero tratar con manejadores de archivos de una OO-Way de todos modos, así que esto resuelve con precisión si el objetivo puede hacer lo que espero de él.Si ya ha marcado los $ fh que se están definiendo, probablemente pueda dejar el eval.