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