This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Generate Errno and Pod::Functions with deterministic order.
[perl5.git] / ext / Errno / Errno_pm.PL
CommitLineData
eab60bb1
GS
1use ExtUtils::MakeMaker;
2use Config;
3use strict;
4
be544edc 5our $VERSION = "1.19";
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
1b9043bb
NC
84 while(<FH>) {
85 $err{$1} = 1
86 if /^\s*#\s*define\s+(E\w+)\s+/;
87 if ($IsMSWin32) {
88 $wsa{$1} = 1
89 if /^\s*#\s*define\s+WSA(E\w+)\s+/;
db5fd395
CN
90 }
91 }
27da23d5 92
db5fd395 93 close(FH);
eab60bb1
GS
94}
95
def887e8
JH
96my $cppstdin;
97
98sub default_cpp {
99 unless (defined $cppstdin) {
100 use File::Spec;
101 $cppstdin = $Config{cppstdin};
102 my $upup_cppstdin = File::Spec->catfile(File::Spec->updir,
103 File::Spec->updir,
104 "cppstdin");
105 my $cppstdin_is_wrapper =
106 ($cppstdin eq 'cppstdin'
107 and -f $upup_cppstdin
108 and -x $upup_cppstdin);
109 $cppstdin = $upup_cppstdin if $cppstdin_is_wrapper;
110 }
111 return "$cppstdin $Config{cppflags} $Config{cppminus}";
112}
113
eab60bb1
GS
114sub get_files {
115 my %file = ();
116 # VMS keeps its include files in system libraries (well, except for Gcc)
117 if ($^O eq 'VMS') {
118 if ($Config{vms_cc_type} eq 'decc') {
119 $file{'Sys$Library:DECC$RTLDEF.TLB'} = 1;
120 } elsif ($Config{vms_cc_type} eq 'vaxc') {
121 $file{'Sys$Library:vaxcdef.tlb'} = 1;
122 } elsif ($Config{vms_cc_type} eq 'gcc') {
123 $file{'gnu_cc_include:[000000]errno.h'} = 1;
124 }
9d116dd7
JH
125 } elsif ($^O eq 'os390') {
126 # OS/390 C compiler doesn't generate #file or #line directives
127 $file{'/usr/include/errno.h'} = 1;
7ee146b1
AW
128 } elsif ($Config{archname} eq 'arm-riscos') {
129 # Watch out for cross compiling for RISC OS
130 my $dep = `echo "#include <errno.h>" | gcc -E -M -`;
131 if ($dep =~ /(\S+errno\.h)/) {
132 $file{$1} = 1;
133 }
022394cf 134 } elsif ($^O eq 'linux' &&
65a03812 135 $Config{gccversion} ne '' &&
e9014798
SP
136 $Config{gccversion} !~ /intel/i
137 # might be using, say, Intel's icc
022394cf 138 ) {
9ae2e8df
P
139 # Some Linuxes have weird errno.hs which generate
140 # no #file or #line directives
a148bc21
DK
141 my $linux_errno_h = -e '/usr/include/errno.h' ?
142 '/usr/include/errno.h' : '/usr/local/include/errno.h';
143 $file{$linux_errno_h} = 1;
b6c36746 144 } elsif ($^O eq 'haiku') {
0d3cd356
JH
145 # hidden in a special place
146 $file{'/boot/develop/headers/posix/errno.h'} = 1;
147
196918b0
PG
148 } elsif ($^O eq 'vos') {
149 # avoid problem where cpp returns non-POSIX pathnames
150 $file{'/system/include_library/errno.h'} = 1;
27da23d5
JH
151 } elsif ($IsSymbian) {
152 my $SDK = $ENV{SDK};
153 $SDK =~ s!\\!/!g;
154 $file{"$SDK/epoc32/include/libc/sys/errno.h"} = 1;
eab60bb1
GS
155 } else {
156 open(CPPI,"> errno.c") or
157 die "Cannot open errno.c";
158
2986a63f 159 if ($^O eq 'NetWare') {
c623ac67 160 print CPPI "#include <nwerrno.h>\n";
2986a63f 161 } else {
c623ac67 162 print CPPI "#include <errno.h>\n";
27da23d5 163 if ($IsMSWin32) {
c623ac67
GS
164 print CPPI "#define _WINSOCKAPI_\n"; # don't drag in everything
165 print CPPI "#include <winsock.h>\n";
166 }
2986a63f 167 }
eab60bb1
GS
168
169 close(CPPI);
170
171 # invoke CPP and read the output
27da23d5 172 if ($IsMSWin32 || $^O eq 'NetWare') {
6ad8d9a8
GB
173 open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
174 die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
175 } else {
def887e8 176 my $cpp = default_cpp();
6ad8d9a8
GB
177 open(CPPO,"$cpp < errno.c |") or
178 die "Cannot exec $cpp";
179 }
eab60bb1 180
378eeda7 181 my $pat = '^#\s*(?:line)?\s*\d+\s+"([^"]+)"';
eab60bb1 182 while(<CPPO>) {
27da23d5 183 if ($^O eq 'os2' or $IsMSWin32 or $^O eq 'NetWare') {
0196e43b
IZ
184 if (/$pat/o) {
185 my $f = $1;
186 $f =~ s,\\\\,/,g;
187 $file{$f} = 1;
188 }
189 }
190 else {
191 $file{$1} = 1 if /$pat/o;
192 }
eab60bb1
GS
193 }
194 close(CPPO);
195 }
196 return keys %file;
197}
198
199sub write_errno_pm {
200 my $err;
201
def887e8
JH
202 # quick sanity check
203
204 die "No error definitions found" unless keys %err;
205
eab60bb1
GS
206 # create the CPP input
207
208 open(CPPI,"> errno.c") or
209 die "Cannot open errno.c";
210
2986a63f 211 if ($^O eq 'NetWare') {
4d70086c
NIS
212 print CPPI "#include <nwerrno.h>\n";
213 }
214 else {
215 print CPPI "#include <errno.h>\n";
216 }
27da23d5 217 if ($IsMSWin32) {
4d70086c
NIS
218 print CPPI "#include <winsock.h>\n";
219 foreach $err (keys %wsa) {
b59e75b3
SH
220 print CPPI "#if defined($err) && $err >= 100\n";
221 print CPPI "#undef $err\n";
222 print CPPI "#endif\n";
4d70086c
NIS
223 print CPPI "#ifndef $err\n";
224 print CPPI "#define $err WSA$err\n";
225 print CPPI "#endif\n";
226 $err{$err} = 1;
2986a63f 227 }
4d70086c
NIS
228 }
229
eab60bb1
GS
230 foreach $err (keys %err) {
231 print CPPI '"',$err,'" [[',$err,']]',"\n";
232 }
233
234 close(CPPI);
235
b6c36746 236 { # BeOS (support now removed) did not enter this block
eab60bb1 237 # invoke CPP and read the output
dcbf900d 238
db5fd395
CN
239 if ($^O eq 'VMS') {
240 my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}";
241 $cpp =~ s/sys\$input//i;
242 open(CPPO,"$cpp errno.c |") or
243 die "Cannot exec $Config{cppstdin}";
27da23d5 244 } elsif ($IsMSWin32 || $^O eq 'NetWare') {
db5fd395
CN
245 open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
246 die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
27da23d5
JH
247 } elsif ($IsSymbian) {
248 my $cpp = "gcc -E -I$ENV{SDK}\\epoc32\\include\\libc -";
249 open(CPPO,"$cpp < errno.c |")
250 or die "Cannot exec $cpp";
251 } else {
db5fd395
CN
252 my $cpp = default_cpp();
253 open(CPPO,"$cpp < errno.c |")
254 or die "Cannot exec $cpp";
255 }
eab60bb1 256
db5fd395 257 %err = ();
eab60bb1 258
db5fd395
CN
259 while(<CPPO>) {
260 my($name,$expr);
261 next unless ($name, $expr) = /"(.*?)"\s*\[\s*\[\s*(.*?)\s*\]\s*\]/;
262 next if $name eq $expr;
a633c72b 263 $expr =~ s/\(?\([a-z_]\w*\)([^\)]*)\)?/$1/i; # ((type)0xcafebabe) at alia
99228ec2
MB
264 $expr =~ s/((?:0x)?[0-9a-fA-F]+)[LU]+\b/$1/g; # 2147483647L et alia
265 next if $expr =~ m/^[a-zA-Z]+$/; # skip some Win32 functions
266 if($expr =~ m/^0[xX]/) {
267 $err{$name} = hex $expr;
268 }
269 else {
db5fd395
CN
270 $err{$name} = eval $expr;
271 }
99228ec2
MB
272 delete $err{$name} unless defined $err{$name};
273 }
db5fd395 274 close(CPPO);
eab60bb1 275 }
eab60bb1 276
928b2f01
RU
277 # escape $Config{'archname'}
278 my $archname = $Config{'archname'};
279 $archname =~ s/([@%\$])/\\\1/g;
280
eab60bb1
GS
281 # Write Errno.pm
282
283 print <<"EDQ";
8f8c2a44 284# -*- buffer-read-only: t -*-
eab60bb1
GS
285#
286# This file is auto-generated. ***ANY*** changes here will be lost
287#
288
289package Errno;
8f8c2a44 290require Exporter;
eab60bb1
GS
291use Config;
292use strict;
293
8bc9d590 294"\$Config{'archname'}-\$Config{'osvers'}" eq
928b2f01
RU
295"$archname-$Config{'osvers'}" or
296 die "Errno architecture ($archname-$Config{'osvers'}) does not match executable architecture (\$Config{'archname'}-\$Config{'osvers'})";
eab60bb1 297
8f8c2a44 298our \$VERSION = "$VERSION";
105cd853 299\$VERSION = eval \$VERSION;
8f8c2a44 300our \@ISA = 'Exporter';
eab60bb1 301
42607a60
NC
302my %err;
303
304BEGIN {
305 %err = (
eab60bb1 306EDQ
be54382c 307
be544edc 308 my @err = sort { $err{$a} <=> $err{$b} || $a cmp $b }
be54382c 309 grep { $err{$_} =~ /-?\d+$/ } keys %err;
eab60bb1 310
42607a60
NC
311 foreach $err (@err) {
312 print "\t$err => $err{$err},\n";
313 }
eab60bb1
GS
314
315print <<'ESQ';
42607a60
NC
316 );
317 # Generate proxy constant subroutines for all the values.
5d8ab953
NC
318 # Well, almost all the values. Unfortunately we can't assume that at this
319 # point that our symbol table is empty, as code such as if the parser has
320 # seen code such as C<exists &Errno::EINVAL>, it will have created the
321 # typeglob.
42607a60
NC
322 # Doing this before defining @EXPORT_OK etc means that even if a platform is
323 # crazy enough to define EXPORT_OK as an error constant, everything will
324 # still work, because the parser will upgrade the PCS to a real typeglob.
325 # We rely on the subroutine definitions below to update the internal caches.
326 # Don't use %each, as we don't want a copy of the value.
327 foreach my $name (keys %err) {
5d8ab953
NC
328 if ($Errno::{$name}) {
329 # We expect this to be reached fairly rarely, so take an approach
330 # which uses the least compile time effort in the common case:
331 eval "sub $name() { $err{$name} }; 1" or die $@;
332 } else {
333 $Errno::{$name} = \$err{$name};
334 }
42607a60
NC
335 }
336}
337
8f8c2a44 338our @EXPORT_OK = keys %err;
42607a60 339
8f8c2a44 340our %EXPORT_TAGS = (
eab60bb1
GS
341 POSIX => [qw(
342ESQ
343
344 my $k = join(" ", grep { exists $err{$_} }
345 qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT
346 EAGAIN EALREADY EBADF EBUSY ECHILD ECONNABORTED
347 ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT
348 EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS
349 EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK
350 EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH
351 ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM
352 ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
353 ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM
354 EPFNOSUPPORT EPIPE EPROCLIM EPROTONOSUPPORT EPROTOTYPE
355 ERANGE EREMOTE ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT
356 ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS ETXTBSY
357 EUSERS EWOULDBLOCK EXDEV));
358
359 $k =~ s/(.{50,70})\s/$1\n\t/g;
360 print "\t",$k,"\n )]\n);\n\n";
361
eab60bb1 362 print <<'ESQ';
42607a60 363sub TIEHASH { bless \%err }
eab60bb1
GS
364
365sub FETCH {
42607a60
NC
366 my (undef, $errname) = @_;
367 return "" unless exists $err{$errname};
368 my $errno = $err{$errname};
369 return $errno == $! ? $errno : 0;
93014de6 370}
eab60bb1
GS
371
372sub STORE {
373 require Carp;
374 Carp::confess("ERRNO hash is read only!");
375}
376
56d853d6 377*CLEAR = *DELETE = \*STORE; # Typeglob aliasing uses less space
eab60bb1
GS
378
379sub NEXTKEY {
42607a60 380 each %err;
eab60bb1
GS
381}
382
383sub FIRSTKEY {
42607a60
NC
384 my $s = scalar keys %err; # initialize iterator
385 each %err;
eab60bb1
GS
386}
387
388sub EXISTS {
42607a60
NC
389 my (undef, $errname) = @_;
390 exists $err{$errname};
eab60bb1
GS
391}
392
42607a60 393tie %!, __PACKAGE__; # Returns an object, objects are true.
eab60bb1 394
eab60bb1
GS
395__END__
396
397=head1 NAME
398
399Errno - System errno constants
400
401=head1 SYNOPSIS
402
403 use Errno qw(EINTR EIO :POSIX);
404
405=head1 DESCRIPTION
406
407C<Errno> defines and conditionally exports all the error constants
408defined in your system C<errno.h> include file. It has a single export
409tag, C<:POSIX>, which will export all POSIX defined error numbers.
410
93014de6 411C<Errno> also makes C<%!> magic such that each element of C<%!> has a
68301627 412non-zero value only if C<$!> is set to that value. For example:
eab60bb1
GS
413
414 use Errno;
3cb6de81 415
eab60bb1
GS
416 unless (open(FH, "/fangorn/spouse")) {
417 if ($!{ENOENT}) {
418 warn "Get a wife!\n";
419 } else {
420 warn "This path is barred: $!";
421 }
422 }
423
68301627
GS
424If a specified constant C<EFOO> does not exist on the system, C<$!{EFOO}>
425returns C<"">. You may use C<exists $!{EFOO}> to check whether the
93014de6
GS
426constant is available on the system.
427
68301627
GS
428=head1 CAVEATS
429
430Importing a particular constant may not be very portable, because the
431import will fail on platforms that do not have that constant. A more
432portable way to set C<$!> to a valid value is to use:
433
434 if (exists &Errno::EFOO) {
435 $! = &Errno::EFOO;
436 }
437
eab60bb1
GS
438=head1 AUTHOR
439
440Graham Barr <gbarr@pobox.com>
441
442=head1 COPYRIGHT
443
444Copyright (c) 1997-8 Graham Barr. All rights reserved.
445This program is free software; you can redistribute it and/or modify it
446under the same terms as Perl itself.
447
448=cut
449
8f8c2a44 450# ex: set ro:
eab60bb1
GS
451ESQ
452
453}