[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/\(?\(\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 $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;
99228ec2	232	$expr =~ s/\(?\(\w+\)([^\)]*)\)?/$1/; # ((type)0xcafebabe) at alia
	233	$expr =~ s/((?:0x)?[0-9a-fA-F]+)[LU]+\b/$1/g; # 2147483647L et alia
	234	next if $expr =~ m/^[a-zA-Z]+$/; # skip some Win32 functions
	235	if($expr =~ m/^0[xX]/) {
	236	$err{$name} = hex $expr;
	237	}
	238	else {
db5fd395	239	$err{$name} = eval $expr;
db5fd395	240	}
99228ec2	241	delete $err{$name} unless defined $err{$name};
99228ec2	242	}
db5fd395	243	close(CPPO);
eab60bb1	244	}
eab60bb1	245
7bf567bf	246	# Many of the E constants (including ENOENT, which is being
	247	# used in the Perl test suite a lot), are available only as
	248	# enums in BeOS, so compiling and executing some code is about
	249	# only way to find out what the numeric Evalues are.
	250
	251	if ($^O eq 'beos') {
	252	if (open(C, ">errno.c")) {
	253	my @zero = grep { !$err{$_} } keys %err;
	254	print C <<EOF;
	255	#include <errno.h>
	256	#include <stdio.h>
	257	int main() {
	258	EOF
	259	for (@zero) {
	260	print C qq[printf("$_ %d\n", $_);]
	261	}
	262	print C "}\n";
	263	close C;
	264	system("cc -o errno errno.c");
	265	unlink("errno.c");
	266	if (open(C, "./errno\|")) {
	267	while (<C>) {
	268	if (/^(\w+) (-?\d+)$/) { $err{$1} = $2 }
	269	}
	270	close(C);
	271	} else {
	272	die "failed to execute ./errno: $!\n";
	273	}
	274	unlink("errno");
	275	} else {
	276	die "failed to create errno.c: $!\n";
	277	}
	278	}
	279
eab60bb1	280	# Write Errno.pm
	281
	282	print <<"EDQ";
	283	#
	284	# This file is auto-generated. *ANY* changes here will be lost
	285	#
	286
	287	package Errno;
f168a5e7	288	our (\@EXPORT_OK,\%EXPORT_TAGS,\@ISA,\$VERSION,\%errno,\$AUTOLOAD);
eab60bb1	289	use Exporter ();
	290	use Config;
	291	use strict;
	292
8bc9d590	293	"\$Config{'archname'}-\$Config{'osvers'}" eq
8bc9d590	294	"$Config{'archname'}-$Config{'osvers'}" or
81be85b8	295	die "Errno architecture ($Config{'archname'}-$Config{'osvers'}) does not match executable architecture (\$Config{'archname'}-\$Config{'osvers'})";
eab60bb1	296
eab60bb1	297	\$VERSION = "$VERSION";
105cd853	298	\$VERSION = eval \$VERSION;
eab60bb1	299	\@ISA = qw(Exporter);
	300
	301	EDQ
	302
	303	my $len = 0;
	304	my @err = sort { $err{$a} <=> $err{$b} } keys %err;
	305	map { $len = length if length > $len } @err;
	306
	307	my $j = "\@EXPORT_OK = qw(" . join(" ",keys %err) . ");\n";
	308	$j =~ s/(.{50,70})\s/$1\n\t/g;
	309	print $j,"\n";
	310
	311	print <<'ESQ';
	312	%EXPORT_TAGS = (
	313	POSIX => [qw(
	314	ESQ
	315
	316	my $k = join(" ", grep { exists $err{$_} }
	317	qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT
	318	EAGAIN EALREADY EBADF EBUSY ECHILD ECONNABORTED
	319	ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT
	320	EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS
	321	EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK
	322	EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH
	323	ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM
	324	ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
	325	ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM
	326	EPFNOSUPPORT EPIPE EPROCLIM EPROTONOSUPPORT EPROTOTYPE
	327	ERANGE EREMOTE ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT
	328	ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS ETXTBSY
	329	EUSERS EWOULDBLOCK EXDEV));
	330
	331	$k =~ s/(.{50,70})\s/$1\n\t/g;
	332	print "\t",$k,"\n )]\n);\n\n";
	333
	334	foreach $err (@err) {
	335	printf "sub %s () { %d }\n",,$err,$err{$err};
	336	}
	337
	338	print <<'ESQ';
	339
	340	sub TIEHASH { bless [] }
	341
	342	sub FETCH {
	343	my ($self, $errname) = @_;
	344	my $proto = prototype("Errno::$errname");
68301627	345	my $errno = "";
eab60bb1	346	if (defined($proto) && $proto eq "") {
eab60bb1	347	no strict 'refs';
68301627	348	$errno = &$errname;
68301627	349	$errno = 0 unless $! == $errno;
eab60bb1	350	}
68301627	351	return $errno;
93014de6	352	}
eab60bb1	353
	354	sub STORE {
	355	require Carp;
	356	Carp::confess("ERRNO hash is read only!");
	357	}
	358
	359	*CLEAR = \&STORE;
	360	*DELETE = \&STORE;
	361
	362	sub NEXTKEY {
	363	my($k,$v);
	364	while(($k,$v) = each %Errno::) {
	365	my $proto = prototype("Errno::$k");
	366	last if (defined($proto) && $proto eq "");
eab60bb1	367	}
	368	$k
	369	}
	370
	371	sub FIRSTKEY {
68301627	372	my $s = scalar keys %Errno::; # initialize iterator
eab60bb1	373	goto &NEXTKEY;
	374	}
	375
	376	sub EXISTS {
	377	my ($self, $errname) = @_;
	378	my $proto = prototype($errname);
	379	defined($proto) && $proto eq "";
	380	}
	381
	382	tie %!, __PACKAGE__;
	383
	384	1;
	385	__END__
	386
	387	=head1 NAME
	388
	389	Errno - System errno constants
	390
	391	=head1 SYNOPSIS
	392
	393	use Errno qw(EINTR EIO :POSIX);
	394
	395	=head1 DESCRIPTION
	396
	397	C<Errno> defines and conditionally exports all the error constants
	398	defined in your system C<errno.h> include file. It has a single export
	399	tag, C<:POSIX>, which will export all POSIX defined error numbers.
	400
93014de6	401	C<Errno> also makes C<%!> magic such that each element of C<%!> has a
68301627	402	non-zero value only if C<$!> is set to that value. For example:
eab60bb1	403
eab60bb1	404	use Errno;
3cb6de81	405
eab60bb1	406	unless (open(FH, "/fangorn/spouse")) {
	407	if ($!{ENOENT}) {
	408	warn "Get a wife!\n";
	409	} else {
	410	warn "This path is barred: $!";
	411	}
	412	}
	413
68301627	414	If a specified constant C<EFOO> does not exist on the system, C<$!{EFOO}>
68301627	415	returns C<"">. You may use C<exists $!{EFOO}> to check whether the
93014de6	416	constant is available on the system.
93014de6	417
68301627	418	=head1 CAVEATS
	419
	420	Importing a particular constant may not be very portable, because the
	421	import will fail on platforms that do not have that constant. A more
	422	portable way to set C<$!> to a valid value is to use:
	423
	424	if (exists &Errno::EFOO) {
	425	$! = &Errno::EFOO;
	426	}
	427
eab60bb1	428	=head1 AUTHOR
	429
	430	Graham Barr <gbarr@pobox.com>
	431
	432	=head1 COPYRIGHT
	433
	434	Copyright (c) 1997-8 Graham Barr. All rights reserved.
	435	This program is free software; you can redistribute it and/or modify it
	436	under the same terms as Perl itself.
	437
	438	=cut
	439
	440	ESQ
	441
	442	}