[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 = ();
my %wsa = ();

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);
    if ($^O eq 'MSWin32') {
      $file =~ s/errno/winsock/;
      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;
#   warn "Processing $file\n";

    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+/;
            if ($^O eq 'MSWin32') {
	        $wsa{$1} = 1
	    	    if /^\s*#\s*define\s+WSA(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/epocemx/epocsdk/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";
    }
    if ($^O eq 'MSWin32') {
	print CPPI "#include <winsock.h>\n";
	foreach $err (keys %wsa) {
	    print CPPI "#ifndef $err\n";
	    print CPPI "#define $err WSA$err\n";
	    print CPPI "#endif\n";
	    $err{$err} = 1;
	}
    }
 
    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);
    }

    # Many of the E constants (including ENOENT, which is being
    # used in the Perl test suite a lot), are available only as
    # enums in BeOS, so compiling and executing some code is about
    # only way to find out what the numeric Evalues are.

    if ($^O eq 'beos') {
	if (open(C, ">errno.c")) {
	    my @zero = grep { !$err{$_} } keys %err;
	    print C <<EOF;
#include <errno.h>
#include <stdio.h>
int main() {
EOF
            for (@zero) {
		print C qq[printf("$_ %d\n", $_);]
	    }
            print C "}\n";
            close C;
            system("cc -o errno errno.c");
            unlink("errno.c");
            if (open(C, "./errno|")) {
		while (<C>) {
		    if (/^(\w+) (-?\d+)$/) { $err{$1} = $2 }
		}
		close(C);
	    } else {
		die "failed to execute ./errno: $!\n";
	    }
            unlink("errno");
        } else {
	    die "failed to create errno.c: $!\n";
	}
    }

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