[perl5.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;

    } elsif ($^O eq 'beos') {
	# hidden in a special place
	$file{'/boot/develop/headers/posix/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;
	    $expr =~ s/(\d+)[LU]+\b/$1/g; # 2147483647L et alia
	    $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 GS	1	use ExtUtils::MakeMaker;
	2	use Config;
	3	use strict;
	4
76fbd8c4	5	our $VERSION = "1.09_00";
eab60bb1 GS	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 GS	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 JH	31	# OpenSTEP has gcc 2.7.2.1 which recognizes but
8ff7320b JH	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 PR	37	warn "Cannot open '$file'";
	38	return;
	39	}
eab60bb1 GS	40	} else {
eab60bb1 GS	41	unless(open(FH,"< $file")) {
def887e8	42	# This file could be a temporary file created by cppstdin
6ad8d9a8 GB	43	# so only warn under -w, and return
6ad8d9a8 GB	44	warn "Cannot open '$file'" if $^W;
eab60bb1 GS	45	return;
	46	}
	47	}
db5fd395 CN	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 GS	61	}
eab60bb1 GS	62
def887e8 JH	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 GS	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 JH	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 JH	95	} elsif ($^O eq 'vmesa') {
	96	# OS/390 C compiler doesn't generate #file or #line directives
	97	$file{'../../vmesa/errno.h'} = 1;
a367e475 OF	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 CR	101	} elsif ($^O eq 'linux' &&
	102	$Config{gccversion} ne '' # might be using, say, Intel's icc
	103	) {
9ae2e8df PR	104	# Some Linuxes have weird errno.hs which generate
	105	# no #file or #line directives
	106	$file{'/usr/include/errno.h'} = 1;
db5fd395 CN	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
0d3cd356 JH	112	} elsif ($^O eq 'beos') {
	113	# hidden in a special place
	114	$file{'/boot/develop/headers/posix/errno.h'} = 1;
	115
eab60bb1 GS	116	} else {
	117	open(CPPI,"> errno.c") or
	118	die "Cannot open errno.c";
	119
2986a63f JH	120	if ($^O eq 'NetWare') {
	121	print CPPI "#include <nwerrno.h>\n";
	122	} else {
	123	print CPPI "#include <errno.h>\n";
	124	}
eab60bb1 GS	125
	126	close(CPPI);
	127
	128	# invoke CPP and read the output
2986a63f	129	if ($^O eq 'MSWin32' \|\| $^O eq 'NetWare') {
6ad8d9a8 GB	130	open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c \|") or
	131	die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
	132	} else {
def887e8	133	my $cpp = default_cpp();
6ad8d9a8 GB	134	open(CPPO,"$cpp < errno.c \|") or
	135	die "Cannot exec $cpp";
	136	}
eab60bb1 GS	137
eab60bb1 GS	138	my $pat;
2986a63f	139	if (($^O eq 'MSWin32' \|\| $^O eq 'NetWare') and $Config{cc} =~ /^bcc/i) {
eab60bb1 GS	140	$pat = '^/\\s+(.+)\s+\d+\s:\s+\*/';
	141	}
	142	else {
d0d1d9b9	143	$pat = '^#\s(?:line)?\s\d+\s+"([^"]+)"';
eab60bb1 GS	144	}
eab60bb1 GS	145	while(<CPPO>) {
2986a63f	146	if ($^O eq 'os2' or $^O eq 'MSWin32' or $^O eq 'NetWare') {
0196e43b IZ	147	if (/$pat/o) {
	148	my $f = $1;
	149	$f =~ s,\\\\,/,g;
	150	$file{$f} = 1;
	151	}
	152	}
	153	else {
	154	$file{$1} = 1 if /$pat/o;
	155	}
eab60bb1 GS	156	}
	157	close(CPPO);
	158	}
	159	return keys %file;
	160	}
	161
	162	sub write_errno_pm {
	163	my $err;
	164
def887e8 JH	165	# quick sanity check
	166
	167	die "No error definitions found" unless keys %err;
	168
eab60bb1 GS	169	# create the CPP input
	170
	171	open(CPPI,"> errno.c") or
	172	die "Cannot open errno.c";
	173
2986a63f JH	174	if ($^O eq 'NetWare') {
	175	print CPPI "#include <nwerrno.h>\n";
	176	} else {
	177	print CPPI "#include <errno.h>\n";
	178	}
eab60bb1 GS	179
	180	foreach $err (keys %err) {
	181	print CPPI '"',$err,'" [[',$err,']]',"\n";
	182	}
	183
	184	close(CPPI);
	185
db5fd395	186	unless ($^O eq 'MacOS') { # trust what we have
eab60bb1	187	# invoke CPP and read the output
dcbf900d	188
db5fd395 CN	189	if ($^O eq 'VMS') {
	190	my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}";
	191	$cpp =~ s/sys\$input//i;
	192	open(CPPO,"$cpp errno.c \|") or
	193	die "Cannot exec $Config{cppstdin}";
2986a63f	194	} elsif ($^O eq 'MSWin32' \|\| $^O eq 'NetWare') {
db5fd395 CN	195	open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c \|") or
	196	die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
	197	} else {
	198	my $cpp = default_cpp();
	199	open(CPPO,"$cpp < errno.c \|")
	200	or die "Cannot exec $cpp";
	201	}
eab60bb1	202
db5fd395	203	%err = ();
eab60bb1	204
db5fd395 CN	205	while(<CPPO>) {
	206	my($name,$expr);
	207	next unless ($name, $expr) = /"(.?)"\s\[\s\[\s(.?)\s\]\s*\]/;
	208	next if $name eq $expr;
0d3cd356	209	$expr =~ s/(\d+)[LU]+\b/$1/g; # 2147483647L et alia
db5fd395 CN	210	$err{$name} = eval $expr;
	211	}
	212	close(CPPO);
eab60bb1	213	}
eab60bb1 GS	214
	215	# Write Errno.pm
	216
	217	print <<"EDQ";
	218	#
	219	# This file is auto-generated. *ANY* changes here will be lost
	220	#
	221
	222	package Errno;
f168a5e7	223	our (\@EXPORT_OK,\%EXPORT_TAGS,\@ISA,\$VERSION,\%errno,\$AUTOLOAD);
eab60bb1 GS	224	use Exporter ();
	225	use Config;
	226	use strict;
	227
8bc9d590 JH	228	"\$Config{'archname'}-\$Config{'osvers'}" eq
8bc9d590 JH	229	"$Config{'archname'}-$Config{'osvers'}" or
81be85b8	230	die "Errno architecture ($Config{'archname'}-$Config{'osvers'}) does not match executable architecture (\$Config{'archname'}-\$Config{'osvers'})";
eab60bb1 GS	231
	232	\$VERSION = "$VERSION";
	233	\@ISA = qw(Exporter);
	234
	235	EDQ
	236
	237	my $len = 0;
	238	my @err = sort { $err{$a} <=> $err{$b} } keys %err;
	239	map { $len = length if length > $len } @err;
	240
	241	my $j = "\@EXPORT_OK = qw(" . join(" ",keys %err) . ");\n";
	242	$j =~ s/(.{50,70})\s/$1\n\t/g;
	243	print $j,"\n";
	244
	245	print <<'ESQ';
	246	%EXPORT_TAGS = (
	247	POSIX => [qw(
	248	ESQ
	249
	250	my $k = join(" ", grep { exists $err{$_} }
	251	qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT
	252	EAGAIN EALREADY EBADF EBUSY ECHILD ECONNABORTED
	253	ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT
	254	EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS
	255	EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK
	256	EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH
	257	ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM
	258	ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
	259	ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM
	260	EPFNOSUPPORT EPIPE EPROCLIM EPROTONOSUPPORT EPROTOTYPE
	261	ERANGE EREMOTE ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT
	262	ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS ETXTBSY
	263	EUSERS EWOULDBLOCK EXDEV));
	264
	265	$k =~ s/(.{50,70})\s/$1\n\t/g;
	266	print "\t",$k,"\n )]\n);\n\n";
	267
	268	foreach $err (@err) {
	269	printf "sub %s () { %d }\n",,$err,$err{$err};
	270	}
	271
	272	print <<'ESQ';
	273
	274	sub TIEHASH { bless [] }
	275
	276	sub FETCH {
	277	my ($self, $errname) = @_;
	278	my $proto = prototype("Errno::$errname");
68301627	279	my $errno = "";
eab60bb1 GS	280	if (defined($proto) && $proto eq "") {
eab60bb1 GS	281	no strict 'refs';
68301627 GS	282	$errno = &$errname;
68301627 GS	283	$errno = 0 unless $! == $errno;
eab60bb1	284	}
68301627	285	return $errno;
93014de6	286	}
eab60bb1 GS	287
	288	sub STORE {
	289	require Carp;
	290	Carp::confess("ERRNO hash is read only!");
	291	}
	292
	293	*CLEAR = \&STORE;
	294	*DELETE = \&STORE;
	295
	296	sub NEXTKEY {
	297	my($k,$v);
	298	while(($k,$v) = each %Errno::) {
	299	my $proto = prototype("Errno::$k");
	300	last if (defined($proto) && $proto eq "");
eab60bb1 GS	301	}
	302	$k
	303	}
	304
	305	sub FIRSTKEY {
68301627	306	my $s = scalar keys %Errno::; # initialize iterator
eab60bb1 GS	307	goto &NEXTKEY;
	308	}
	309
	310	sub EXISTS {
	311	my ($self, $errname) = @_;
	312	my $proto = prototype($errname);
	313	defined($proto) && $proto eq "";
	314	}
	315
	316	tie %!, __PACKAGE__;
	317
	318	1;
	319	__END__
	320
	321	=head1 NAME
	322
	323	Errno - System errno constants
	324
	325	=head1 SYNOPSIS
	326
	327	use Errno qw(EINTR EIO :POSIX);
	328
	329	=head1 DESCRIPTION
	330
	331	C<Errno> defines and conditionally exports all the error constants
	332	defined in your system C<errno.h> include file. It has a single export
	333	tag, C<:POSIX>, which will export all POSIX defined error numbers.
	334
93014de6	335	C<Errno> also makes C<%!> magic such that each element of C<%!> has a
68301627	336	non-zero value only if C<$!> is set to that value. For example:
eab60bb1 GS	337
eab60bb1 GS	338	use Errno;
3cb6de81	339
eab60bb1 GS	340	unless (open(FH, "/fangorn/spouse")) {
	341	if ($!{ENOENT}) {
	342	warn "Get a wife!\n";
	343	} else {
	344	warn "This path is barred: $!";
	345	}
	346	}
	347
68301627 GS	348	If a specified constant C<EFOO> does not exist on the system, C<$!{EFOO}>
68301627 GS	349	returns C<"">. You may use C<exists $!{EFOO}> to check whether the
93014de6 GS	350	constant is available on the system.
93014de6 GS	351
68301627 GS	352	=head1 CAVEATS
	353
	354	Importing a particular constant may not be very portable, because the
	355	import will fail on platforms that do not have that constant. A more
	356	portable way to set C<$!> to a valid value is to use:
	357
	358	if (exists &Errno::EFOO) {
	359	$! = &Errno::EFOO;
	360	}
	361
eab60bb1 GS	362	=head1 AUTHOR
	363
	364	Graham Barr <gbarr@pobox.com>
	365
	366	=head1 COPYRIGHT
	367
	368	Copyright (c) 1997-8 Graham Barr. All rights reserved.
	369	This program is free software; you can redistribute it and/or modify it
	370	under the same terms as Perl itself.
	371
	372	=cut
	373
	374	ESQ
	375
	376	}