[p5sagit/p5-mst-13.2.git] / ext / Errno / Errno_pm.PL

use ExtUtils::MakeMaker;
use Config;
use strict;

our $VERSION = "1.09_00";

my %err = ();

unlink "Errno.pm" if -f "Errno.pm";
open OUT, ">Errno.pm" or die "Cannot open Errno.pm: $!";
select OUT;
my $file;
foreach $file (get_files()) {
    process_file($file);
}
write_errno_pm();
unlink "errno.c" if -f "errno.c";

sub process_file {
    my($file) = @_;

    return unless defined $file and -f $file;

    local *FH;
    if (($^O eq 'VMS') && ($Config{vms_cc_type} ne 'gnuc')) {
	unless(open(FH," LIBRARY/EXTRACT=ERRNO/OUTPUT=SYS\$OUTPUT $file |")) {
            warn "Cannot open '$file'";
            return;
	}     
    } elsif ($Config{gccversion} ne ''
             # OpenSTEP has gcc 2.7.2.1 which recognizes but
	     # doesn't implement the -dM flag.
	     && $^O ne 'openstep' && $^O ne 'next' && $^O ne 'darwin'
	     ) { 
	# With the -dM option, gcc outputs every #define it finds
	unless(open(FH,"$Config{cc} -E -dM $Config{cppflags} $file |")) {
            warn "Cannot open '$file'";
            return;
	}     
    } else {
	unless(open(FH,"< $file")) {
	    # This file could be a temporary file created by cppstdin
	    # so only warn under -w, and return
            warn "Cannot open '$file'" if $^W;
            return;
	}
    }

    if ($^O eq 'MacOS') {
	while(<FH>) {
	    $err{$1} = $2
		if /^\s*#\s*define\s+(E\w+)\s+(\d+)/;
	}
    } else {
	while(<FH>) {
	    $err{$1} = 1
		if /^\s*#\s*define\s+(E\w+)\s+/;
	}
    }
    close(FH);
}

my $cppstdin;

sub default_cpp {
    unless (defined $cppstdin) {
	use File::Spec;
	$cppstdin = $Config{cppstdin};
	my $upup_cppstdin = File::Spec->catfile(File::Spec->updir,
						File::Spec->updir,
						"cppstdin");
	my $cppstdin_is_wrapper =
	    ($cppstdin eq 'cppstdin'
		and -f $upup_cppstdin
		    and -x $upup_cppstdin);
	$cppstdin = $upup_cppstdin if $cppstdin_is_wrapper;
    }
    return "$cppstdin $Config{cppflags} $Config{cppminus}";
}

sub get_files {
    my %file = ();
    # VMS keeps its include files in system libraries (well, except for Gcc)
    if ($^O eq 'VMS') {
	if ($Config{vms_cc_type} eq 'decc') {
	    $file{'Sys$Library:DECC$RTLDEF.TLB'} = 1;
	} elsif ($Config{vms_cc_type} eq 'vaxc') {
	    $file{'Sys$Library:vaxcdef.tlb'} = 1;
	} elsif ($Config{vms_cc_type} eq 'gcc') {
	    $file{'gnu_cc_include:[000000]errno.h'} = 1;
	}
    } elsif ($^O eq 'os390') {
	# OS/390 C compiler doesn't generate #file or #line directives
	$file{'/usr/include/errno.h'} = 1;
    } elsif ($^O eq 'vmesa') {
	# OS/390 C compiler doesn't generate #file or #line directives
	$file{'../../vmesa/errno.h'} = 1;
    } elsif ($Config{archname} eq 'epoc') {
	# Watch out for cross compiling for EPOC (usually done on linux)
	$file{'/usr/local/epoc/include/libc/sys/errno.h'} = 1;
    } elsif ($^O eq 'linux' &&
	     $Config{gccversion} ne '' # might be using, say, Intel's icc
	     ) {
	# Some Linuxes have weird errno.hs which generate
	# no #file or #line directives
	$file{'/usr/include/errno.h'} = 1;
    } elsif ($^O eq 'MacOS') {
	# note that we are only getting the GUSI errno's here ...
	# we might miss out on compiler-specific ones
	$file{"$ENV{GUSI}include:sys:errno.h"} = 1;

    } else {
	open(CPPI,"> errno.c") or
	    die "Cannot open errno.c";

	if ($^O eq 'NetWare') {
		print CPPI "#include <nwerrno.h>\n";
	} else {
		print CPPI "#include <errno.h>\n";
	}

	close(CPPI);

	# invoke CPP and read the output
	if ($^O eq 'MSWin32' || $^O eq 'NetWare') {
	    open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
		die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
	} else {
	    my $cpp = default_cpp();
	    open(CPPO,"$cpp < errno.c |") or
		die "Cannot exec $cpp";
	}

	my $pat;
	if (($^O eq 'MSWin32' || $^O eq 'NetWare') and $Config{cc} =~ /^bcc/i) {
	    $pat = '^/\*\s+(.+)\s+\d+\s*:\s+\*/';
	}
	else {
	    $pat = '^#\s*(?:line)?\s*\d+\s+"([^"]+)"';
	}
	while(<CPPO>) {
	    if ($^O eq 'os2' or $^O eq 'MSWin32' or $^O eq 'NetWare') {
		if (/$pat/o) {
		   my $f = $1;
		   $f =~ s,\\\\,/,g;
		   $file{$f} = 1;
		}
	    }
	    else {
		$file{$1} = 1 if /$pat/o;
	    }
	}
	close(CPPO);
    }
    return keys %file;
}

sub write_errno_pm {
    my $err;

    # quick sanity check

    die "No error definitions found" unless keys %err;

    # create the CPP input

    open(CPPI,"> errno.c") or
	die "Cannot open errno.c";

    if ($^O eq 'NetWare') {
		print CPPI "#include <nwerrno.h>\n";
	} else {
		print CPPI "#include <errno.h>\n";
	}

    foreach $err (keys %err) {
	print CPPI '"',$err,'" [[',$err,']]',"\n";
    }

    close(CPPI);

    unless ($^O eq 'MacOS') {	# trust what we have
    # invoke CPP and read the output

	if ($^O eq 'VMS') {
	    my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}";
	    $cpp =~ s/sys\$input//i;
	    open(CPPO,"$cpp  errno.c |") or
		die "Cannot exec $Config{cppstdin}";
	} elsif ($^O eq 'MSWin32' || $^O eq 'NetWare') {
	    open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
		die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
	} else {
	    my $cpp = default_cpp();
	    open(CPPO,"$cpp < errno.c |")
		or die "Cannot exec $cpp";
	}

	%err = ();

	while(<CPPO>) {
	    my($name,$expr);
	    next unless ($name, $expr) = /"(.*?)"\s*\[\s*\[\s*(.*?)\s*\]\s*\]/;
	    next if $name eq $expr;
	    $err{$name} = eval $expr;
	}
	close(CPPO);
    }

    # Write Errno.pm

    print <<"EDQ";
#
# This file is auto-generated. ***ANY*** changes here will be lost
#

package Errno;
our (\@EXPORT_OK,\%EXPORT_TAGS,\@ISA,\$VERSION,\%errno,\$AUTOLOAD);
use Exporter ();
use Config;
use strict;

"\$Config{'archname'}-\$Config{'osvers'}" eq
"$Config{'archname'}-$Config{'osvers'}" or
	die "Errno architecture ($Config{'archname'}-$Config{'osvers'}) does not match executable architecture (\$Config{'archname'}-\$Config{'osvers'})";

\$VERSION = "$VERSION";
\@ISA = qw(Exporter);

EDQ
   
    my $len = 0;
    my @err = sort { $err{$a} <=> $err{$b} } keys %err;
    map { $len = length if length > $len } @err;

    my $j = "\@EXPORT_OK = qw(" . join(" ",keys %err) . ");\n";
    $j =~ s/(.{50,70})\s/$1\n\t/g;
    print $j,"\n";

print <<'ESQ';
%EXPORT_TAGS = (
    POSIX => [qw(
ESQ

    my $k = join(" ", grep { exists $err{$_} } 
	qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT
	EAGAIN EALREADY EBADF EBUSY ECHILD ECONNABORTED
	ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT
	EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS
	EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK
	EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH
	ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM
	ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
	ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM
	EPFNOSUPPORT EPIPE EPROCLIM EPROTONOSUPPORT EPROTOTYPE
	ERANGE EREMOTE ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT
	ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS ETXTBSY
	EUSERS EWOULDBLOCK EXDEV));

    $k =~ s/(.{50,70})\s/$1\n\t/g;
    print "\t",$k,"\n    )]\n);\n\n";

    foreach $err (@err) {
	printf "sub %s () { %d }\n",,$err,$err{$err};
    }

    print <<'ESQ';

sub TIEHASH { bless [] }

sub FETCH {
    my ($self, $errname) = @_;
    my $proto = prototype("Errno::$errname");
    my $errno = "";
    if (defined($proto) && $proto eq "") {
	no strict 'refs';
	$errno = &$errname;
        $errno = 0 unless $! == $errno;
    }
    return $errno;
}

sub STORE {
    require Carp;
    Carp::confess("ERRNO hash is read only!");
}

*CLEAR = \&STORE;
*DELETE = \&STORE;

sub NEXTKEY {
    my($k,$v);
    while(($k,$v) = each %Errno::) {
	my $proto = prototype("Errno::$k");
	last if (defined($proto) && $proto eq "");
    }
    $k
}

sub FIRSTKEY {
    my $s = scalar keys %Errno::;	# initialize iterator
    goto &NEXTKEY;
}

sub EXISTS {
    my ($self, $errname) = @_;
    my $proto = prototype($errname);
    defined($proto) && $proto eq "";
}

tie %!, __PACKAGE__;

1;
__END__

=head1 NAME

Errno - System errno constants

=head1 SYNOPSIS

    use Errno qw(EINTR EIO :POSIX);

=head1 DESCRIPTION

C<Errno> defines and conditionally exports all the error constants
defined in your system C<errno.h> include file. It has a single export
tag, C<:POSIX>, which will export all POSIX defined error numbers.

C<Errno> also makes C<%!> magic such that each element of C<%!> has a
non-zero value only if C<$!> is set to that value. For example:

    use Errno;

    unless (open(FH, "/fangorn/spouse")) {
        if ($!{ENOENT}) {
            warn "Get a wife!\n";
        } else {
            warn "This path is barred: $!";
        } 
    } 

If a specified constant C<EFOO> does not exist on the system, C<$!{EFOO}>
returns C<"">.  You may use C<exists $!{EFOO}> to check whether the
constant is available on the system.

=head1 CAVEATS

Importing a particular constant may not be very portable, because the
import will fail on platforms that do not have that constant.  A more
portable way to set C<$!> to a valid value is to use:

    if (exists &Errno::EFOO) {
        $! = &Errno::EFOO;
    }

=head1 AUTHOR

Graham Barr <gbarr@pobox.com>

=head1 COPYRIGHT

Copyright (c) 1997-8 Graham Barr. All rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

ESQ

}
Commit	Line	Data
eab60bb1	1	use ExtUtils::MakeMaker;
	2	use Config;
	3	use strict;
	4
76fbd8c4	5	our $VERSION = "1.09_00";
eab60bb1	6
	7	my %err = ();
	8
	9	unlink "Errno.pm" if -f "Errno.pm";
	10	open OUT, ">Errno.pm" or die "Cannot open Errno.pm: $!";
	11	select OUT;
	12	my $file;
	13	foreach $file (get_files()) {
	14	process_file($file);
	15	}
	16	write_errno_pm();
	17	unlink "errno.c" if -f "errno.c";
	18
	19	sub process_file {
	20	my($file) = @_;
	21
6683669a	22	return unless defined $file and -f $file;
eab60bb1	23
	24	local *FH;
	25	if (($^O eq 'VMS') && ($Config{vms_cc_type} ne 'gnuc')) {
	26	unless(open(FH," LIBRARY/EXTRACT=ERRNO/OUTPUT=SYS\$OUTPUT $file \|")) {
	27	warn "Cannot open '$file'";
	28	return;
	29	}
7237d657	30	} elsif ($Config{gccversion} ne ''
8ff7320b	31	# OpenSTEP has gcc 2.7.2.1 which recognizes but
8ff7320b	32	# doesn't implement the -dM flag.
8f4f83ba	33	&& $^O ne 'openstep' && $^O ne 'next' && $^O ne 'darwin'
8ff7320b	34	) {
9ae2e8df	35	# With the -dM option, gcc outputs every #define it finds
ee1e7ac2	36	unless(open(FH,"$Config{cc} -E -dM $Config{cppflags} $file \|")) {
9ae2e8df	37	warn "Cannot open '$file'";
	38	return;
	39	}
eab60bb1	40	} else {
eab60bb1	41	unless(open(FH,"< $file")) {
def887e8	42	# This file could be a temporary file created by cppstdin
6ad8d9a8	43	# so only warn under -w, and return
6ad8d9a8	44	warn "Cannot open '$file'" if $^W;
eab60bb1	45	return;
	46	}
	47	}
db5fd395	48
	49	if ($^O eq 'MacOS') {
	50	while(<FH>) {
	51	$err{$1} = $2
	52	if /^\s#\sdefine\s+(E\w+)\s+(\d+)/;
	53	}
	54	} else {
	55	while(<FH>) {
	56	$err{$1} = 1
	57	if /^\s#\sdefine\s+(E\w+)\s+/;
	58	}
	59	}
	60	close(FH);
eab60bb1	61	}
eab60bb1	62
def887e8	63	my $cppstdin;
	64
	65	sub default_cpp {
	66	unless (defined $cppstdin) {
	67	use File::Spec;
	68	$cppstdin = $Config{cppstdin};
	69	my $upup_cppstdin = File::Spec->catfile(File::Spec->updir,
	70	File::Spec->updir,
	71	"cppstdin");
	72	my $cppstdin_is_wrapper =
	73	($cppstdin eq 'cppstdin'
	74	and -f $upup_cppstdin
	75	and -x $upup_cppstdin);
	76	$cppstdin = $upup_cppstdin if $cppstdin_is_wrapper;
	77	}
	78	return "$cppstdin $Config{cppflags} $Config{cppminus}";
	79	}
	80
eab60bb1	81	sub get_files {
	82	my %file = ();
	83	# VMS keeps its include files in system libraries (well, except for Gcc)
	84	if ($^O eq 'VMS') {
	85	if ($Config{vms_cc_type} eq 'decc') {
	86	$file{'Sys$Library:DECC$RTLDEF.TLB'} = 1;
	87	} elsif ($Config{vms_cc_type} eq 'vaxc') {
	88	$file{'Sys$Library:vaxcdef.tlb'} = 1;
	89	} elsif ($Config{vms_cc_type} eq 'gcc') {
	90	$file{'gnu_cc_include:[000000]errno.h'} = 1;
	91	}
9d116dd7	92	} elsif ($^O eq 'os390') {
	93	# OS/390 C compiler doesn't generate #file or #line directives
	94	$file{'/usr/include/errno.h'} = 1;
092bebab	95	} elsif ($^O eq 'vmesa') {
	96	# OS/390 C compiler doesn't generate #file or #line directives
	97	$file{'../../vmesa/errno.h'} = 1;
a367e475	98	} elsif ($Config{archname} eq 'epoc') {
	99	# Watch out for cross compiling for EPOC (usually done on linux)
	100	$file{'/usr/local/epoc/include/libc/sys/errno.h'} = 1;
022394cf	101	} elsif ($^O eq 'linux' &&
	102	$Config{gccversion} ne '' # might be using, say, Intel's icc
	103	) {
9ae2e8df	104	# Some Linuxes have weird errno.hs which generate
	105	# no #file or #line directives
	106	$file{'/usr/include/errno.h'} = 1;
db5fd395	107	} elsif ($^O eq 'MacOS') {
	108	# note that we are only getting the GUSI errno's here ...
	109	# we might miss out on compiler-specific ones
	110	$file{"$ENV{GUSI}include:sys:errno.h"} = 1;
	111
eab60bb1	112	} else {
	113	open(CPPI,"> errno.c") or
	114	die "Cannot open errno.c";
	115
2986a63f	116	if ($^O eq 'NetWare') {
	117	print CPPI "#include <nwerrno.h>\n";
	118	} else {
	119	print CPPI "#include <errno.h>\n";
	120	}
eab60bb1	121
	122	close(CPPI);
	123
	124	# invoke CPP and read the output
2986a63f	125	if ($^O eq 'MSWin32' \|\| $^O eq 'NetWare') {
6ad8d9a8	126	open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c \|") or
	127	die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
	128	} else {
def887e8	129	my $cpp = default_cpp();
6ad8d9a8	130	open(CPPO,"$cpp < errno.c \|") or
	131	die "Cannot exec $cpp";
	132	}
eab60bb1	133
eab60bb1	134	my $pat;
2986a63f	135	if (($^O eq 'MSWin32' \|\| $^O eq 'NetWare') and $Config{cc} =~ /^bcc/i) {
eab60bb1	136	$pat = '^/\\s+(.+)\s+\d+\s:\s+\*/';
	137	}
	138	else {
d0d1d9b9	139	$pat = '^#\s(?:line)?\s\d+\s+"([^"]+)"';
eab60bb1	140	}
eab60bb1	141	while(<CPPO>) {
2986a63f	142	if ($^O eq 'os2' or $^O eq 'MSWin32' or $^O eq 'NetWare') {
0196e43b	143	if (/$pat/o) {
	144	my $f = $1;
	145	$f =~ s,\\\\,/,g;
	146	$file{$f} = 1;
	147	}
	148	}
	149	else {
	150	$file{$1} = 1 if /$pat/o;
	151	}
eab60bb1	152	}
	153	close(CPPO);
	154	}
	155	return keys %file;
	156	}
	157
	158	sub write_errno_pm {
	159	my $err;
	160
def887e8	161	# quick sanity check
	162
	163	die "No error definitions found" unless keys %err;
	164
eab60bb1	165	# create the CPP input
	166
	167	open(CPPI,"> errno.c") or
	168	die "Cannot open errno.c";
	169
2986a63f	170	if ($^O eq 'NetWare') {
	171	print CPPI "#include <nwerrno.h>\n";
	172	} else {
	173	print CPPI "#include <errno.h>\n";
	174	}
eab60bb1	175
	176	foreach $err (keys %err) {
	177	print CPPI '"',$err,'" [[',$err,']]',"\n";
	178	}
	179
	180	close(CPPI);
	181
db5fd395	182	unless ($^O eq 'MacOS') { # trust what we have
eab60bb1	183	# invoke CPP and read the output
dcbf900d	184
db5fd395	185	if ($^O eq 'VMS') {
	186	my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}";
	187	$cpp =~ s/sys\$input//i;
	188	open(CPPO,"$cpp errno.c \|") or
	189	die "Cannot exec $Config{cppstdin}";
2986a63f	190	} elsif ($^O eq 'MSWin32' \|\| $^O eq 'NetWare') {
db5fd395	191	open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c \|") or
	192	die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
	193	} else {
	194	my $cpp = default_cpp();
	195	open(CPPO,"$cpp < errno.c \|")
	196	or die "Cannot exec $cpp";
	197	}
eab60bb1	198
db5fd395	199	%err = ();
eab60bb1	200
db5fd395	201	while(<CPPO>) {
	202	my($name,$expr);
	203	next unless ($name, $expr) = /"(.?)"\s\[\s\[\s(.?)\s\]\s*\]/;
	204	next if $name eq $expr;
	205	$err{$name} = eval $expr;
	206	}
	207	close(CPPO);
eab60bb1	208	}
eab60bb1	209
	210	# Write Errno.pm
	211
	212	print <<"EDQ";
	213	#
	214	# This file is auto-generated. *ANY* changes here will be lost
	215	#
	216
	217	package Errno;
f168a5e7	218	our (\@EXPORT_OK,\%EXPORT_TAGS,\@ISA,\$VERSION,\%errno,\$AUTOLOAD);
eab60bb1	219	use Exporter ();
	220	use Config;
	221	use strict;
	222
8bc9d590	223	"\$Config{'archname'}-\$Config{'osvers'}" eq
8bc9d590	224	"$Config{'archname'}-$Config{'osvers'}" or
81be85b8	225	die "Errno architecture ($Config{'archname'}-$Config{'osvers'}) does not match executable architecture (\$Config{'archname'}-\$Config{'osvers'})";
eab60bb1	226
	227	\$VERSION = "$VERSION";
	228	\@ISA = qw(Exporter);
	229
	230	EDQ
	231
	232	my $len = 0;
	233	my @err = sort { $err{$a} <=> $err{$b} } keys %err;
	234	map { $len = length if length > $len } @err;
	235
	236	my $j = "\@EXPORT_OK = qw(" . join(" ",keys %err) . ");\n";
	237	$j =~ s/(.{50,70})\s/$1\n\t/g;
	238	print $j,"\n";
	239
	240	print <<'ESQ';
	241	%EXPORT_TAGS = (
	242	POSIX => [qw(
	243	ESQ
	244
	245	my $k = join(" ", grep { exists $err{$_} }
	246	qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT
	247	EAGAIN EALREADY EBADF EBUSY ECHILD ECONNABORTED
	248	ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT
	249	EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS
	250	EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK
	251	EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH
	252	ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM
	253	ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
	254	ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM
	255	EPFNOSUPPORT EPIPE EPROCLIM EPROTONOSUPPORT EPROTOTYPE
	256	ERANGE EREMOTE ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT
	257	ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS ETXTBSY
	258	EUSERS EWOULDBLOCK EXDEV));
	259
	260	$k =~ s/(.{50,70})\s/$1\n\t/g;
	261	print "\t",$k,"\n )]\n);\n\n";
	262
	263	foreach $err (@err) {
	264	printf "sub %s () { %d }\n",,$err,$err{$err};
	265	}
	266
	267	print <<'ESQ';
	268
	269	sub TIEHASH { bless [] }
	270
	271	sub FETCH {
	272	my ($self, $errname) = @_;
	273	my $proto = prototype("Errno::$errname");
68301627	274	my $errno = "";
eab60bb1	275	if (defined($proto) && $proto eq "") {
eab60bb1	276	no strict 'refs';
68301627	277	$errno = &$errname;
68301627	278	$errno = 0 unless $! == $errno;
eab60bb1	279	}
68301627	280	return $errno;
93014de6	281	}
eab60bb1	282
	283	sub STORE {
	284	require Carp;
	285	Carp::confess("ERRNO hash is read only!");
	286	}
	287
	288	*CLEAR = \&STORE;
	289	*DELETE = \&STORE;
	290
	291	sub NEXTKEY {
	292	my($k,$v);
	293	while(($k,$v) = each %Errno::) {
	294	my $proto = prototype("Errno::$k");
	295	last if (defined($proto) && $proto eq "");
eab60bb1	296	}
	297	$k
	298	}
	299
	300	sub FIRSTKEY {
68301627	301	my $s = scalar keys %Errno::; # initialize iterator
eab60bb1	302	goto &NEXTKEY;
	303	}
	304
	305	sub EXISTS {
	306	my ($self, $errname) = @_;
	307	my $proto = prototype($errname);
	308	defined($proto) && $proto eq "";
	309	}
	310
	311	tie %!, __PACKAGE__;
	312
	313	1;
	314	__END__
	315
	316	=head1 NAME
	317
	318	Errno - System errno constants
	319
	320	=head1 SYNOPSIS
	321
	322	use Errno qw(EINTR EIO :POSIX);
	323
	324	=head1 DESCRIPTION
	325
	326	C<Errno> defines and conditionally exports all the error constants
	327	defined in your system C<errno.h> include file. It has a single export
	328	tag, C<:POSIX>, which will export all POSIX defined error numbers.
	329
93014de6	330	C<Errno> also makes C<%!> magic such that each element of C<%!> has a
68301627	331	non-zero value only if C<$!> is set to that value. For example:
eab60bb1	332
eab60bb1	333	use Errno;
3cb6de81	334
eab60bb1	335	unless (open(FH, "/fangorn/spouse")) {
	336	if ($!{ENOENT}) {
	337	warn "Get a wife!\n";
	338	} else {
	339	warn "This path is barred: $!";
	340	}
	341	}
	342
68301627	343	If a specified constant C<EFOO> does not exist on the system, C<$!{EFOO}>
68301627	344	returns C<"">. You may use C<exists $!{EFOO}> to check whether the
93014de6	345	constant is available on the system.
93014de6	346
68301627	347	=head1 CAVEATS
	348
	349	Importing a particular constant may not be very portable, because the
	350	import will fail on platforms that do not have that constant. A more
	351	portable way to set C<$!> to a valid value is to use:
	352
	353	if (exists &Errno::EFOO) {
	354	$! = &Errno::EFOO;
	355	}
	356
eab60bb1	357	=head1 AUTHOR
	358
	359	Graham Barr <gbarr@pobox.com>
	360
	361	=head1 COPYRIGHT
	362
	363	Copyright (c) 1997-8 Graham Barr. All rights reserved.
	364	This program is free software; you can redistribute it and/or modify it
	365	under the same terms as Perl itself.
	366
	367	=cut
	368
	369	ESQ
	370
	371	}