X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FErrno%2FErrno_pm.PL;h=5c76d89057094175745bbf843351e8b319b9b616;hb=427d62a407a31445bc7585263d1b781552e27ce5;hp=75dacfc0bd1c37f081e4664fb85ff4b9dcd5c2d0;hpb=146174a91a192983720a158796dc066226ad0e55;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/Errno/Errno_pm.PL b/ext/Errno/Errno_pm.PL index 75dacfc..5c76d89 100644 --- a/ext/Errno/Errno_pm.PL +++ b/ext/Errno/Errno_pm.PL @@ -2,11 +2,15 @@ use ExtUtils::MakeMaker; use Config; use strict; -use vars qw($VERSION); - -$VERSION = "1.111"; +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: $!"; @@ -21,7 +25,14 @@ 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')) { @@ -29,6 +40,16 @@ sub process_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 @@ -37,11 +58,24 @@ sub process_file { return; } } - while() { - $err{$1} = 1 - if /^\s*#\s*define\s+(E\w+)\s+/; - } - close(FH); + + if ($^O eq 'MacOS') { + while() { + $err{$1} = $2 + if /^\s*#\s*define\s+(E\w+)\s+(\d+)/; + } + } else { + while() { + $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; @@ -79,16 +113,51 @@ sub get_files { } 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"; - print CPPI "#include \n"; + if ($^O eq 'NetWare') { + print CPPI "#include \n"; + } else { + print CPPI "#include \n"; + if ($IsMSWin32) { + print CPPI "#define _WINSOCKAPI_\n"; # don't drag in everything + print CPPI "#include \n"; + } + } close(CPPI); # invoke CPP and read the output - if ($^O eq 'MSWin32') { + if ($IsMSWin32 || $^O eq 'NetWare') { open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'"; } else { @@ -98,14 +167,14 @@ sub get_files { } my $pat; - if ($^O eq 'MSWin32' and $Config{cc} =~ /^bcc/i) { + if (($IsMSWin32 || $^O eq 'NetWare') and $Config{cc} =~ /^bcc/i) { $pat = '^/\*\s+(.+)\s+\d+\s*:\s+\*/'; } else { - $pat = '^#(?:line)?\s*\d+\s+"([^"]+)"'; + $pat = '^#\s*(?:line)?\s*\d+\s+"([^"]+)"'; } while() { - if ($^O eq 'os2' or $^O eq 'MSWin32') { + if ($^O eq 'os2' or $IsMSWin32 or $^O eq 'NetWare') { if (/$pat/o) { my $f = $1; $f =~ s,\\\\,/,g; @@ -133,39 +202,104 @@ sub write_errno_pm { open(CPPI,"> errno.c") or die "Cannot open errno.c"; - print CPPI "#include \n"; - + if ($^O eq 'NetWare') { + print CPPI "#include \n"; + } + else { + print CPPI "#include \n"; + } + if ($IsMSWin32) { + print CPPI "#include \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 ($^O eq 'MSWin32') { - 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"; - } + 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 = (); + %err = (); - while() { - my($name,$expr); - next unless ($name, $expr) = /"(.*?)"\s*\[\s*\[\s*(.*?)\s*\]\s*\]/; - next if $name eq $expr; - $err{$name} = eval $expr; + while() { + 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 < +#include +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 () { + 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"; + } } - close(CPPO); # Write Errno.pm @@ -175,7 +309,7 @@ sub write_errno_pm { # package Errno; -use vars qw(\@EXPORT_OK \%EXPORT_TAGS \@ISA \$VERSION \%errno \$AUTOLOAD); +our (\@EXPORT_OK,\%EXPORT_TAGS,\@ISA,\$VERSION,\%errno,\$AUTOLOAD); use Exporter (); use Config; use strict; @@ -185,6 +319,7 @@ use strict; 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 @@ -231,13 +366,14 @@ sub TIEHASH { bless [] } sub FETCH { my ($self, $errname) = @_; my $proto = prototype("Errno::$errname"); + my $errno = ""; if (defined($proto) && $proto eq "") { no strict 'refs'; - return $! == &$errname; + $errno = &$errname; + $errno = 0 unless $! == $errno; } - require Carp; - Carp::confess("No errno $errname"); -} + return $errno; +} sub STORE { require Carp; @@ -252,19 +388,19 @@ sub NEXTKEY { while(($k,$v) = each %Errno::) { my $proto = prototype("Errno::$k"); last if (defined($proto) && $proto eq ""); - } $k } sub FIRSTKEY { - my $s = scalar keys %Errno::; + my $s = scalar keys %Errno::; # initialize iterator goto &NEXTKEY; } sub EXISTS { my ($self, $errname) = @_; - my $proto = prototype($errname); + my $r = ref $errname; + my $proto = !$r || $r eq 'CODE' ? prototype($errname) : undef; defined($proto) && $proto eq ""; } @@ -287,11 +423,11 @@ C defines and conditionally exports all the error constants defined in your system C include file. It has a single export tag, C<:POSIX>, which will export all POSIX defined error numbers. -C also makes C<%!> magic such that each element of C<%!> has a non-zero -value only if C<$!> is set to that value, eg +C 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"; @@ -300,6 +436,20 @@ value only if C<$!> is set to that value, eg } } +If a specified constant C does not exist on the system, C<$!{EFOO}> +returns C<"">. You may use C 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