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