[p5sagit/p5-mst-13.2.git] / ext / Errno / Errno_pm.PL

use ExtUtils::MakeMaker;
use Config;
use strict;

our $VERSION = "1.09_01";

my %err = ();
my %wsa = ();

# Symbian cross-compiling environment.
my $IsSymbian = exists $ENV{SDK} && -d "$ENV{SDK}\\epoc32";

my $IsMSWin32 = $^O eq 'MSWin32' && !$IsSymbian;

unlink "Errno.pm" if -f "Errno.pm";
open OUT, ">Errno.pm" or die "Cannot open Errno.pm: $!";
select OUT;
my $file;
my @files = get_files();
if ($Config{gccversion} ne '' && $^O eq 'MSWin32') {
    # MinGW complains "warning: #pragma system_header ignored outside include
    # file" if the header files are processed individually, so include them
    # all in .c file and process that instead.
    open INCS, '>includes.c' or
	die "Cannot open includes.c";
    foreach $file (@files) {
	next if $file eq 'errno.c';
	next unless -f $file;
	print INCS qq[#include "$file"\n];
    }
    close INCS;
    process_file('includes.c');
    unlink 'includes.c';
}
else {
    foreach $file (@files) {
	process_file($file);
    }
}
write_errno_pm();
unlink "errno.c" if -f "errno.c";

sub process_file {
    my($file) = @_;

    # for win32 perl under cygwin, we need to get a windows pathname
    if ($^O eq 'MSWin32' && $Config{cc} =~ /\B-mno-cygwin\b/ &&
        defined($file) && !-f $file) {
        chomp($file = `cygpath -w "$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 ($IsMSWin32) {
	        $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;
    } elsif ($IsSymbian) {
        my $SDK = $ENV{SDK};
        $SDK =~ s!\\!/!g;
	$file{"$SDK/epoc32/include/libc/sys/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 ($IsMSWin32) {
		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 ($IsMSWin32 || $^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 (($IsMSWin32 || $^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 $IsMSWin32 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 ($IsMSWin32) {
	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' || $^O eq 'beos') {	# trust what we have / get later
    # 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 ($IsMSWin32 || $^O eq 'NetWare') {
	    open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
		die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
	} elsif ($IsSymbian) {
            my $cpp = "gcc -E -I$ENV{SDK}\\epoc32\\include\\libc -";
	    open(CPPO,"$cpp < errno.c |")
		or die "Cannot exec $cpp";
        } 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/\(?\([a-z_]\w*\)([^\)]*)\)?/$1/i; # ((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. In fact above, we
    # didn't even bother to get the values of the ones that have numeric
    # values, since we can get all of them here, anyway.

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