ext/Errno/Errno_pm.PL

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