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