This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove unused %errno and $AUTOLOAD from the generated Errno.pm
[perl5.git] / ext / Errno / Errno_pm.PL
CommitLineData
eab60bb1
GS
1use ExtUtils::MakeMaker;
2use Config;
3use strict;
4
f5d41823 5our $VERSION = "1.12";
eab60bb1
GS
6
7my %err = ();
4d70086c 8my %wsa = ();
eab60bb1 9
27da23d5
JH
10# Symbian cross-compiling environment.
11my $IsSymbian = exists $ENV{SDK} && -d "$ENV{SDK}\\epoc32";
12
13my $IsMSWin32 = $^O eq 'MSWin32' && !$IsSymbian;
14
eab60bb1 15unlink "Errno.pm" if -f "Errno.pm";
cedab142
NC
16unlink "Errno.tmp" if -f "Errno.tmp";
17open OUT, ">Errno.tmp" or die "Cannot open Errno.tmp: $!";
eab60bb1
GS
18select OUT;
19my $file;
1e92bf58
SH
20my @files = get_files();
21if ($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) {
eeb7067f
YST
28 next if $file eq 'errno.c';
29 next unless -f $file;
1e92bf58
SH
30 print INCS qq[#include "$file"\n];
31 }
32 close INCS;
33 process_file('includes.c');
34 unlink 'includes.c';
35}
36else {
37 foreach $file (@files) {
38 process_file($file);
39 }
eab60bb1
GS
40}
41write_errno_pm();
42unlink "errno.c" if -f "errno.c";
f5800e99
NC
43close OUT or die "Error closing Errno.tmp: $!";
44select STDOUT;
cedab142 45rename "Errno.tmp", "Errno.pm" or die "Cannot rename Errno.tmp to Errno.pm: $!";
eab60bb1
GS
46
47sub process_file {
48 my($file) = @_;
49
22402b47
YST
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
6683669a 56 return unless defined $file and -f $file;
27da23d5 57# warn "Processing $file\n";
eab60bb1
GS
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 }
7237d657 65 } elsif ($Config{gccversion} ne ''
8ff7320b
JH
66 # OpenSTEP has gcc 2.7.2.1 which recognizes but
67 # doesn't implement the -dM flag.
8f4f83ba 68 && $^O ne 'openstep' && $^O ne 'next' && $^O ne 'darwin'
8ff7320b 69 ) {
9ae2e8df 70 # With the -dM option, gcc outputs every #define it finds
ee1e7ac2 71 unless(open(FH,"$Config{cc} -E -dM $Config{cppflags} $file |")) {
9ae2e8df
P
72 warn "Cannot open '$file'";
73 return;
74 }
eab60bb1
GS
75 } else {
76 unless(open(FH,"< $file")) {
def887e8 77 # This file could be a temporary file created by cppstdin
6ad8d9a8
GB
78 # so only warn under -w, and return
79 warn "Cannot open '$file'" if $^W;
eab60bb1
GS
80 return;
81 }
82 }
27da23d5 83
db5fd395
CN
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+/;
27da23d5 93 if ($IsMSWin32) {
4d70086c
NIS
94 $wsa{$1} = 1
95 if /^\s*#\s*define\s+WSA(E\w+)\s+/;
96 }
db5fd395
CN
97 }
98 }
27da23d5 99
db5fd395 100 close(FH);
eab60bb1
GS
101}
102
def887e8
JH
103my $cppstdin;
104
105sub 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
eab60bb1
GS
121sub 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 }
9d116dd7
JH
132 } elsif ($^O eq 'os390') {
133 # OS/390 C compiler doesn't generate #file or #line directives
134 $file{'/usr/include/errno.h'} = 1;
092bebab
JH
135 } elsif ($^O eq 'vmesa') {
136 # OS/390 C compiler doesn't generate #file or #line directives
137 $file{'../../vmesa/errno.h'} = 1;
a367e475
OF
138 } elsif ($Config{archname} eq 'epoc') {
139 # Watch out for cross compiling for EPOC (usually done on linux)
02a99678 140 $file{'/usr/local/epocemx/epocsdk/include/libc/sys/errno.h'} = 1;
7ee146b1
AW
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 }
022394cf 147 } elsif ($^O eq 'linux' &&
65a03812 148 $Config{gccversion} ne '' &&
e9014798
SP
149 $Config{gccversion} !~ /intel/i
150 # might be using, say, Intel's icc
022394cf 151 ) {
9ae2e8df
P
152 # Some Linuxes have weird errno.hs which generate
153 # no #file or #line directives
a148bc21
DK
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;
db5fd395
CN
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
df00ff3b 162 } elsif ($^O eq 'beos' || $^O eq 'haiku') {
0d3cd356
JH
163 # hidden in a special place
164 $file{'/boot/develop/headers/posix/errno.h'} = 1;
165
196918b0
PG
166 } elsif ($^O eq 'vos') {
167 # avoid problem where cpp returns non-POSIX pathnames
168 $file{'/system/include_library/errno.h'} = 1;
27da23d5
JH
169 } elsif ($IsSymbian) {
170 my $SDK = $ENV{SDK};
171 $SDK =~ s!\\!/!g;
172 $file{"$SDK/epoc32/include/libc/sys/errno.h"} = 1;
eab60bb1
GS
173 } else {
174 open(CPPI,"> errno.c") or
175 die "Cannot open errno.c";
176
2986a63f 177 if ($^O eq 'NetWare') {
c623ac67 178 print CPPI "#include <nwerrno.h>\n";
2986a63f 179 } else {
c623ac67 180 print CPPI "#include <errno.h>\n";
27da23d5 181 if ($IsMSWin32) {
c623ac67
GS
182 print CPPI "#define _WINSOCKAPI_\n"; # don't drag in everything
183 print CPPI "#include <winsock.h>\n";
184 }
2986a63f 185 }
eab60bb1
GS
186
187 close(CPPI);
188
189 # invoke CPP and read the output
27da23d5 190 if ($IsMSWin32 || $^O eq 'NetWare') {
6ad8d9a8
GB
191 open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
192 die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
193 } else {
def887e8 194 my $cpp = default_cpp();
6ad8d9a8
GB
195 open(CPPO,"$cpp < errno.c |") or
196 die "Cannot exec $cpp";
197 }
eab60bb1
GS
198
199 my $pat;
27da23d5 200 if (($IsMSWin32 || $^O eq 'NetWare') and $Config{cc} =~ /^bcc/i) {
eab60bb1
GS
201 $pat = '^/\*\s+(.+)\s+\d+\s*:\s+\*/';
202 }
203 else {
d0d1d9b9 204 $pat = '^#\s*(?:line)?\s*\d+\s+"([^"]+)"';
eab60bb1
GS
205 }
206 while(<CPPO>) {
27da23d5 207 if ($^O eq 'os2' or $IsMSWin32 or $^O eq 'NetWare') {
0196e43b
IZ
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 }
eab60bb1
GS
217 }
218 close(CPPO);
219 }
220 return keys %file;
221}
222
223sub write_errno_pm {
224 my $err;
225
def887e8
JH
226 # quick sanity check
227
228 die "No error definitions found" unless keys %err;
229
eab60bb1
GS
230 # create the CPP input
231
232 open(CPPI,"> errno.c") or
233 die "Cannot open errno.c";
234
2986a63f 235 if ($^O eq 'NetWare') {
4d70086c
NIS
236 print CPPI "#include <nwerrno.h>\n";
237 }
238 else {
239 print CPPI "#include <errno.h>\n";
240 }
27da23d5 241 if ($IsMSWin32) {
4d70086c
NIS
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;
2986a63f 248 }
4d70086c
NIS
249 }
250
eab60bb1
GS
251 foreach $err (keys %err) {
252 print CPPI '"',$err,'" [[',$err,']]',"\n";
253 }
254
255 close(CPPI);
256
dbc1d986 257 unless ($^O eq 'MacOS' || $^O eq 'beos') { # trust what we have / get later
eab60bb1 258 # invoke CPP and read the output
dcbf900d 259
db5fd395
CN
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}";
27da23d5 265 } elsif ($IsMSWin32 || $^O eq 'NetWare') {
db5fd395
CN
266 open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
267 die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
27da23d5
JH
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 {
db5fd395
CN
273 my $cpp = default_cpp();
274 open(CPPO,"$cpp < errno.c |")
275 or die "Cannot exec $cpp";
276 }
eab60bb1 277
db5fd395 278 %err = ();
eab60bb1 279
db5fd395
CN
280 while(<CPPO>) {
281 my($name,$expr);
282 next unless ($name, $expr) = /"(.*?)"\s*\[\s*\[\s*(.*?)\s*\]\s*\]/;
283 next if $name eq $expr;
a633c72b 284 $expr =~ s/\(?\([a-z_]\w*\)([^\)]*)\)?/$1/i; # ((type)0xcafebabe) at alia
99228ec2
MB
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 {
db5fd395
CN
291 $err{$name} = eval $expr;
292 }
99228ec2
MB
293 delete $err{$name} unless defined $err{$name};
294 }
db5fd395 295 close(CPPO);
eab60bb1 296 }
eab60bb1 297
7bf567bf
JH
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
dbc1d986
IW
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.
7bf567bf
JH
304
305 if ($^O eq 'beos') {
306 if (open(C, ">errno.c")) {
dbc1d986 307 my @allerrs = keys %err;
7bf567bf
JH
308 print C <<EOF;
309#include <errno.h>
310#include <stdio.h>
311int main() {
312EOF
dbc1d986 313 for (@allerrs) {
7bf567bf
JH
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
eab60bb1
GS
334 # Write Errno.pm
335
336 print <<"EDQ";
337#
338# This file is auto-generated. ***ANY*** changes here will be lost
339#
340
341package Errno;
425a871f 342our (\@EXPORT_OK,\%EXPORT_TAGS,\@ISA,\$VERSION);
eab60bb1
GS
343use Exporter ();
344use Config;
345use strict;
346
8bc9d590
JH
347"\$Config{'archname'}-\$Config{'osvers'}" eq
348"$Config{'archname'}-$Config{'osvers'}" or
81be85b8 349 die "Errno architecture ($Config{'archname'}-$Config{'osvers'}) does not match executable architecture (\$Config{'archname'}-\$Config{'osvers'})";
eab60bb1
GS
350
351\$VERSION = "$VERSION";
105cd853 352\$VERSION = eval \$VERSION;
eab60bb1
GS
353\@ISA = qw(Exporter);
354
355EDQ
356
eab60bb1 357 my @err = sort { $err{$a} <=> $err{$b} } keys %err;
eab60bb1
GS
358
359 my $j = "\@EXPORT_OK = qw(" . join(" ",keys %err) . ");\n";
360 $j =~ s/(.{50,70})\s/$1\n\t/g;
361 print $j,"\n";
362
363print <<'ESQ';
364%EXPORT_TAGS = (
365 POSIX => [qw(
366ESQ
367
368 my $k = join(" ", grep { exists $err{$_} }
369 qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT
370 EAGAIN EALREADY EBADF EBUSY ECHILD ECONNABORTED
371 ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT
372 EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS
373 EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK
374 EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH
375 ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM
376 ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
377 ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM
378 EPFNOSUPPORT EPIPE EPROCLIM EPROTONOSUPPORT EPROTOTYPE
379 ERANGE EREMOTE ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT
380 ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS ETXTBSY
381 EUSERS EWOULDBLOCK EXDEV));
382
383 $k =~ s/(.{50,70})\s/$1\n\t/g;
384 print "\t",$k,"\n )]\n);\n\n";
385
386 foreach $err (@err) {
387 printf "sub %s () { %d }\n",,$err,$err{$err};
388 }
389
390 print <<'ESQ';
391
392sub TIEHASH { bless [] }
393
394sub FETCH {
395 my ($self, $errname) = @_;
396 my $proto = prototype("Errno::$errname");
68301627 397 my $errno = "";
eab60bb1
GS
398 if (defined($proto) && $proto eq "") {
399 no strict 'refs';
68301627
GS
400 $errno = &$errname;
401 $errno = 0 unless $! == $errno;
eab60bb1 402 }
68301627 403 return $errno;
93014de6 404}
eab60bb1
GS
405
406sub STORE {
407 require Carp;
408 Carp::confess("ERRNO hash is read only!");
409}
410
411*CLEAR = \&STORE;
412*DELETE = \&STORE;
413
414sub NEXTKEY {
415 my($k,$v);
416 while(($k,$v) = each %Errno::) {
417 my $proto = prototype("Errno::$k");
418 last if (defined($proto) && $proto eq "");
eab60bb1
GS
419 }
420 $k
421}
422
423sub FIRSTKEY {
68301627 424 my $s = scalar keys %Errno::; # initialize iterator
eab60bb1
GS
425 goto &NEXTKEY;
426}
427
428sub EXISTS {
429 my ($self, $errname) = @_;
f8ed3476
RGS
430 my $r = ref $errname;
431 my $proto = !$r || $r eq 'CODE' ? prototype($errname) : undef;
eab60bb1
GS
432 defined($proto) && $proto eq "";
433}
434
435tie %!, __PACKAGE__;
436
4371;
438__END__
439
440=head1 NAME
441
442Errno - System errno constants
443
444=head1 SYNOPSIS
445
446 use Errno qw(EINTR EIO :POSIX);
447
448=head1 DESCRIPTION
449
450C<Errno> defines and conditionally exports all the error constants
451defined in your system C<errno.h> include file. It has a single export
452tag, C<:POSIX>, which will export all POSIX defined error numbers.
453
93014de6 454C<Errno> also makes C<%!> magic such that each element of C<%!> has a
68301627 455non-zero value only if C<$!> is set to that value. For example:
eab60bb1
GS
456
457 use Errno;
3cb6de81 458
eab60bb1
GS
459 unless (open(FH, "/fangorn/spouse")) {
460 if ($!{ENOENT}) {
461 warn "Get a wife!\n";
462 } else {
463 warn "This path is barred: $!";
464 }
465 }
466
68301627
GS
467If a specified constant C<EFOO> does not exist on the system, C<$!{EFOO}>
468returns C<"">. You may use C<exists $!{EFOO}> to check whether the
93014de6
GS
469constant is available on the system.
470
68301627
GS
471=head1 CAVEATS
472
473Importing a particular constant may not be very portable, because the
474import will fail on platforms that do not have that constant. A more
475portable way to set C<$!> to a valid value is to use:
476
477 if (exists &Errno::EFOO) {
478 $! = &Errno::EFOO;
479 }
480
eab60bb1
GS
481=head1 AUTHOR
482
483Graham Barr <gbarr@pobox.com>
484
485=head1 COPYRIGHT
486
487Copyright (c) 1997-8 Graham Barr. All rights reserved.
488This program is free software; you can redistribute it and/or modify it
489under the same terms as Perl itself.
490
491=cut
492
493ESQ
494
495}