[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);
}
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";
	    if ($^O eq 'MSWin32') {
		print CPPI "#define _WINSOCKAPI_\n"; # don't drag in everything
		print CPPI "#include <winsock.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";
\$VERSION = eval \$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);
	16	}
	17	write_errno_pm();
	18	unlink "errno.c" if -f "errno.c";
	19
	20	sub process_file {
	21	my($file) = @_;
	22
6683669a	23	return unless defined $file and -f $file;
4d70086c	24	# warn "Processing $file\n";
eab60bb1	25
	26	local *FH;
	27	if (($^O eq 'VMS') && ($Config{vms_cc_type} ne 'gnuc')) {
	28	unless(open(FH," LIBRARY/EXTRACT=ERRNO/OUTPUT=SYS\$OUTPUT $file \|")) {
	29	warn "Cannot open '$file'";
	30	return;
	31	}
7237d657	32	} elsif ($Config{gccversion} ne ''
8ff7320b	33	# OpenSTEP has gcc 2.7.2.1 which recognizes but
8ff7320b	34	# doesn't implement the -dM flag.
8f4f83ba	35	&& $^O ne 'openstep' && $^O ne 'next' && $^O ne 'darwin'
8ff7320b	36	) {
9ae2e8df	37	# With the -dM option, gcc outputs every #define it finds
ee1e7ac2	38	unless(open(FH,"$Config{cc} -E -dM $Config{cppflags} $file \|")) {
9ae2e8df	39	warn "Cannot open '$file'";
	40	return;
	41	}
eab60bb1	42	} else {
eab60bb1	43	unless(open(FH,"< $file")) {
def887e8	44	# This file could be a temporary file created by cppstdin
6ad8d9a8	45	# so only warn under -w, and return
6ad8d9a8	46	warn "Cannot open '$file'" if $^W;
eab60bb1	47	return;
	48	}
	49	}
db5fd395	50
	51	if ($^O eq 'MacOS') {
	52	while(<FH>) {
	53	$err{$1} = $2
	54	if /^\s#\sdefine\s+(E\w+)\s+(\d+)/;
	55	}
	56	} else {
	57	while(<FH>) {
	58	$err{$1} = 1
	59	if /^\s#\sdefine\s+(E\w+)\s+/;
4d70086c	60	if ($^O eq 'MSWin32') {
	61	$wsa{$1} = 1
	62	if /^\s#\sdefine\s+WSA(E\w+)\s+/;
	63	}
db5fd395	64	}
	65	}
	66	close(FH);
eab60bb1	67	}
eab60bb1	68
def887e8	69	my $cppstdin;
	70
	71	sub default_cpp {
	72	unless (defined $cppstdin) {
	73	use File::Spec;
	74	$cppstdin = $Config{cppstdin};
	75	my $upup_cppstdin = File::Spec->catfile(File::Spec->updir,
	76	File::Spec->updir,
	77	"cppstdin");
	78	my $cppstdin_is_wrapper =
	79	($cppstdin eq 'cppstdin'
	80	and -f $upup_cppstdin
	81	and -x $upup_cppstdin);
	82	$cppstdin = $upup_cppstdin if $cppstdin_is_wrapper;
	83	}
	84	return "$cppstdin $Config{cppflags} $Config{cppminus}";
	85	}
	86
eab60bb1	87	sub get_files {
	88	my %file = ();
	89	# VMS keeps its include files in system libraries (well, except for Gcc)
	90	if ($^O eq 'VMS') {
	91	if ($Config{vms_cc_type} eq 'decc') {
	92	$file{'Sys$Library:DECC$RTLDEF.TLB'} = 1;
	93	} elsif ($Config{vms_cc_type} eq 'vaxc') {
	94	$file{'Sys$Library:vaxcdef.tlb'} = 1;
	95	} elsif ($Config{vms_cc_type} eq 'gcc') {
	96	$file{'gnu_cc_include:[000000]errno.h'} = 1;
	97	}
9d116dd7	98	} elsif ($^O eq 'os390') {
	99	# OS/390 C compiler doesn't generate #file or #line directives
	100	$file{'/usr/include/errno.h'} = 1;
092bebab	101	} elsif ($^O eq 'vmesa') {
	102	# OS/390 C compiler doesn't generate #file or #line directives
	103	$file{'../../vmesa/errno.h'} = 1;
a367e475	104	} elsif ($Config{archname} eq 'epoc') {
a367e475	105	# Watch out for cross compiling for EPOC (usually done on linux)
02a99678	106	$file{'/usr/local/epocemx/epocsdk/include/libc/sys/errno.h'} = 1;
022394cf	107	} elsif ($^O eq 'linux' &&
	108	$Config{gccversion} ne '' # might be using, say, Intel's icc
	109	) {
9ae2e8df	110	# Some Linuxes have weird errno.hs which generate
	111	# no #file or #line directives
	112	$file{'/usr/include/errno.h'} = 1;
db5fd395	113	} elsif ($^O eq 'MacOS') {
	114	# note that we are only getting the GUSI errno's here ...
	115	# we might miss out on compiler-specific ones
	116	$file{"$ENV{GUSI}include:sys:errno.h"} = 1;
	117
0d3cd356	118	} elsif ($^O eq 'beos') {
	119	# hidden in a special place
	120	$file{'/boot/develop/headers/posix/errno.h'} = 1;
	121
196918b0	122	} elsif ($^O eq 'vos') {
	123	# avoid problem where cpp returns non-POSIX pathnames
	124	$file{'/system/include_library/errno.h'} = 1;
eab60bb1	125	} else {
	126	open(CPPI,"> errno.c") or
	127	die "Cannot open errno.c";
	128
2986a63f	129	if ($^O eq 'NetWare') {
c623ac67	130	print CPPI "#include <nwerrno.h>\n";
2986a63f	131	} else {
c623ac67	132	print CPPI "#include <errno.h>\n";
	133	if ($^O eq 'MSWin32') {
	134	print CPPI "#define _WINSOCKAPI_\n"; # don't drag in everything
	135	print CPPI "#include <winsock.h>\n";
	136	}
2986a63f	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
eab60bb1	289	\$VERSION = "$VERSION";
105cd853	290	\$VERSION = eval \$VERSION;
eab60bb1	291	\@ISA = qw(Exporter);
	292
	293	EDQ
	294
	295	my $len = 0;
	296	my @err = sort { $err{$a} <=> $err{$b} } keys %err;
	297	map { $len = length if length > $len } @err;
	298
	299	my $j = "\@EXPORT_OK = qw(" . join(" ",keys %err) . ");\n";
	300	$j =~ s/(.{50,70})\s/$1\n\t/g;
	301	print $j,"\n";
	302
	303	print <<'ESQ';
	304	%EXPORT_TAGS = (
	305	POSIX => [qw(
	306	ESQ
	307
	308	my $k = join(" ", grep { exists $err{$_} }
	309	qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT
	310	EAGAIN EALREADY EBADF EBUSY ECHILD ECONNABORTED
	311	ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT
	312	EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS
	313	EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK
	314	EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH
	315	ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM
	316	ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
	317	ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM
	318	EPFNOSUPPORT EPIPE EPROCLIM EPROTONOSUPPORT EPROTOTYPE
	319	ERANGE EREMOTE ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT
	320	ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS ETXTBSY
	321	EUSERS EWOULDBLOCK EXDEV));
	322
	323	$k =~ s/(.{50,70})\s/$1\n\t/g;
	324	print "\t",$k,"\n )]\n);\n\n";
	325
	326	foreach $err (@err) {
	327	printf "sub %s () { %d }\n",,$err,$err{$err};
	328	}
	329
	330	print <<'ESQ';
	331
	332	sub TIEHASH { bless [] }
	333
	334	sub FETCH {
	335	my ($self, $errname) = @_;
	336	my $proto = prototype("Errno::$errname");
68301627	337	my $errno = "";
eab60bb1	338	if (defined($proto) && $proto eq "") {
eab60bb1	339	no strict 'refs';
68301627	340	$errno = &$errname;
68301627	341	$errno = 0 unless $! == $errno;
eab60bb1	342	}
68301627	343	return $errno;
93014de6	344	}
eab60bb1	345
	346	sub STORE {
	347	require Carp;
	348	Carp::confess("ERRNO hash is read only!");
	349	}
	350
	351	*CLEAR = \&STORE;
	352	*DELETE = \&STORE;
	353
	354	sub NEXTKEY {
	355	my($k,$v);
	356	while(($k,$v) = each %Errno::) {
	357	my $proto = prototype("Errno::$k");
	358	last if (defined($proto) && $proto eq "");
eab60bb1	359	}
	360	$k
	361	}
	362
	363	sub FIRSTKEY {
68301627	364	my $s = scalar keys %Errno::; # initialize iterator
eab60bb1	365	goto &NEXTKEY;
	366	}
	367
	368	sub EXISTS {
	369	my ($self, $errname) = @_;
	370	my $proto = prototype($errname);
	371	defined($proto) && $proto eq "";
	372	}
	373
	374	tie %!, __PACKAGE__;
	375
	376	1;
	377	__END__
	378
	379	=head1 NAME
	380
	381	Errno - System errno constants
	382
	383	=head1 SYNOPSIS
	384
	385	use Errno qw(EINTR EIO :POSIX);
	386
	387	=head1 DESCRIPTION
	388
	389	C<Errno> defines and conditionally exports all the error constants
	390	defined in your system C<errno.h> include file. It has a single export
	391	tag, C<:POSIX>, which will export all POSIX defined error numbers.
	392
93014de6	393	C<Errno> also makes C<%!> magic such that each element of C<%!> has a
68301627	394	non-zero value only if C<$!> is set to that value. For example:
eab60bb1	395
eab60bb1	396	use Errno;
3cb6de81	397
eab60bb1	398	unless (open(FH, "/fangorn/spouse")) {
	399	if ($!{ENOENT}) {
	400	warn "Get a wife!\n";
	401	} else {
	402	warn "This path is barred: $!";
	403	}
	404	}
	405
68301627	406	If a specified constant C<EFOO> does not exist on the system, C<$!{EFOO}>
68301627	407	returns C<"">. You may use C<exists $!{EFOO}> to check whether the
93014de6	408	constant is available on the system.
93014de6	409
68301627	410	=head1 CAVEATS
	411
	412	Importing a particular constant may not be very portable, because the
	413	import will fail on platforms that do not have that constant. A more
	414	portable way to set C<$!> to a valid value is to use:
	415
	416	if (exists &Errno::EFOO) {
	417	$! = &Errno::EFOO;
	418	}
	419
eab60bb1	420	=head1 AUTHOR
	421
	422	Graham Barr <gbarr@pobox.com>
	423
	424	=head1 COPYRIGHT
	425
	426	Copyright (c) 1997-8 Graham Barr. All rights reserved.
	427	This program is free software; you can redistribute it and/or modify it
	428	under the same terms as Perl itself.
	429
	430	=cut
	431
	432	ESQ
	433
	434	}