File Coverage

blib/lib/IO/Dir/Dirfd.pm

Criterion	Covered	Total	%
statement	23	23	100.0
branch	4	4	100.0
condition	3	5	60.0
subroutine	5	5	100.0
pod	0	1	0.0
total	35	38	92.1

# ----------------------------------------------------------------------------
# "THE BEER-WARE LICENSE" (Revision 42)
#  wrote this file.  As long as you retain this notice you
# can do whatever you want with this stuff. If we meet some day, and you think
# this stuff is worth it, you can buy me a beer in return.   Anton Berezin
# ----------------------------------------------------------------------------
#
# $Id: Dirfd.pm,v 1.1.1.1 2001/11/21 17:30:15 tobez Exp $
#
package IO::Dir::Dirfd;

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

require Exporter;
require DynaLoader;

@ISA = qw(Exporter DynaLoader);
@EXPORT = qw(dirfd);
@EXPORT_OK = qw(fileno);
$VERSION = '0.01';

sub dirfd(*);

bootstrap IO::Dir::Dirfd $VERSION;

sub fileno(*)
{
	no strict "refs";
	my $no;
	eval { $no = CORE::fileno($_[0]) };
	return $no if defined $no;
	my $arg = $_[0];
	$! = 0;
	unless (ref($arg) || $arg =~ /(^\*)|(::)/) {
		my $caller = caller || 'main';
		$arg = "${caller}::$arg";
	}
	$no = dirfd($arg);
	use strict "refs";
	$no;
}

1;
__END__