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/epocemx/epocsdk/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     } elsif ($^O eq 'beos') {
 113         # hidden in a special place
 114         $file{'/boot/develop/headers/posix/errno.h'} = 1;
 115
 116     } else {
 117         open(CPPI,"> errno.c") or
 118             die "Cannot open errno.c";
 119
 120         if ($^O eq 'NetWare') {
 121                 print CPPI "#include <nwerrno.h>\n";
 122         } else {
 123                 print CPPI "#include <errno.h>\n";
 124         }
 125
 126         close(CPPI);
 127
 128         # invoke CPP and read the output
 129         if ($^O eq 'MSWin32' || $^O eq 'NetWare') {
 130             open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
 131                 die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
 132         } else {
 133             my $cpp = default_cpp();
 134             open(CPPO,"$cpp < errno.c |") or
 135                 die "Cannot exec $cpp";
 136         }
 137
 138         my $pat;
 139         if (($^O eq 'MSWin32' || $^O eq 'NetWare') and $Config{cc} =~ /^bcc/i) {
 140             $pat = '^/\*\s+(.+)\s+\d+\s*:\s+\*/';
 141         }
 142         else {
 143             $pat = '^#\s*(?:line)?\s*\d+\s+"([^"]+)"';
 144         }
 145         while(<CPPO>) {
 146             if ($^O eq 'os2' or $^O eq 'MSWin32' or $^O eq 'NetWare') {
 147                 if (/$pat/o) {
 148                    my $f = $1;
 149                    $f =~ s,\\\\,/,g;
 150                    $file{$f} = 1;
 151                 }
 152             }
 153             else {
 154                 $file{$1} = 1 if /$pat/o;
 155             }
 156         }
 157         close(CPPO);
 158     }
 159     return keys %file;
 160 }
 161
 162 sub write_errno_pm {
 163     my $err;
 164
 165     # quick sanity check
 166
 167     die "No error definitions found" unless keys %err;
 168
 169     # create the CPP input
 170
 171     open(CPPI,"> errno.c") or
 172         die "Cannot open errno.c";
 173
 174     if ($^O eq 'NetWare') {
 175                 print CPPI "#include <nwerrno.h>\n";
 176         } else {
 177                 print CPPI "#include <errno.h>\n";
 178         }
 179
 180     foreach $err (keys %err) {
 181         print CPPI '"',$err,'" [[',$err,']]',"\n";
 182     }
 183
 184     close(CPPI);
 185
 186     unless ($^O eq 'MacOS') {   # trust what we have
 187     # invoke CPP and read the output
 188
 189         if ($^O eq 'VMS') {
 190             my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}";
 191             $cpp =~ s/sys\$input//i;
 192             open(CPPO,"$cpp  errno.c |") or
 193                 die "Cannot exec $Config{cppstdin}";
 194         } elsif ($^O eq 'MSWin32' || $^O eq 'NetWare') {
 195             open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
 196                 die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
 197         } else {
 198             my $cpp = default_cpp();
 199             open(CPPO,"$cpp < errno.c |")
 200                 or die "Cannot exec $cpp";
 201         }
 202
 203         %err = ();
 204
 205         while(<CPPO>) {
 206             my($name,$expr);
 207             next unless ($name, $expr) = /"(.*?)"\s*\[\s*\[\s*(.*?)\s*\]\s*\]/;
 208             next if $name eq $expr;
 209             $expr =~ s/(\d+)[LU]+\b/$1/g; # 2147483647L et alia
 210             $err{$name} = eval $expr;
 211         }
 212         close(CPPO);
 213     }
 214
 215     # Many of the E constants (including ENOENT, which is being
 216     # used in the Perl test suite a lot), are available only as
 217     # enums in BeOS, so compiling and executing some code is about
 218     # only way to find out what the numeric Evalues are.
 219
 220     if ($^O eq 'beos') {
 221         if (open(C, ">errno.c")) {
 222             my @zero = grep { !$err{$_} } keys %err;
 223             print C <<EOF;
 224 #include <errno.h>
 225 #include <stdio.h>
 226 int main() {
 227 EOF
 228             for (@zero) {
 229                 print C qq[printf("$_ %d\n", $_);]
 230             }
 231             print C "}\n";
 232             close C;
 233             system("cc -o errno errno.c");
 234             unlink("errno.c");
 235             if (open(C, "./errno|")) {
 236                 while (<C>) {
 237                     if (/^(\w+) (-?\d+)$/) { $err{$1} = $2 }
 238                 }
 239                 close(C);
 240             } else {
 241                 die "failed to execute ./errno: $!\n";
 242             }
 243             unlink("errno");
 244         } else {
 245             die "failed to create errno.c: $!\n";
 246         }
 247     }
 248
 249     # Write Errno.pm
 250
 251     print <<"EDQ";
 252 #
 253 # This file is auto-generated. ***ANY*** changes here will be lost
 254 #
 255
 256 package Errno;
 257 our (\@EXPORT_OK,\%EXPORT_TAGS,\@ISA,\$VERSION,\%errno,\$AUTOLOAD);
 258 use Exporter ();
 259 use Config;
 260 use strict;
 261
 262 "\$Config{'archname'}-\$Config{'osvers'}" eq
 263 "$Config{'archname'}-$Config{'osvers'}" or
 264         die "Errno architecture ($Config{'archname'}-$Config{'osvers'}) does not match executable architecture (\$Config{'archname'}-\$Config{'osvers'})";
 265
 266 \$VERSION = "$VERSION";
 267 \@ISA = qw(Exporter);
 268
 269 EDQ
 270
 271     my $len = 0;
 272     my @err = sort { $err{$a} <=> $err{$b} } keys %err;
 273     map { $len = length if length > $len } @err;
 274
 275     my $j = "\@EXPORT_OK = qw(" . join(" ",keys %err) . ");\n";
 276     $j =~ s/(.{50,70})\s/$1\n\t/g;
 277     print $j,"\n";
 278
 279 print <<'ESQ';
 280 %EXPORT_TAGS = (
 281     POSIX => [qw(
 282 ESQ
 283
 284     my $k = join(" ", grep { exists $err{$_} }
 285         qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT
 286         EAGAIN EALREADY EBADF EBUSY ECHILD ECONNABORTED
 287         ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT
 288         EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS
 289         EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK
 290         EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH
 291         ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM
 292         ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
 293         ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM
 294         EPFNOSUPPORT EPIPE EPROCLIM EPROTONOSUPPORT EPROTOTYPE
 295         ERANGE EREMOTE ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT
 296         ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS ETXTBSY
 297         EUSERS EWOULDBLOCK EXDEV));
 298
 299     $k =~ s/(.{50,70})\s/$1\n\t/g;
 300     print "\t",$k,"\n    )]\n);\n\n";
 301
 302     foreach $err (@err) {
 303         printf "sub %s () { %d }\n",,$err,$err{$err};
 304     }
 305
 306     print <<'ESQ';
 307
 308 sub TIEHASH { bless [] }
 309
 310 sub FETCH {
 311     my ($self, $errname) = @_;
 312     my $proto = prototype("Errno::$errname");
 313     my $errno = "";
 314     if (defined($proto) && $proto eq "") {
 315         no strict 'refs';
 316         $errno = &$errname;
 317         $errno = 0 unless $! == $errno;
 318     }
 319     return $errno;
 320 }
 321
 322 sub STORE {
 323     require Carp;
 324     Carp::confess("ERRNO hash is read only!");
 325 }
 326
 327 *CLEAR = \&STORE;
 328 *DELETE = \&STORE;
 329
 330 sub NEXTKEY {
 331     my($k,$v);
 332     while(($k,$v) = each %Errno::) {
 333         my $proto = prototype("Errno::$k");
 334         last if (defined($proto) && $proto eq "");
 335     }
 336     $k
 337 }
 338
 339 sub FIRSTKEY {
 340     my $s = scalar keys %Errno::;       # initialize iterator
 341     goto &NEXTKEY;
 342 }
 343
 344 sub EXISTS {
 345     my ($self, $errname) = @_;
 346     my $proto = prototype($errname);
 347     defined($proto) && $proto eq "";
 348 }
 349
 350 tie %!, __PACKAGE__;
 351
 352 1;
 353 __END__
 354
 355 =head1 NAME
 356
 357 Errno - System errno constants
 358
 359 =head1 SYNOPSIS
 360
 361     use Errno qw(EINTR EIO :POSIX);
 362
 363 =head1 DESCRIPTION
 364
 365 C<Errno> defines and conditionally exports all the error constants
 366 defined in your system C<errno.h> include file. It has a single export
 367 tag, C<:POSIX>, which will export all POSIX defined error numbers.
 368
 369 C<Errno> also makes C<%!> magic such that each element of C<%!> has a
 370 non-zero value only if C<$!> is set to that value. For example:
 371
 372     use Errno;
 373
 374     unless (open(FH, "/fangorn/spouse")) {
 375         if ($!{ENOENT}) {
 376             warn "Get a wife!\n";
 377         } else {
 378             warn "This path is barred: $!";
 379         }
 380     }
 381
 382 If a specified constant C<EFOO> does not exist on the system, C<$!{EFOO}>
 383 returns C<"">.  You may use C<exists $!{EFOO}> to check whether the
 384 constant is available on the system.
 385
 386 =head1 CAVEATS
 387
 388 Importing a particular constant may not be very portable, because the
 389 import will fail on platforms that do not have that constant.  A more
 390 portable way to set C<$!> to a valid value is to use:
 391
 392     if (exists &Errno::EFOO) {
 393         $! = &Errno::EFOO;
 394     }
 395
 396 =head1 AUTHOR
 397
 398 Graham Barr <gbarr@pobox.com>
 399
 400 =head1 COPYRIGHT
 401
 402 Copyright (c) 1997-8 Graham Barr. All rights reserved.
 403 This program is free software; you can redistribute it and/or modify it
 404 under the same terms as Perl itself.
 405
 406 =cut
 407
 408 ESQ
 409
 410 }