Qual è il modo migliore per determinare se uno scalare contiene un filehandle?

Question

Sto provando a determinare se un dato scalar contiene un filehandle. Potrebbe essermi passato da un filehandle bareword (ovvero \*FH), un filehandle lessicale, un IO :: Handle, un IO :: File, ecc. Finora, l'unica cosa che sembra essere coerente tra i vari sapori è che hanno tutti un reftype di "GLOB".

Answer 1

Utilizzare la funzione openhandle da Scalar::Util:

openhandle FH

Restituisce FH se FH può essere usato come filehandle ed è aperto, oppure FH è un handle legato . Altrimenti, undef restituisce .

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

L'implementazione corrente è simile a Greg Bacon's answer, ma ha alcuni test aggiuntivi.

Answer 2

Ricordate che si può fare questo:

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

Questa è una stringa normale, ma ancora utile come filehandle.

Guardando il source of IO::Handle, la sua opened è un sottile wrapper fileno, che ha una proprietà a portata di mano:

Restituisce il descrittore di file per un filehandle, o non definito se il filehandle non è aperto.

Ma c'è un avvertimento:

Filehandle collegati ad oggetti di memoria con nuove caratteristiche di apertura può restituire indefinito anche se sono aperti.

Sembra quindi che un test lungo le linee di

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

farà quello che vuoi.

Il codice sotto controlli i rappresentanti delle

• in memoria oggetti
• nome filehandles
• gocce
• riferimenti glob
• nomi glob
• standard input
• FileHandle istanze
• IO::File casi
• tubi
• FIFO
• prese

gestire direttamente:

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

Tutto passa su un 9.10 casella di Ubuntu, quindi l'avvertenza in materia di oggetti in memoria non sembra essere una preoccupazione per quella piattaforma almeno.

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

Ecco un estratto dal File::Copy determinare se una variabile è un handle di file:

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 si occupa di aggiornare qualsiasi cosa a qualcosa di sano.

Answer 5

Ma qualsiasi scalare contiene qualcosa che potrebbe essere utilizzato come un filehandle. Le stringhe possono essere filehandle: sono maniglie dei pacchetti, quindi.

Per questo motivo abbiamo sempre utilizzato Symbol::qualify(). Non so se questo è ancora il "modo" che è comunemente sostenuto, ma funzionerà se si superano gli handle di bareword (che sono solo stringhe). Controlla il pacchetto caller, qualificandolo in modo appropriato. anche qui Symbol::qualify_to_ref(), che potrebbe essere più vicino a quello che stai cercando.

Ecco come funzionano entrambi. Nell'output seguito:

1. Il primo elemento i => elenco è ciò che viene effettuato tramite qualify
2. Il secondo elemento nell'elenco => è ciò che viene rilasciato da qualify_to_ref
3. Il terzo elemento della => elenco è presentare fileno rendimenti sul secondo punto

lo script che produce questo è riportato qui di seguito:

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 

Ed ecco lo script che generano quella uscita:

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

Cosa posso dire? A volte mi manca davvero il preprocessore C.

I just so questo mi farò parlare di. ☺

Answer 6

Io tendo ad usare:

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

O posso ('print') nel caso di maniglie ho intenzione di scrivere a. Questo è principalmente dovuto al fatto che in realtà voglio solo trattare i filehandle in modo OO, quindi questo risolve accuratamente se l'obiettivo può fare ciò che mi aspetto da esso.Se hai già controllato la definizione di $ fh, probabilmente puoi lasciare la valutazione.