This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
bump Errno version number after change 34630 (add Haiku port)
[perl5.git] / ext / Errno / Errno_pm.PL
CommitLineData
eab60bb1
GS
1use ExtUtils::MakeMaker;
2use Config;
3use strict;
4
6bb0de4e 5our $VERSION = "1.10_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;
1e92bf58
SH
19my @files = get_files();
20if ($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) {
eeb7067f
YST
27 next if $file eq 'errno.c';
28 next unless -f $file;
1e92bf58
SH
29 print INCS qq[#include "$file"\n];
30 }
31 close INCS;
32 process_file('includes.c');
33 unlink 'includes.c';
34}
35else {
36 foreach $file (@files) {
37 process_file($file);
38 }
eab60bb1
GS
39}
40write_errno_pm();
41unlink "errno.c" if -f "errno.c";
42
43sub process_file {
44 my($file) = @_;
45
22402b47
YST
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
6683669a 52 return unless defined $file and -f $file;
27da23d5 53# warn "Processing $file\n";
eab60bb1
GS
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 }
7237d657 61 } elsif ($Config{gccversion} ne ''
8ff7320b
JH
62 # OpenSTEP has gcc 2.7.2.1 which recognizes but
63 # doesn't implement the -dM flag.
8f4f83ba 64 && $^O ne 'openstep' && $^O ne 'next' && $^O ne 'darwin'
8ff7320b 65 ) {
9ae2e8df 66 # With the -dM option, gcc outputs every #define it finds
ee1e7ac2 67 unless(open(FH,"$Config{cc} -E -dM $Config{cppflags} $file |")) {
9ae2e8df
P
68 warn "Cannot open '$file'";
69 return;
70 }
eab60bb1
GS
71 } else {
72 unless(open(FH,"< $file")) {
def887e8 73 # This file could be a temporary file created by cppstdin
6ad8d9a8
GB
74 # so only warn under -w, and return
75 warn "Cannot open '$file'" if $^W;
eab60bb1
GS
76 return;
77 }
78 }
27da23d5 79
db5fd395
CN
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+/;
27da23d5 89 if ($IsMSWin32) {
4d70086c
NIS
90 $wsa{$1} = 1
91 if /^\s*#\s*define\s+WSA(E\w+)\s+/;
92 }
db5fd395
CN
93 }
94 }
27da23d5 95
db5fd395 96 close(FH);
eab60bb1
GS
97}
98
def887e8
JH
99my $cppstdin;
100
101sub 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
eab60bb1
GS
117sub 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 }
9d116dd7
JH
128 } elsif ($^O eq 'os390') {
129 # OS/390 C compiler doesn't generate #file or #line directives
130 $file{'/usr/include/errno.h'} = 1;
092bebab
JH
131 } elsif ($^O eq 'vmesa') {
132 # OS/390 C compiler doesn't generate #file or #line directives
133 $file{'../../vmesa/errno.h'} = 1;
a367e475
OF
134 } elsif ($Config{archname} eq 'epoc') {
135 # Watch out for cross compiling for EPOC (usually done on linux)
02a99678 136 $file{'/usr/local/epocemx/epocsdk/include/libc/sys/errno.h'} = 1;
7ee146b1
AW
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 }
022394cf 143 } elsif ($^O eq 'linux' &&
65a03812 144 $Config{gccversion} ne '' &&
e9014798
SP
145 $Config{gccversion} !~ /intel/i
146 # might be using, say, Intel's icc
022394cf 147 ) {
9ae2e8df
P
148 # Some Linuxes have weird errno.hs which generate
149 # no #file or #line directives
a148bc21
DK
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;
db5fd395
CN
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
df00ff3b 158 } elsif ($^O eq 'beos' || $^O eq 'haiku') {
0d3cd356
JH
159 # hidden in a special place
160 $file{'/boot/develop/headers/posix/errno.h'} = 1;
161
196918b0
PG
162 } elsif ($^O eq 'vos') {
163 # avoid problem where cpp returns non-POSIX pathnames
164 $file{'/system/include_library/errno.h'} = 1;
27da23d5
JH
165 } elsif ($IsSymbian) {
166 my $SDK = $ENV{SDK};
167 $SDK =~ s!\\!/!g;
168 $file{"$SDK/epoc32/include/libc/sys/errno.h"} = 1;
eab60bb1
GS
169 } else {
170 open(CPPI,"> errno.c") or
171 die "Cannot open errno.c";
172
2986a63f 173 if ($^O eq 'NetWare') {
c623ac67 174 print CPPI "#include <nwerrno.h>\n";
2986a63f 175 } else {
c623ac67 176 print CPPI "#include <errno.h>\n";
27da23d5 177 if ($IsMSWin32) {
c623ac67
GS
178 print CPPI "#define _WINSOCKAPI_\n"; # don't drag in everything
179 print CPPI "#include <winsock.h>\n";
180 }
2986a63f 181 }
eab60bb1
GS
182
183 close(CPPI);
184
185 # invoke CPP and read the output
27da23d5 186 if ($IsMSWin32 || $^O eq 'NetWare') {
6ad8d9a8
GB
187 open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
188 die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
189 } else {
def887e8 190 my $cpp = default_cpp();
6ad8d9a8
GB
191 open(CPPO,"$cpp < errno.c |") or
192 die "Cannot exec $cpp";
193 }
eab60bb1
GS
194
195 my $pat;
27da23d5 196 if (($IsMSWin32 || $^O eq 'NetWare') and $Config{cc} =~ /^bcc/i) {
eab60bb1
GS
197 $pat = '^/\*\s+(.+)\s+\d+\s*:\s+\*/';
198 }
199 else {
d0d1d9b9 200 $pat = '^#\s*(?:line)?\s*\d+\s+"([^"]+)"';
eab60bb1
GS
201 }
202 while(<CPPO>) {
27da23d5 203 if ($^O eq 'os2' or $IsMSWin32 or $^O eq 'NetWare') {
0196e43b
IZ
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 }
eab60bb1
GS
213 }
214 close(CPPO);
215 }
216 return keys %file;
217}
218
219sub write_errno_pm {
220 my $err;
221
def887e8
JH
222 # quick sanity check
223
224 die "No error definitions found" unless keys %err;
225
eab60bb1
GS
226 # create the CPP input
227
228 open(CPPI,"> errno.c") or
229 die "Cannot open errno.c";
230
2986a63f 231 if ($^O eq 'NetWare') {
4d70086c
NIS
232 print CPPI "#include <nwerrno.h>\n";
233 }
234 else {
235 print CPPI "#include <errno.h>\n";
236 }
27da23d5 237 if ($IsMSWin32) {
4d70086c
NIS
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;
2986a63f 244 }
4d70086c
NIS
245 }
246
eab60bb1
GS
247 foreach $err (keys %err) {
248 print CPPI '"',$err,'" [[',$err,']]',"\n";
249 }
250
251 close(CPPI);
252
dbc1d986 253 unless ($^O eq 'MacOS' || $^O eq 'beos') { # trust what we have / get later
eab60bb1 254 # invoke CPP and read the output
dcbf900d 255
db5fd395
CN
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}";
27da23d5 261 } elsif ($IsMSWin32 || $^O eq 'NetWare') {
db5fd395
CN
262 open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
263 die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
27da23d5
JH
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 {
db5fd395
CN
269 my $cpp = default_cpp();
270 open(CPPO,"$cpp < errno.c |")
271 or die "Cannot exec $cpp";
272 }
eab60bb1 273
db5fd395 274 %err = ();
eab60bb1 275
db5fd395
CN
276 while(<CPPO>) {
277 my($name,$expr);
278 next unless ($name, $expr) = /"(.*?)"\s*\[\s*\[\s*(.*?)\s*\]\s*\]/;
279 next if $name eq $expr;
a633c72b 280 $expr =~ s/\(?\([a-z_]\w*\)([^\)]*)\)?/$1/i; # ((type)0xcafebabe) at alia
99228ec2
MB
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 {
db5fd395
CN
287 $err{$name} = eval $expr;
288 }
99228ec2
MB
289 delete $err{$name} unless defined $err{$name};
290 }
db5fd395 291 close(CPPO);
eab60bb1 292 }
eab60bb1 293
7bf567bf
JH
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
dbc1d986
IW
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.
7bf567bf
JH
300
301 if ($^O eq 'beos') {
302 if (open(C, ">errno.c")) {
dbc1d986 303 my @allerrs = keys %err;
7bf567bf
JH
304 print C <<EOF;
305#include <errno.h>
306#include <stdio.h>
307int main() {
308EOF
dbc1d986 309 for (@allerrs) {
7bf567bf
JH
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
eab60bb1
GS
330 # Write Errno.pm
331
332 print <<"EDQ";
333#
334# This file is auto-generated. ***ANY*** changes here will be lost
335#
336
337package Errno;
f168a5e7 338our (\@EXPORT_OK,\%EXPORT_TAGS,\@ISA,\$VERSION,\%errno,\$AUTOLOAD);
eab60bb1
GS
339use Exporter ();
340use Config;
341use strict;
342
8bc9d590
JH
343"\$Config{'archname'}-\$Config{'osvers'}" eq
344"$Config{'archname'}-$Config{'osvers'}" or
81be85b8 345 die "Errno architecture ($Config{'archname'}-$Config{'osvers'}) does not match executable architecture (\$Config{'archname'}-\$Config{'osvers'})";
eab60bb1
GS
346
347\$VERSION = "$VERSION";
105cd853 348\$VERSION = eval \$VERSION;
eab60bb1
GS
349\@ISA = qw(Exporter);
350
351EDQ
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
361print <<'ESQ';
362%EXPORT_TAGS = (
363 POSIX => [qw(
364ESQ
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
390sub TIEHASH { bless [] }
391
392sub FETCH {
393 my ($self, $errname) = @_;
394 my $proto = prototype("Errno::$errname");
68301627 395 my $errno = "";
eab60bb1
GS
396 if (defined($proto) && $proto eq "") {
397 no strict 'refs';
68301627
GS
398 $errno = &$errname;
399 $errno = 0 unless $! == $errno;
eab60bb1 400 }
68301627 401 return $errno;
93014de6 402}
eab60bb1
GS
403
404sub STORE {
405 require Carp;
406 Carp::confess("ERRNO hash is read only!");
407}
408
409*CLEAR = \&STORE;
410*DELETE = \&STORE;
411
412sub NEXTKEY {
413 my($k,$v);
414 while(($k,$v) = each %Errno::) {
415 my $proto = prototype("Errno::$k");
416 last if (defined($proto) && $proto eq "");
eab60bb1
GS
417 }
418 $k
419}
420
421sub FIRSTKEY {
68301627 422 my $s = scalar keys %Errno::; # initialize iterator
eab60bb1
GS
423 goto &NEXTKEY;
424}
425
426sub EXISTS {
427 my ($self, $errname) = @_;
f8ed3476
RGS
428 my $r = ref $errname;
429 my $proto = !$r || $r eq 'CODE' ? prototype($errname) : undef;
eab60bb1
GS
430 defined($proto) && $proto eq "";
431}
432
433tie %!, __PACKAGE__;
434
4351;
436__END__
437
438=head1 NAME
439
440Errno - System errno constants
441
442=head1 SYNOPSIS
443
444 use Errno qw(EINTR EIO :POSIX);
445
446=head1 DESCRIPTION
447
448C<Errno> defines and conditionally exports all the error constants
449defined in your system C<errno.h> include file. It has a single export
450tag, C<:POSIX>, which will export all POSIX defined error numbers.
451
93014de6 452C<Errno> also makes C<%!> magic such that each element of C<%!> has a
68301627 453non-zero value only if C<$!> is set to that value. For example:
eab60bb1
GS
454
455 use Errno;
3cb6de81 456
eab60bb1
GS
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
68301627
GS
465If a specified constant C<EFOO> does not exist on the system, C<$!{EFOO}>
466returns C<"">. You may use C<exists $!{EFOO}> to check whether the
93014de6
GS
467constant is available on the system.
468
68301627
GS
469=head1 CAVEATS
470
471Importing a particular constant may not be very portable, because the
472import will fail on platforms that do not have that constant. A more
473portable way to set C<$!> to a valid value is to use:
474
475 if (exists &Errno::EFOO) {
476 $! = &Errno::EFOO;
477 }
478
eab60bb1
GS
479=head1 AUTHOR
480
481Graham Barr <gbarr@pobox.com>
482
483=head1 COPYRIGHT
484
485Copyright (c) 1997-8 Graham Barr. All rights reserved.
486This program is free software; you can redistribute it and/or modify it
487under the same terms as Perl itself.
488
489=cut
490
491ESQ
492
493}