ext/Errno/Errno_pm.PL

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