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