[perl5.git] / ext / Errno / Errno_pm.PL

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

our $VERSION = "1.10";

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