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