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

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

our $VERSION = "1.13";

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";
# -*- buffer-read-only: t -*-
#
# This file is auto-generated. ***ANY*** changes here will be lost
#

package Errno;
require 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'})";

our \$VERSION = "$VERSION";
\$VERSION = eval \$VERSION;
our \@ISA = 'Exporter';

my %err;

BEGIN {
    %err = (
EDQ

    my @err = sort { $err{$a} <=> $err{$b} }
	grep { $err{$_} =~ /-?\d+$/ } keys %err;

    foreach $err (@err) {
	print "\t$err => $err{$err},\n";
    }

print <<'ESQ';
    );
    # Generate proxy constant subroutines for all the values.
    # We assume at this point that our symbol table is empty.
    # Doing this before defining @EXPORT_OK etc means that even if a platform is
    # crazy enough to define EXPORT_OK as an error constant, everything will
    # still work, because the parser will upgrade the PCS to a real typeglob.
    # We rely on the subroutine definitions below to update the internal caches.
    # Don't use %each, as we don't want a copy of the value.
    foreach my $name (keys %err) {
        $Errno::{$name} = \$err{$name};
    }
}

our @EXPORT_OK = keys %err;

our %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";

    print <<'ESQ';
sub TIEHASH { bless \%err }

sub FETCH {
    my (undef, $errname) = @_;
    return "" unless exists $err{$errname};
    my $errno = $err{$errname};
    return $errno == $! ? $errno : 0;
}

sub STORE {
    require Carp;
    Carp::confess("ERRNO hash is read only!");
}

*CLEAR = \&STORE;
*DELETE = \&STORE;

sub NEXTKEY {
    each %err;
}

sub FIRSTKEY {
    my $s = scalar keys %err;	# initialize iterator
    each %err;
}

sub EXISTS {
    my (undef, $errname) = @_;
    exists $err{$errname};
}

tie %!, __PACKAGE__; # Returns an object, objects are true.

__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

# ex: set ro:
ESQ

}
Commit	Line	Data
eab60bb1 GS	1	use ExtUtils::MakeMaker;
	2	use Config;
	3	use strict;
	4
aa2e500f	5	our $VERSION = "1.13";
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	15	unlink "Errno.pm" if -f "Errno.pm";
cedab142 NC	16	unlink "Errno.tmp" if -f "Errno.tmp";
cedab142 NC	17	open OUT, ">Errno.tmp" or die "Cannot open Errno.tmp: $!";
eab60bb1 GS	18	select OUT;
eab60bb1 GS	19	my $file;
1e92bf58 SH	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 YST	28	next if $file eq 'errno.c';
eeb7067f YST	29	next unless -f $file;
1e92bf58 SH	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 GS	40	}
	41	write_errno_pm();
	42	unlink "errno.c" if -f "errno.c";
f5800e99 NC	43	close OUT or die "Error closing Errno.tmp: $!";
f5800e99 NC	44	select STDOUT;
cedab142	45	rename "Errno.tmp", "Errno.pm" or die "Cannot rename Errno.tmp to Errno.pm: $!";
eab60bb1 GS	46
	47	sub process_file {
	48	my($file) = @_;
	49
22402b47 YST	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 GS	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 JH	66	# OpenSTEP has gcc 2.7.2.1 which recognizes but
8ff7320b JH	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 PR	72	warn "Cannot open '$file'";
	73	return;
	74	}
eab60bb1 GS	75	} else {
eab60bb1 GS	76	unless(open(FH,"< $file")) {
def887e8	77	# This file could be a temporary file created by cppstdin
6ad8d9a8 GB	78	# so only warn under -w, and return
6ad8d9a8 GB	79	warn "Cannot open '$file'" if $^W;
eab60bb1 GS	80	return;
	81	}
	82	}
27da23d5	83
db5fd395 CN	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 NIS	94	$wsa{$1} = 1
	95	if /^\s#\sdefine\s+WSA(E\w+)\s+/;
	96	}
db5fd395 CN	97	}
db5fd395 CN	98	}
27da23d5	99
db5fd395	100	close(FH);
eab60bb1 GS	101	}
eab60bb1 GS	102
def887e8 JH	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 GS	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 JH	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 JH	135	} elsif ($^O eq 'vmesa') {
	136	# OS/390 C compiler doesn't generate #file or #line directives
	137	$file{'../../vmesa/errno.h'} = 1;
a367e475 OF	138	} elsif ($Config{archname} eq 'epoc') {
a367e475 OF	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 AW	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 SP	149	$Config{gccversion} !~ /intel/i
e9014798 SP	150	# might be using, say, Intel's icc
022394cf	151	) {
9ae2e8df PR	152	# Some Linuxes have weird errno.hs which generate
9ae2e8df PR	153	# no #file or #line directives
a148bc21 DK	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 CN	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 JH	163	# hidden in a special place
	164	$file{'/boot/develop/headers/posix/errno.h'} = 1;
	165
196918b0 PG	166	} elsif ($^O eq 'vos') {
	167	# avoid problem where cpp returns non-POSIX pathnames
	168	$file{'/system/include_library/errno.h'} = 1;
27da23d5 JH	169	} elsif ($IsSymbian) {
	170	my $SDK = $ENV{SDK};
	171	$SDK =~ s!\\!/!g;
	172	$file{"$SDK/epoc32/include/libc/sys/errno.h"} = 1;
eab60bb1 GS	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 GS	182	print CPPI "#define _WINSOCKAPI_\n"; # don't drag in everything
	183	print CPPI "#include <winsock.h>\n";
	184	}
2986a63f	185	}
eab60bb1 GS	186
	187	close(CPPI);
	188
	189	# invoke CPP and read the output
27da23d5	190	if ($IsMSWin32 \|\| $^O eq 'NetWare') {
6ad8d9a8 GB	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 GB	195	open(CPPO,"$cpp < errno.c \|") or
	196	die "Cannot exec $cpp";
	197	}
eab60bb1 GS	198
eab60bb1 GS	199	my $pat;
27da23d5	200	if (($IsMSWin32 \|\| $^O eq 'NetWare') and $Config{cc} =~ /^bcc/i) {
eab60bb1 GS	201	$pat = '^/\\s+(.+)\s+\d+\s:\s+\*/';
	202	}
	203	else {
d0d1d9b9	204	$pat = '^#\s(?:line)?\s\d+\s+"([^"]+)"';
eab60bb1 GS	205	}
eab60bb1 GS	206	while(<CPPO>) {
27da23d5	207	if ($^O eq 'os2' or $IsMSWin32 or $^O eq 'NetWare') {
0196e43b IZ	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 GS	217	}
	218	close(CPPO);
	219	}
	220	return keys %file;
	221	}
	222
	223	sub write_errno_pm {
	224	my $err;
	225
def887e8 JH	226	# quick sanity check
	227
	228	die "No error definitions found" unless keys %err;
	229
eab60bb1 GS	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 NIS	236	print CPPI "#include <nwerrno.h>\n";
	237	}
	238	else {
	239	print CPPI "#include <errno.h>\n";
	240	}
27da23d5	241	if ($IsMSWin32) {
4d70086c NIS	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 NIS	249	}
4d70086c NIS	250
eab60bb1 GS	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 CN	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 CN	266	open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c \|") or
db5fd395 CN	267	die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
27da23d5 JH	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 CN	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 CN	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 MB	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 CN	291	$err{$name} = eval $expr;
db5fd395 CN	292	}
99228ec2 MB	293	delete $err{$name} unless defined $err{$name};
99228ec2 MB	294	}
db5fd395	295	close(CPPO);
eab60bb1	296	}
eab60bb1	297
7bf567bf JH	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 IW	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 JH	304
	305	if ($^O eq 'beos') {
	306	if (open(C, ">errno.c")) {
dbc1d986	307	my @allerrs = keys %err;
7bf567bf JH	308	print C <<EOF;
	309	#include <errno.h>
	310	#include <stdio.h>
	311	int main() {
	312	EOF
dbc1d986	313	for (@allerrs) {
7bf567bf JH	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 GS	334	# Write Errno.pm
	335
	336	print <<"EDQ";
8f8c2a44	337	# -- buffer-read-only: t --
eab60bb1 GS	338	#
	339	# This file is auto-generated. *ANY* changes here will be lost
	340	#
	341
	342	package Errno;
8f8c2a44	343	require Exporter;
eab60bb1 GS	344	use Config;
	345	use strict;
	346
8bc9d590 JH	347	"\$Config{'archname'}-\$Config{'osvers'}" eq
8bc9d590 JH	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
8f8c2a44	351	our \$VERSION = "$VERSION";
105cd853	352	\$VERSION = eval \$VERSION;
8f8c2a44	353	our \@ISA = 'Exporter';
eab60bb1	354
42607a60 NC	355	my %err;
	356
	357	BEGIN {
	358	%err = (
eab60bb1	359	EDQ
be54382c CJ	360
	361	my @err = sort { $err{$a} <=> $err{$b} }
	362	grep { $err{$_} =~ /-?\d+$/ } keys %err;
eab60bb1	363
42607a60 NC	364	foreach $err (@err) {
	365	print "\t$err => $err{$err},\n";
	366	}
eab60bb1 GS	367
eab60bb1 GS	368	print <<'ESQ';
42607a60 NC	369	);
	370	# Generate proxy constant subroutines for all the values.
	371	# We assume at this point that our symbol table is empty.
	372	# Doing this before defining @EXPORT_OK etc means that even if a platform is
	373	# crazy enough to define EXPORT_OK as an error constant, everything will
	374	# still work, because the parser will upgrade the PCS to a real typeglob.
	375	# We rely on the subroutine definitions below to update the internal caches.
	376	# Don't use %each, as we don't want a copy of the value.
	377	foreach my $name (keys %err) {
	378	$Errno::{$name} = \$err{$name};
	379	}
	380	}
	381
8f8c2a44	382	our @EXPORT_OK = keys %err;
42607a60	383
8f8c2a44	384	our %EXPORT_TAGS = (
eab60bb1 GS	385	POSIX => [qw(
	386	ESQ
	387
	388	my $k = join(" ", grep { exists $err{$_} }
	389	qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT
	390	EAGAIN EALREADY EBADF EBUSY ECHILD ECONNABORTED
	391	ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT
	392	EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS
	393	EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK
	394	EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH
	395	ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM
	396	ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
	397	ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM
	398	EPFNOSUPPORT EPIPE EPROCLIM EPROTONOSUPPORT EPROTOTYPE
	399	ERANGE EREMOTE ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT
	400	ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS ETXTBSY
	401	EUSERS EWOULDBLOCK EXDEV));
	402
	403	$k =~ s/(.{50,70})\s/$1\n\t/g;
	404	print "\t",$k,"\n )]\n);\n\n";
	405
eab60bb1	406	print <<'ESQ';
42607a60	407	sub TIEHASH { bless \%err }
eab60bb1 GS	408
eab60bb1 GS	409	sub FETCH {
42607a60 NC	410	my (undef, $errname) = @_;
	411	return "" unless exists $err{$errname};
	412	my $errno = $err{$errname};
	413	return $errno == $! ? $errno : 0;
93014de6	414	}
eab60bb1 GS	415
	416	sub STORE {
	417	require Carp;
	418	Carp::confess("ERRNO hash is read only!");
	419	}
	420
	421	*CLEAR = \&STORE;
	422	*DELETE = \&STORE;
	423
	424	sub NEXTKEY {
42607a60	425	each %err;
eab60bb1 GS	426	}
	427
	428	sub FIRSTKEY {
42607a60 NC	429	my $s = scalar keys %err; # initialize iterator
42607a60 NC	430	each %err;
eab60bb1 GS	431	}
	432
	433	sub EXISTS {
42607a60 NC	434	my (undef, $errname) = @_;
42607a60 NC	435	exists $err{$errname};
eab60bb1 GS	436	}
eab60bb1 GS	437
42607a60	438	tie %!, __PACKAGE__; # Returns an object, objects are true.
eab60bb1	439
eab60bb1 GS	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 GS	458
eab60bb1 GS	459	use Errno;
3cb6de81	460
eab60bb1 GS	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 GS	469	If a specified constant C<EFOO> does not exist on the system, C<$!{EFOO}>
68301627 GS	470	returns C<"">. You may use C<exists $!{EFOO}> to check whether the
93014de6 GS	471	constant is available on the system.
93014de6 GS	472
68301627 GS	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 GS	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
8f8c2a44	495	# ex: set ro:
eab60bb1 GS	496	ESQ
	497
	498	}