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