What is the best way to determine if a scalar holds a filehandle?

Question

I am trying to determine if a given scalar holds a filehandle. It could have been passed to me from a bareword filehandle (i.e. \*FH), a lexical filehandle, an IO::Handle, an IO::File, etc. So far, the only thing that seems to be consistent amongst the various flavors is that they all have a reftype of "GLOB".

Answer 1

Use the openhandle function from Scalar::Util:

openhandle FH

Returns FH if FH may be used as a filehandle and is open, or FH is a tied handle. Otherwise undef is returned.

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

The current implementation is similar to Greg Bacon's answer, but it has some additional tests.

Answer 2

I tend to use:

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

Or can('print') in the case of handles I intend on writing to. This is mostly because I really only want to deal with filehandles in an OO-way anyway, so this accurately resolves whether the target can do what I expect of it. If you've already checked for the $fh being defined, you can probably leave off the eval.

Answer 3

But any scalar contains something that could be used as a filehandle. Strings can be filehandles: they are package handles, then.

We always used to use Symbol::qualify() for this. I don’t know whether that’s still “the” way that’s commonly advocated, but it will work if you are passed bareword handles (which are just strings). It checks the caller’s package, qualifying it appropriately. here’s also Symbol::qualify_to_ref(), which may perhaps be closer to what you’re looking for.

Here's how they both work. In the output below:

1. The first item in the => list is what gets made by qualify
2. The second item in the => list is what gets made by qualify_to_ref
3. The third item in the => list is file fileno returns on the second item

The script that produces this is included below:

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

And here’s the script that generate that output:

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

What can I say? Sometimes I really miss the C preprocessor.

I just know this one’s gonna get me talked about. ☺

Answer 4

io_from_any from IO::Handle::Util takes care of upgrading anything to something sane.

Answer 5

Remember that you can do this:

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

That's an ordinary string but still useful as a filehandle.

Looking at the source of IO::Handle, its opened is a thin wrapper around fileno, which has a handy property:

Returns the file descriptor for a filehandle, or undefined if the filehandle is not open.

But there is one caveat:

Filehandles connected to memory objects via new features of open may return undefined even though they are open.

It appears then that a test along the lines of

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

will do what you want.

The code below checks representatives of

• in-memory objects
• named filehandles
• globs
• glob references
• glob names
• the standard input
• FileHandle instances
• IO::File instances
• pipes
• FIFOs
• sockets

Run it yourself:

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

All passes on an Ubuntu 9.10 box, so the caveat concerning in-memory objects does not seem to be a concern on that platform at least.

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 6

Here's an excerpt from File::Copy determining whether or not a variable is a file handle:

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