This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Skip processing a file if the file to be opened is '-'
[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
36d52296 24 return if !defined $file || $file eq '-';
eab60bb1
GS
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
8bc9d590
JH
183"\$Config{'archname'}-\$Config{'osvers'}" eq
184"$Config{'archname'}-$Config{'osvers'}" or
81be85b8 185 die "Errno architecture ($Config{'archname'}-$Config{'osvers'}) does not match executable architecture (\$Config{'archname'}-\$Config{'osvers'})";
eab60bb1
GS
186
187\$VERSION = "$VERSION";
188\@ISA = qw(Exporter);
189
190EDQ
191
192 my $len = 0;
193 my @err = sort { $err{$a} <=> $err{$b} } keys %err;
194 map { $len = length if length > $len } @err;
195
196 my $j = "\@EXPORT_OK = qw(" . join(" ",keys %err) . ");\n";
197 $j =~ s/(.{50,70})\s/$1\n\t/g;
198 print $j,"\n";
199
200print <<'ESQ';
201%EXPORT_TAGS = (
202 POSIX => [qw(
203ESQ
204
205 my $k = join(" ", grep { exists $err{$_} }
206 qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT
207 EAGAIN EALREADY EBADF EBUSY ECHILD ECONNABORTED
208 ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT
209 EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS
210 EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK
211 EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH
212 ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM
213 ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
214 ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM
215 EPFNOSUPPORT EPIPE EPROCLIM EPROTONOSUPPORT EPROTOTYPE
216 ERANGE EREMOTE ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT
217 ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS ETXTBSY
218 EUSERS EWOULDBLOCK EXDEV));
219
220 $k =~ s/(.{50,70})\s/$1\n\t/g;
221 print "\t",$k,"\n )]\n);\n\n";
222
223 foreach $err (@err) {
224 printf "sub %s () { %d }\n",,$err,$err{$err};
225 }
226
227 print <<'ESQ';
228
229sub TIEHASH { bless [] }
230
231sub FETCH {
232 my ($self, $errname) = @_;
233 my $proto = prototype("Errno::$errname");
234 if (defined($proto) && $proto eq "") {
235 no strict 'refs';
236 return $! == &$errname;
237 }
238 require Carp;
239 Carp::confess("No errno $errname");
240}
241
242sub STORE {
243 require Carp;
244 Carp::confess("ERRNO hash is read only!");
245}
246
247*CLEAR = \&STORE;
248*DELETE = \&STORE;
249
250sub NEXTKEY {
251 my($k,$v);
252 while(($k,$v) = each %Errno::) {
253 my $proto = prototype("Errno::$k");
254 last if (defined($proto) && $proto eq "");
255
256 }
257 $k
258}
259
260sub FIRSTKEY {
261 my $s = scalar keys %Errno::;
262 goto &NEXTKEY;
263}
264
265sub EXISTS {
266 my ($self, $errname) = @_;
267 my $proto = prototype($errname);
268 defined($proto) && $proto eq "";
269}
270
271tie %!, __PACKAGE__;
272
2731;
274__END__
275
276=head1 NAME
277
278Errno - System errno constants
279
280=head1 SYNOPSIS
281
282 use Errno qw(EINTR EIO :POSIX);
283
284=head1 DESCRIPTION
285
286C<Errno> defines and conditionally exports all the error constants
287defined in your system C<errno.h> include file. It has a single export
288tag, C<:POSIX>, which will export all POSIX defined error numbers.
289
290C<Errno> also makes C<%!> magic such that each element of C<%!> has a non-zero
291value only if C<$!> is set to that value, eg
292
293 use Errno;
294
295 unless (open(FH, "/fangorn/spouse")) {
296 if ($!{ENOENT}) {
297 warn "Get a wife!\n";
298 } else {
299 warn "This path is barred: $!";
300 }
301 }
302
303=head1 AUTHOR
304
305Graham Barr <gbarr@pobox.com>
306
307=head1 COPYRIGHT
308
309Copyright (c) 1997-8 Graham Barr. All rights reserved.
310This program is free software; you can redistribute it and/or modify it
311under the same terms as Perl itself.
312
313=cut
314
315ESQ
316
317}