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