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

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

our $VERSION = "1.11";

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";
unlink "Errno.tmp" if -f "Errno.tmp";
open OUT, ">Errno.tmp" or die "Cannot open Errno.tmp: $!";
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";
close OUT or die "Error closing Errno.tmp: $!";
select STDOUT;
rename "Errno.tmp", "Errno.pm" or die "Cannot rename Errno.tmp to Errno.pm: $!";

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