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