ext/Errno/Errno_pm.PL

   1 use ExtUtils::MakeMaker;
   2 use Config;
   3 use strict;
   4
   5 our $VERSION = "1.09_00";
   6
   7 my %err = ();
   8
   9 unlink "Errno.pm" if -f "Errno.pm";
  10 open OUT, ">Errno.pm" or die "Cannot open Errno.pm: $!";
  11 select OUT;
  12 my $file;
  13 foreach $file (get_files()) {
  14     process_file($file);
  15 }
  16 write_errno_pm();
  17 unlink "errno.c" if -f "errno.c";
  18
  19 sub process_file {
  20     my($file) = @_;
  21
  22     return unless defined $file and -f $file;
  23
  24     local *FH;
  25     if (($^O eq 'VMS') && ($Config{vms_cc_type} ne 'gnuc')) {
  26         unless(open(FH," LIBRARY/EXTRACT=ERRNO/OUTPUT=SYS\$OUTPUT $file |")) {
  27             warn "Cannot open '$file'";
  28             return;
  29         }
  30     } elsif ($Config{gccversion} ne ''
  31              # OpenSTEP has gcc 2.7.2.1 which recognizes but
  32              # doesn't implement the -dM flag.
  33              && $^O ne 'openstep' && $^O ne 'next' && $^O ne 'darwin'
  34              ) {
  35         # With the -dM option, gcc outputs every #define it finds
  36         unless(open(FH,"$Config{cc} -E -dM $Config{cppflags} $file |")) {
  37             warn "Cannot open '$file'";
  38             return;
  39         }
  40     } else {
  41         unless(open(FH,"< $file")) {
  42             # This file could be a temporary file created by cppstdin
  43             # so only warn under -w, and return
  44             warn "Cannot open '$file'" if $^W;
  45             return;
  46         }
  47     }
  48
  49     if ($^O eq 'MacOS') {
  50         while(<FH>) {
  51             $err{$1} = $2
  52                 if /^\s*#\s*define\s+(E\w+)\s+(\d+)/;
  53         }
  54     } else {
  55         while(<FH>) {
  56             $err{$1} = 1
  57                 if /^\s*#\s*define\s+(E\w+)\s+/;
  58         }
  59     }
  60     close(FH);
  61 }
  62
  63 my $cppstdin;
  64
  65 sub default_cpp {
  66     unless (defined $cppstdin) {
  67         use File::Spec;
  68         $cppstdin = $Config{cppstdin};
  69         my $upup_cppstdin = File::Spec->catfile(File::Spec->updir,
  70                                                 File::Spec->updir,
  71                                                 "cppstdin");
  72         my $cppstdin_is_wrapper =
  73             ($cppstdin eq 'cppstdin'
  74                 and -f $upup_cppstdin
  75                     and -x $upup_cppstdin);
  76         $cppstdin = $upup_cppstdin if $cppstdin_is_wrapper;
  77     }
  78     return "$cppstdin $Config{cppflags} $Config{cppminus}";
  79 }
  80
  81 sub get_files {
  82     my %file = ();
  83     # VMS keeps its include files in system libraries (well, except for Gcc)
  84     if ($^O eq 'VMS') {
  85         if ($Config{vms_cc_type} eq 'decc') {
  86             $file{'Sys$Library:DECC$RTLDEF.TLB'} = 1;
  87         } elsif ($Config{vms_cc_type} eq 'vaxc') {
  88             $file{'Sys$Library:vaxcdef.tlb'} = 1;
  89         } elsif ($Config{vms_cc_type} eq 'gcc') {
  90             $file{'gnu_cc_include:[000000]errno.h'} = 1;
  91         }
  92     } elsif ($^O eq 'os390') {
  93         # OS/390 C compiler doesn't generate #file or #line directives
  94         $file{'/usr/include/errno.h'} = 1;
  95     } elsif ($^O eq 'vmesa') {
  96         # OS/390 C compiler doesn't generate #file or #line directives
  97         $file{'../../vmesa/errno.h'} = 1;
  98     } elsif ($Config{archname} eq 'epoc') {
  99         # Watch out for cross compiling for EPOC (usually done on linux)
 100         $file{'/usr/local/epoc/include/libc/sys/errno.h'} = 1;
 101     } elsif ($^O eq 'linux' &&
 102              $Config{gccversion} ne '' # might be using, say, Intel's icc
 103              ) {
 104         # Some Linuxes have weird errno.hs which generate
 105         # no #file or #line directives
 106         $file{'/usr/include/errno.h'} = 1;
 107     } elsif ($^O eq 'MacOS') {
 108         # note that we are only getting the GUSI errno's here ...
 109         # we might miss out on compiler-specific ones
 110         $file{"$ENV{GUSI}include:sys:errno.h"} = 1;
 111
 112     } else {
 113         open(CPPI,"> errno.c") or
 114             die "Cannot open errno.c";
 115
 116         if ($^O eq 'NetWare') {
 117                 print CPPI "#include <nwerrno.h>\n";
 118         } else {
 119                 print CPPI "#include <errno.h>\n";
 120         }
 121
 122         close(CPPI);
 123
 124         # invoke CPP and read the output
 125         if ($^O eq 'MSWin32' || $^O eq 'NetWare') {
 126             open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
 127                 die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
 128         } else {
 129             my $cpp = default_cpp();
 130             open(CPPO,"$cpp < errno.c |") or
 131                 die "Cannot exec $cpp";
 132         }
 133
 134         my $pat;
 135         if (($^O eq 'MSWin32' || $^O eq 'NetWare') and $Config{cc} =~ /^bcc/i) {
 136             $pat = '^/\*\s+(.+)\s+\d+\s*:\s+\*/';
 137         }
 138         else {
 139             $pat = '^#\s*(?:line)?\s*\d+\s+"([^"]+)"';
 140         }
 141         while(<CPPO>) {
 142             if ($^O eq 'os2' or $^O eq 'MSWin32' or $^O eq 'NetWare') {
 143                 if (/$pat/o) {
 144                    my $f = $1;
 145                    $f =~ s,\\\\,/,g;
 146                    $file{$f} = 1;
 147                 }
 148             }
 149             else {
 150                 $file{$1} = 1 if /$pat/o;
 151             }
 152         }
 153         close(CPPO);
 154     }
 155     return keys %file;
 156 }
 157
 158 sub write_errno_pm {
 159     my $err;
 160
 161     # quick sanity check
 162
 163     die "No error definitions found" unless keys %err;
 164
 165     # create the CPP input
 166
 167     open(CPPI,"> errno.c") or
 168         die "Cannot open errno.c";
 169
 170     if ($^O eq 'NetWare') {
 171                 print CPPI "#include <nwerrno.h>\n";
 172         } else {
 173                 print CPPI "#include <errno.h>\n";
 174         }
 175
 176     foreach $err (keys %err) {
 177         print CPPI '"',$err,'" [[',$err,']]',"\n";
 178     }
 179
 180     close(CPPI);
 181
 182     unless ($^O eq 'MacOS') {   # trust what we have
 183     # invoke CPP and read the output
 184
 185         if ($^O eq 'VMS') {
 186             my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}";
 187             $cpp =~ s/sys\$input//i;
 188             open(CPPO,"$cpp  errno.c |") or
 189                 die "Cannot exec $Config{cppstdin}";
 190         } elsif ($^O eq 'MSWin32' || $^O eq 'NetWare') {
 191             open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
 192                 die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
 193         } else {
 194             my $cpp = default_cpp();
 195             open(CPPO,"$cpp < errno.c |")
 196                 or die "Cannot exec $cpp";
 197         }
 198
 199         %err = ();
 200
 201         while(<CPPO>) {
 202             my($name,$expr);
 203             next unless ($name, $expr) = /"(.*?)"\s*\[\s*\[\s*(.*?)\s*\]\s*\]/;
 204             next if $name eq $expr;
 205             $err{$name} = eval $expr;
 206         }
 207         close(CPPO);
 208     }
 209
 210     # Write Errno.pm
 211
 212     print <<"EDQ";
 213 #
 214 # This file is auto-generated. ***ANY*** changes here will be lost
 215 #
 216
 217 package Errno;
 218 our (\@EXPORT_OK,\%EXPORT_TAGS,\@ISA,\$VERSION,\%errno,\$AUTOLOAD);
 219 use Exporter ();
 220 use Config;
 221 use strict;
 222
 223 "\$Config{'archname'}-\$Config{'osvers'}" eq
 224 "$Config{'archname'}-$Config{'osvers'}" or
 225         die "Errno architecture ($Config{'archname'}-$Config{'osvers'}) does not match executable architecture (\$Config{'archname'}-\$Config{'osvers'})";
 226
 227 \$VERSION = "$VERSION";
 228 \@ISA = qw(Exporter);
 229
 230 EDQ
 231
 232     my $len = 0;
 233     my @err = sort { $err{$a} <=> $err{$b} } keys %err;
 234     map { $len = length if length > $len } @err;
 235
 236     my $j = "\@EXPORT_OK = qw(" . join(" ",keys %err) . ");\n";
 237     $j =~ s/(.{50,70})\s/$1\n\t/g;
 238     print $j,"\n";
 239
 240 print <<'ESQ';
 241 %EXPORT_TAGS = (
 242     POSIX => [qw(
 243 ESQ
 244
 245     my $k = join(" ", grep { exists $err{$_} }
 246         qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT
 247         EAGAIN EALREADY EBADF EBUSY ECHILD ECONNABORTED
 248         ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT
 249         EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS
 250         EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK
 251         EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH
 252         ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM
 253         ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
 254         ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM
 255         EPFNOSUPPORT EPIPE EPROCLIM EPROTONOSUPPORT EPROTOTYPE
 256         ERANGE EREMOTE ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT
 257         ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS ETXTBSY
 258         EUSERS EWOULDBLOCK EXDEV));
 259
 260     $k =~ s/(.{50,70})\s/$1\n\t/g;
 261     print "\t",$k,"\n    )]\n);\n\n";
 262
 263     foreach $err (@err) {
 264         printf "sub %s () { %d }\n",,$err,$err{$err};
 265     }
 266
 267     print <<'ESQ';
 268
 269 sub TIEHASH { bless [] }
 270
 271 sub FETCH {
 272     my ($self, $errname) = @_;
 273     my $proto = prototype("Errno::$errname");
 274     my $errno = "";
 275     if (defined($proto) && $proto eq "") {
 276         no strict 'refs';
 277         $errno = &$errname;
 278         $errno = 0 unless $! == $errno;
 279     }
 280     return $errno;
 281 }
 282
 283 sub STORE {
 284     require Carp;
 285     Carp::confess("ERRNO hash is read only!");
 286 }
 287
 288 *CLEAR = \&STORE;
 289 *DELETE = \&STORE;
 290
 291 sub NEXTKEY {
 292     my($k,$v);
 293     while(($k,$v) = each %Errno::) {
 294         my $proto = prototype("Errno::$k");
 295         last if (defined($proto) && $proto eq "");
 296     }
 297     $k
 298 }
 299
 300 sub FIRSTKEY {
 301     my $s = scalar keys %Errno::;       # initialize iterator
 302     goto &NEXTKEY;
 303 }
 304
 305 sub EXISTS {
 306     my ($self, $errname) = @_;
 307     my $proto = prototype($errname);
 308     defined($proto) && $proto eq "";
 309 }
 310
 311 tie %!, __PACKAGE__;
 312
 313 1;
 314 __END__
 315
 316 =head1 NAME
 317
 318 Errno - System errno constants
 319
 320 =head1 SYNOPSIS
 321
 322     use Errno qw(EINTR EIO :POSIX);
 323
 324 =head1 DESCRIPTION
 325
 326 C<Errno> defines and conditionally exports all the error constants
 327 defined in your system C<errno.h> include file. It has a single export
 328 tag, C<:POSIX>, which will export all POSIX defined error numbers.
 329
 330 C<Errno> also makes C<%!> magic such that each element of C<%!> has a
 331 non-zero value only if C<$!> is set to that value. For example:
 332
 333     use Errno;
 334
 335     unless (open(FH, "/fangorn/spouse")) {
 336         if ($!{ENOENT}) {
 337             warn "Get a wife!\n";
 338         } else {
 339             warn "This path is barred: $!";
 340         }
 341     }
 342
 343 If a specified constant C<EFOO> does not exist on the system, C<$!{EFOO}>
 344 returns C<"">.  You may use C<exists $!{EFOO}> to check whether the
 345 constant is available on the system.
 346
 347 =head1 CAVEATS
 348
 349 Importing a particular constant may not be very portable, because the
 350 import will fail on platforms that do not have that constant.  A more
 351 portable way to set C<$!> to a valid value is to use:
 352
 353     if (exists &Errno::EFOO) {
 354         $! = &Errno::EFOO;
 355     }
 356
 357 =head1 AUTHOR
 358
 359 Graham Barr <gbarr@pobox.com>
 360
 361 =head1 COPYRIGHT
 362
 363 Copyright (c) 1997-8 Graham Barr. All rights reserved.
 364 This program is free software; you can redistribute it and/or modify it
 365 under the same terms as Perl itself.
 366
 367 =cut
 368
 369 ESQ
 370
 371 }