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