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