for(;;), sort

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

diff --git a/ext/Errno/Errno_pm.PL b/ext/Errno/Errno_pm.PL
index ba0b281..4a11318 100644 (file)
--- a/ext/Errno/Errno_pm.PL
+++ b/ext/Errno/Errno_pm.PL
@@ -2,9 +2,7 @@ use ExtUtils::MakeMaker;
 use Config;
 use strict;
 
-use vars qw($VERSION);
-
-$VERSION = "1.111";
+our $VERSION = "1.111";
 
 my %err = ();
 
@@ -21,7 +19,7 @@ unlink "errno.c" if -f "errno.c";
 sub process_file {
     my($file) = @_;
 
-    return if !defined $file || $file eq '-';
+    return unless defined $file and -f $file;
 
     local *FH;
     if (($^O eq 'VMS') && ($Config{vms_cc_type} ne 'gnuc')) {
@@ -29,6 +27,12 @@ sub process_file {
             warn "Cannot open '$file'";
             return;
        }     
+    } elsif ($Config{gccversion} ne '') { 
+       # 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 +41,19 @@ sub process_file {
             return;
        }
     }
-    while(<FH>) {
-       $err{$1} = 1
-           if /^\s*#\s*define\s+(E\w+)\s+/;
-   }
-   close(FH);
+
+    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+/;
+       }
+    }
+    close(FH);
 }
 
 my $cppstdin;
@@ -79,6 +91,18 @@ 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/epoc/include/libc/sys/errno.h'} = 1;
+    } elsif ($^O eq 'linux') {
+       # Some Linuxes have weird errno.hs which generate
+       # no #file or #line directives
+       $file{'/usr/include/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;
+
     } else {
        open(CPPI,"> errno.c") or
            die "Cannot open errno.c";
@@ -102,7 +126,7 @@ sub get_files {
            $pat = '^/\*\s+(.+)\s+\d+\s*:\s+\*/';
        }
        else {
-           $pat = '^#(?:line)?\s*\d+\s+"([^"]+)"';
+           $pat = '^#\s*(?:line)?\s*\d+\s+"([^"]+)"';
        }
        while(<CPPO>) {
            if ($^O eq 'os2' or $^O eq 'MSWin32') {
@@ -141,31 +165,33 @@ sub write_errno_pm {
 
     close(CPPI);
 
+    unless ($^O eq 'MacOS') {  # trust what we have
     # 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 ($^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";
+       }
 
-    %err = ();
+       %err = ();
 
-    while(<CPPO>) {
-       my($name,$expr);
-       next unless ($name, $expr) = /"(.*?)"\s*\[\s*\[\s*(.*?)\s*\]\s*\]/;
-       next if $name eq $expr;
-       $err{$name} = eval $expr;
+       while(<CPPO>) {
+           my($name,$expr);
+           next unless ($name, $expr) = /"(.*?)"\s*\[\s*\[\s*(.*?)\s*\]\s*\]/;
+           next if $name eq $expr;
+           $err{$name} = eval $expr;
+       }
+       close(CPPO);
     }
-    close(CPPO);
 
     # Write Errno.pm
 
@@ -175,7 +201,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;
@@ -231,13 +257,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,13 +279,12 @@ 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;
 }
 
@@ -287,11 +313,11 @@ 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, eg
+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";
@@ -300,6 +326,20 @@ value only if C<$!> is set to that value, eg
         } 
     } 
 
+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>