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

    } elsif ($^O eq 'vos') {
	# avoid problem where cpp returns non-POSIX pathnames
	$file{'/system/include_library/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
196918b0	126	} elsif ($^O eq 'vos') {
	127	# avoid problem where cpp returns non-POSIX pathnames
	128	$file{'/system/include_library/errno.h'} = 1;
eab60bb1	129	} else {
	130	open(CPPI,"> errno.c") or
	131	die "Cannot open errno.c";
	132
2986a63f	133	if ($^O eq 'NetWare') {
	134	print CPPI "#include <nwerrno.h>\n";
	135	} else {
	136	print CPPI "#include <errno.h>\n";
	137	}
eab60bb1	138
	139	close(CPPI);
	140
	141	# invoke CPP and read the output
2986a63f	142	if ($^O eq 'MSWin32' \|\| $^O eq 'NetWare') {
6ad8d9a8	143	open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c \|") or
	144	die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
	145	} else {
def887e8	146	my $cpp = default_cpp();
6ad8d9a8	147	open(CPPO,"$cpp < errno.c \|") or
	148	die "Cannot exec $cpp";
	149	}
eab60bb1	150
eab60bb1	151	my $pat;
2986a63f	152	if (($^O eq 'MSWin32' \|\| $^O eq 'NetWare') and $Config{cc} =~ /^bcc/i) {
eab60bb1	153	$pat = '^/\\s+(.+)\s+\d+\s:\s+\*/';
	154	}
	155	else {
d0d1d9b9	156	$pat = '^#\s(?:line)?\s\d+\s+"([^"]+)"';
eab60bb1	157	}
eab60bb1	158	while(<CPPO>) {
2986a63f	159	if ($^O eq 'os2' or $^O eq 'MSWin32' or $^O eq 'NetWare') {
0196e43b	160	if (/$pat/o) {
	161	my $f = $1;
	162	$f =~ s,\\\\,/,g;
	163	$file{$f} = 1;
	164	}
	165	}
	166	else {
	167	$file{$1} = 1 if /$pat/o;
	168	}
eab60bb1	169	}
	170	close(CPPO);
	171	}
	172	return keys %file;
	173	}
	174
	175	sub write_errno_pm {
	176	my $err;
	177
def887e8	178	# quick sanity check
	179
	180	die "No error definitions found" unless keys %err;
	181
eab60bb1	182	# create the CPP input
	183
	184	open(CPPI,"> errno.c") or
	185	die "Cannot open errno.c";
	186
2986a63f	187	if ($^O eq 'NetWare') {
4d70086c	188	print CPPI "#include <nwerrno.h>\n";
	189	}
	190	else {
	191	print CPPI "#include <errno.h>\n";
	192	}
	193	if ($^O eq 'MSWin32') {
	194	print CPPI "#include <winsock.h>\n";
	195	foreach $err (keys %wsa) {
	196	print CPPI "#ifndef $err\n";
	197	print CPPI "#define $err WSA$err\n";
	198	print CPPI "#endif\n";
	199	$err{$err} = 1;
2986a63f	200	}
4d70086c	201	}
4d70086c	202
eab60bb1	203	foreach $err (keys %err) {
	204	print CPPI '"',$err,'" [[',$err,']]',"\n";
	205	}
	206
	207	close(CPPI);
	208
db5fd395	209	unless ($^O eq 'MacOS') { # trust what we have
eab60bb1	210	# invoke CPP and read the output
dcbf900d	211
db5fd395	212	if ($^O eq 'VMS') {
	213	my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}";
	214	$cpp =~ s/sys\$input//i;
	215	open(CPPO,"$cpp errno.c \|") or
	216	die "Cannot exec $Config{cppstdin}";
2986a63f	217	} elsif ($^O eq 'MSWin32' \|\| $^O eq 'NetWare') {
db5fd395	218	open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c \|") or
	219	die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
	220	} else {
	221	my $cpp = default_cpp();
	222	open(CPPO,"$cpp < errno.c \|")
	223	or die "Cannot exec $cpp";
	224	}
eab60bb1	225
db5fd395	226	%err = ();
eab60bb1	227
db5fd395	228	while(<CPPO>) {
	229	my($name,$expr);
	230	next unless ($name, $expr) = /"(.?)"\s\[\s\[\s(.?)\s\]\s*\]/;
	231	next if $name eq $expr;
0d3cd356	232	$expr =~ s/(\d+)[LU]+\b/$1/g; # 2147483647L et alia
db5fd395	233	$err{$name} = eval $expr;
	234	}
	235	close(CPPO);
eab60bb1	236	}
eab60bb1	237
7bf567bf	238	# Many of the E constants (including ENOENT, which is being
	239	# used in the Perl test suite a lot), are available only as
	240	# enums in BeOS, so compiling and executing some code is about
	241	# only way to find out what the numeric Evalues are.
	242
	243	if ($^O eq 'beos') {
	244	if (open(C, ">errno.c")) {
	245	my @zero = grep { !$err{$_} } keys %err;
	246	print C <<EOF;
	247	#include <errno.h>
	248	#include <stdio.h>
	249	int main() {
	250	EOF
	251	for (@zero) {
	252	print C qq[printf("$_ %d\n", $_);]
	253	}
	254	print C "}\n";
	255	close C;
	256	system("cc -o errno errno.c");
	257	unlink("errno.c");
	258	if (open(C, "./errno\|")) {
	259	while (<C>) {
	260	if (/^(\w+) (-?\d+)$/) { $err{$1} = $2 }
	261	}
	262	close(C);
	263	} else {
	264	die "failed to execute ./errno: $!\n";
	265	}
	266	unlink("errno");
	267	} else {
	268	die "failed to create errno.c: $!\n";
	269	}
	270	}
	271
eab60bb1	272	# Write Errno.pm
	273
	274	print <<"EDQ";
	275	#
	276	# This file is auto-generated. *ANY* changes here will be lost
	277	#
	278
	279	package Errno;
f168a5e7	280	our (\@EXPORT_OK,\%EXPORT_TAGS,\@ISA,\$VERSION,\%errno,\$AUTOLOAD);
eab60bb1	281	use Exporter ();
	282	use Config;
	283	use strict;
	284
8bc9d590	285	"\$Config{'archname'}-\$Config{'osvers'}" eq
8bc9d590	286	"$Config{'archname'}-$Config{'osvers'}" or
81be85b8	287	die "Errno architecture ($Config{'archname'}-$Config{'osvers'}) does not match executable architecture (\$Config{'archname'}-\$Config{'osvers'})";
eab60bb1	288
	289	\$VERSION = "$VERSION";
	290	\@ISA = qw(Exporter);
	291
	292	EDQ
	293
	294	my $len = 0;
	295	my @err = sort { $err{$a} <=> $err{$b} } keys %err;
	296	map { $len = length if length > $len } @err;
	297
	298	my $j = "\@EXPORT_OK = qw(" . join(" ",keys %err) . ");\n";
	299	$j =~ s/(.{50,70})\s/$1\n\t/g;
	300	print $j,"\n";
	301
	302	print <<'ESQ';
	303	%EXPORT_TAGS = (
	304	POSIX => [qw(
	305	ESQ
	306
	307	my $k = join(" ", grep { exists $err{$_} }
	308	qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT
	309	EAGAIN EALREADY EBADF EBUSY ECHILD ECONNABORTED
	310	ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT
	311	EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS
	312	EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK
	313	EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH
	314	ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM
	315	ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
	316	ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM
	317	EPFNOSUPPORT EPIPE EPROCLIM EPROTONOSUPPORT EPROTOTYPE
	318	ERANGE EREMOTE ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT
	319	ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS ETXTBSY
	320	EUSERS EWOULDBLOCK EXDEV));
	321
	322	$k =~ s/(.{50,70})\s/$1\n\t/g;
	323	print "\t",$k,"\n )]\n);\n\n";
	324
	325	foreach $err (@err) {
	326	printf "sub %s () { %d }\n",,$err,$err{$err};
	327	}
	328
	329	print <<'ESQ';
	330
	331	sub TIEHASH { bless [] }
	332
	333	sub FETCH {
	334	my ($self, $errname) = @_;
	335	my $proto = prototype("Errno::$errname");
68301627	336	my $errno = "";
eab60bb1	337	if (defined($proto) && $proto eq "") {
eab60bb1	338	no strict 'refs';
68301627	339	$errno = &$errname;
68301627	340	$errno = 0 unless $! == $errno;
eab60bb1	341	}
68301627	342	return $errno;
93014de6	343	}
eab60bb1	344
	345	sub STORE {
	346	require Carp;
	347	Carp::confess("ERRNO hash is read only!");
	348	}
	349
	350	*CLEAR = \&STORE;
	351	*DELETE = \&STORE;
	352
	353	sub NEXTKEY {
	354	my($k,$v);
	355	while(($k,$v) = each %Errno::) {
	356	my $proto = prototype("Errno::$k");
	357	last if (defined($proto) && $proto eq "");
eab60bb1	358	}
	359	$k
	360	}
	361
	362	sub FIRSTKEY {
68301627	363	my $s = scalar keys %Errno::; # initialize iterator
eab60bb1	364	goto &NEXTKEY;
	365	}
	366
	367	sub EXISTS {
	368	my ($self, $errname) = @_;
	369	my $proto = prototype($errname);
	370	defined($proto) && $proto eq "";
	371	}
	372
	373	tie %!, __PACKAGE__;
	374
	375	1;
	376	__END__
	377
	378	=head1 NAME
	379
	380	Errno - System errno constants
	381
	382	=head1 SYNOPSIS
	383
	384	use Errno qw(EINTR EIO :POSIX);
	385
	386	=head1 DESCRIPTION
	387
	388	C<Errno> defines and conditionally exports all the error constants
	389	defined in your system C<errno.h> include file. It has a single export
	390	tag, C<:POSIX>, which will export all POSIX defined error numbers.
	391
93014de6	392	C<Errno> also makes C<%!> magic such that each element of C<%!> has a
68301627	393	non-zero value only if C<$!> is set to that value. For example:
eab60bb1	394
eab60bb1	395	use Errno;
3cb6de81	396
eab60bb1	397	unless (open(FH, "/fangorn/spouse")) {
	398	if ($!{ENOENT}) {
	399	warn "Get a wife!\n";
	400	} else {
	401	warn "This path is barred: $!";
	402	}
	403	}
	404
68301627	405	If a specified constant C<EFOO> does not exist on the system, C<$!{EFOO}>
68301627	406	returns C<"">. You may use C<exists $!{EFOO}> to check whether the
93014de6	407	constant is available on the system.
93014de6	408
68301627	409	=head1 CAVEATS
	410
	411	Importing a particular constant may not be very portable, because the
	412	import will fail on platforms that do not have that constant. A more
	413	portable way to set C<$!> to a valid value is to use:
	414
	415	if (exists &Errno::EFOO) {
	416	$! = &Errno::EFOO;
	417	}
	418
eab60bb1	419	=head1 AUTHOR
	420
	421	Graham Barr <gbarr@pobox.com>
	422
	423	=head1 COPYRIGHT
	424
	425	Copyright (c) 1997-8 Graham Barr. All rights reserved.
	426	This program is free software; you can redistribute it and/or modify it
	427	under the same terms as Perl itself.
	428
	429	=cut
	430
	431	ESQ
	432
	433	}