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