This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
First steps of making builds outside the source
[perl5.git] / ext / Errno / Errno_pm.PL
CommitLineData
eab60bb1
GS
1use ExtUtils::MakeMaker;
2use Config;
3use strict;
4
5use vars qw($VERSION);
6
6ad8d9a8 7$VERSION = "1.111";
eab60bb1
GS
8
9my %err = ();
10
11unlink "Errno.pm" if -f "Errno.pm";
12open OUT, ">Errno.pm" or die "Cannot open Errno.pm: $!";
13select OUT;
14my $file;
15foreach $file (get_files()) {
16 process_file($file);
17}
18write_errno_pm();
19unlink "errno.c" if -f "errno.c";
20
21sub process_file {
22 my($file) = @_;
23
24 return unless defined $file;
25
26 local *FH;
27 if (($^O eq 'VMS') && ($Config{vms_cc_type} ne 'gnuc')) {
28 unless(open(FH," LIBRARY/EXTRACT=ERRNO/OUTPUT=SYS\$OUTPUT $file |")) {
29 warn "Cannot open '$file'";
30 return;
31 }
32 } else {
33 unless(open(FH,"< $file")) {
def887e8 34 # This file could be a temporary file created by cppstdin
6ad8d9a8
GB
35 # so only warn under -w, and return
36 warn "Cannot open '$file'" if $^W;
eab60bb1
GS
37 return;
38 }
39 }
40 while(<FH>) {
41 $err{$1} = 1
dcbf900d 42 if /^\s*#\s*define\s+(E\w+)\s+/;
eab60bb1
GS
43 }
44 close(FH);
45}
46
def887e8
JH
47my $cppstdin;
48
49sub default_cpp {
50 unless (defined $cppstdin) {
51 use File::Spec;
52 $cppstdin = $Config{cppstdin};
53 my $upup_cppstdin = File::Spec->catfile(File::Spec->updir,
54 File::Spec->updir,
55 "cppstdin");
56 my $cppstdin_is_wrapper =
57 ($cppstdin eq 'cppstdin'
58 and -f $upup_cppstdin
59 and -x $upup_cppstdin);
60 $cppstdin = $upup_cppstdin if $cppstdin_is_wrapper;
61 }
62 return "$cppstdin $Config{cppflags} $Config{cppminus}";
63}
64
eab60bb1
GS
65sub get_files {
66 my %file = ();
67 # VMS keeps its include files in system libraries (well, except for Gcc)
68 if ($^O eq 'VMS') {
69 if ($Config{vms_cc_type} eq 'decc') {
70 $file{'Sys$Library:DECC$RTLDEF.TLB'} = 1;
71 } elsif ($Config{vms_cc_type} eq 'vaxc') {
72 $file{'Sys$Library:vaxcdef.tlb'} = 1;
73 } elsif ($Config{vms_cc_type} eq 'gcc') {
74 $file{'gnu_cc_include:[000000]errno.h'} = 1;
75 }
9d116dd7
JH
76 } elsif ($^O eq 'os390') {
77 # OS/390 C compiler doesn't generate #file or #line directives
78 $file{'/usr/include/errno.h'} = 1;
092bebab
JH
79 } elsif ($^O eq 'vmesa') {
80 # OS/390 C compiler doesn't generate #file or #line directives
81 $file{'../../vmesa/errno.h'} = 1;
eab60bb1
GS
82 } else {
83 open(CPPI,"> errno.c") or
84 die "Cannot open errno.c";
85
86 print CPPI "#include <errno.h>\n";
87
88 close(CPPI);
89
90 # invoke CPP and read the output
6ad8d9a8
GB
91 if ($^O eq 'MSWin32') {
92 open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
93 die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
94 } else {
def887e8 95 my $cpp = default_cpp();
6ad8d9a8
GB
96 open(CPPO,"$cpp < errno.c |") or
97 die "Cannot exec $cpp";
98 }
eab60bb1
GS
99
100 my $pat;
101 if ($^O eq 'MSWin32' and $Config{cc} =~ /^bcc/i) {
102 $pat = '^/\*\s+(.+)\s+\d+\s*:\s+\*/';
103 }
104 else {
76287dce 105 $pat = '^#(?:line)?\s*\d+\s+"([^"]+)"';
eab60bb1
GS
106 }
107 while(<CPPO>) {
2449e420 108 if ($^O eq 'os2' or $^O eq 'MSWin32') {
0196e43b
IZ
109 if (/$pat/o) {
110 my $f = $1;
111 $f =~ s,\\\\,/,g;
112 $file{$f} = 1;
113 }
114 }
115 else {
116 $file{$1} = 1 if /$pat/o;
117 }
eab60bb1
GS
118 }
119 close(CPPO);
120 }
121 return keys %file;
122}
123
124sub write_errno_pm {
125 my $err;
126
def887e8
JH
127 # quick sanity check
128
129 die "No error definitions found" unless keys %err;
130
eab60bb1
GS
131 # create the CPP input
132
133 open(CPPI,"> errno.c") or
134 die "Cannot open errno.c";
135
136 print CPPI "#include <errno.h>\n";
137
138 foreach $err (keys %err) {
139 print CPPI '"',$err,'" [[',$err,']]',"\n";
140 }
141
142 close(CPPI);
143
144 # invoke CPP and read the output
dcbf900d 145
eab60bb1
GS
146 if ($^O eq 'VMS') {
147 my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}";
148 $cpp =~ s/sys\$input//i;
149 open(CPPO,"$cpp errno.c |") or
150 die "Cannot exec $Config{cppstdin}";
6ad8d9a8
GB
151 } elsif ($^O eq 'MSWin32') {
152 open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
153 die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
154 } else {
def887e8 155 my $cpp = default_cpp();
dcbf900d
GS
156 open(CPPO,"$cpp < errno.c |")
157 or die "Cannot exec $cpp";
eab60bb1
GS
158 }
159
160 %err = ();
161
162 while(<CPPO>) {
163 my($name,$expr);
164 next unless ($name, $expr) = /"(.*?)"\s*\[\s*\[\s*(.*?)\s*\]\s*\]/;
165 next if $name eq $expr;
166 $err{$name} = eval $expr;
167 }
168 close(CPPO);
169
170 # Write Errno.pm
171
172 print <<"EDQ";
173#
174# This file is auto-generated. ***ANY*** changes here will be lost
175#
176
177package Errno;
178use vars qw(\@EXPORT_OK \%EXPORT_TAGS \@ISA \$VERSION \%errno \$AUTOLOAD);
179use Exporter ();
180use Config;
181use strict;
182
183\$Config{'myarchname'} eq "$Config{'myarchname'}" or
184 die "Errno architecture ($Config{'myarchname'}) does not match executable architecture (\$Config{'myarchname'})";
185
186\$VERSION = "$VERSION";
187\@ISA = qw(Exporter);
188
189EDQ
190
191 my $len = 0;
192 my @err = sort { $err{$a} <=> $err{$b} } keys %err;
193 map { $len = length if length > $len } @err;
194
195 my $j = "\@EXPORT_OK = qw(" . join(" ",keys %err) . ");\n";
196 $j =~ s/(.{50,70})\s/$1\n\t/g;
197 print $j,"\n";
198
199print <<'ESQ';
200%EXPORT_TAGS = (
201 POSIX => [qw(
202ESQ
203
204 my $k = join(" ", grep { exists $err{$_} }
205 qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT
206 EAGAIN EALREADY EBADF EBUSY ECHILD ECONNABORTED
207 ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT
208 EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS
209 EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK
210 EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH
211 ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM
212 ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
213 ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM
214 EPFNOSUPPORT EPIPE EPROCLIM EPROTONOSUPPORT EPROTOTYPE
215 ERANGE EREMOTE ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT
216 ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS ETXTBSY
217 EUSERS EWOULDBLOCK EXDEV));
218
219 $k =~ s/(.{50,70})\s/$1\n\t/g;
220 print "\t",$k,"\n )]\n);\n\n";
221
222 foreach $err (@err) {
223 printf "sub %s () { %d }\n",,$err,$err{$err};
224 }
225
226 print <<'ESQ';
227
228sub TIEHASH { bless [] }
229
230sub FETCH {
231 my ($self, $errname) = @_;
232 my $proto = prototype("Errno::$errname");
233 if (defined($proto) && $proto eq "") {
234 no strict 'refs';
235 return $! == &$errname;
236 }
237 require Carp;
238 Carp::confess("No errno $errname");
239}
240
241sub STORE {
242 require Carp;
243 Carp::confess("ERRNO hash is read only!");
244}
245
246*CLEAR = \&STORE;
247*DELETE = \&STORE;
248
249sub NEXTKEY {
250 my($k,$v);
251 while(($k,$v) = each %Errno::) {
252 my $proto = prototype("Errno::$k");
253 last if (defined($proto) && $proto eq "");
254
255 }
256 $k
257}
258
259sub FIRSTKEY {
260 my $s = scalar keys %Errno::;
261 goto &NEXTKEY;
262}
263
264sub EXISTS {
265 my ($self, $errname) = @_;
266 my $proto = prototype($errname);
267 defined($proto) && $proto eq "";
268}
269
270tie %!, __PACKAGE__;
271
2721;
273__END__
274
275=head1 NAME
276
277Errno - System errno constants
278
279=head1 SYNOPSIS
280
281 use Errno qw(EINTR EIO :POSIX);
282
283=head1 DESCRIPTION
284
285C<Errno> defines and conditionally exports all the error constants
286defined in your system C<errno.h> include file. It has a single export
287tag, C<:POSIX>, which will export all POSIX defined error numbers.
288
289C<Errno> also makes C<%!> magic such that each element of C<%!> has a non-zero
290value only if C<$!> is set to that value, eg
291
292 use Errno;
293
294 unless (open(FH, "/fangorn/spouse")) {
295 if ($!{ENOENT}) {
296 warn "Get a wife!\n";
297 } else {
298 warn "This path is barred: $!";
299 }
300 }
301
302=head1 AUTHOR
303
304Graham Barr <gbarr@pobox.com>
305
306=head1 COPYRIGHT
307
308Copyright (c) 1997-8 Graham Barr. All rights reserved.
309This program is free software; you can redistribute it and/or modify it
310under the same terms as Perl itself.
311
312=cut
313
314ESQ
315
316}