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