This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
enable Errno build on win32, add Errno-1.08 files to repository
[perl5.git] / ext / Errno / Errno_pm.PL
CommitLineData
eab60bb1
GS
1#!perl
2use ExtUtils::MakeMaker;
3use Config;
4use strict;
5
6use vars qw($VERSION);
7
8$VERSION = "1.08";
9
10my %err = ();
11
12unlink "Errno.pm" if -f "Errno.pm";
13open OUT, ">Errno.pm" or die "Cannot open Errno.pm: $!";
14select OUT;
15my $file;
16foreach $file (get_files()) {
17 process_file($file);
18}
19write_errno_pm();
20unlink "errno.c" if -f "errno.c";
21
22sub 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
41 if /^#\s*define\s+(E\w+)\s+/;
42 }
43 close(FH);
44}
45
46sub 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 {
75 $pat = '^#(?:line)?\s+\d+\s+"([^"]+)"';
76 }
77 while(<CPPO>) {
78 $file{$1} = 1 if /$pat/o;
79 }
80 close(CPPO);
81 }
82 return keys %file;
83}
84
85sub 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}";
107 } else {
108 open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
109 die "Cannot exec $Config{cpprun}";
110 }
111
112 %err = ();
113
114 while(<CPPO>) {
115 my($name,$expr);
116 next unless ($name, $expr) = /"(.*?)"\s*\[\s*\[\s*(.*?)\s*\]\s*\]/;
117 next if $name eq $expr;
118 $err{$name} = eval $expr;
119 }
120 close(CPPO);
121
122 # Write Errno.pm
123
124 print <<"EDQ";
125#
126# This file is auto-generated. ***ANY*** changes here will be lost
127#
128
129package Errno;
130use vars qw(\@EXPORT_OK \%EXPORT_TAGS \@ISA \$VERSION \%errno \$AUTOLOAD);
131use Exporter ();
132use Config;
133use strict;
134
135\$Config{'myarchname'} eq "$Config{'myarchname'}" or
136 die "Errno architecture ($Config{'myarchname'}) does not match executable architecture (\$Config{'myarchname'})";
137
138\$VERSION = "$VERSION";
139\@ISA = qw(Exporter);
140
141EDQ
142
143 my $len = 0;
144 my @err = sort { $err{$a} <=> $err{$b} } keys %err;
145 map { $len = length if length > $len } @err;
146
147 my $j = "\@EXPORT_OK = qw(" . join(" ",keys %err) . ");\n";
148 $j =~ s/(.{50,70})\s/$1\n\t/g;
149 print $j,"\n";
150
151print <<'ESQ';
152%EXPORT_TAGS = (
153 POSIX => [qw(
154ESQ
155
156 my $k = join(" ", grep { exists $err{$_} }
157 qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT
158 EAGAIN EALREADY EBADF EBUSY ECHILD ECONNABORTED
159 ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT
160 EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS
161 EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK
162 EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH
163 ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM
164 ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
165 ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM
166 EPFNOSUPPORT EPIPE EPROCLIM EPROTONOSUPPORT EPROTOTYPE
167 ERANGE EREMOTE ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT
168 ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS ETXTBSY
169 EUSERS EWOULDBLOCK EXDEV));
170
171 $k =~ s/(.{50,70})\s/$1\n\t/g;
172 print "\t",$k,"\n )]\n);\n\n";
173
174 foreach $err (@err) {
175 printf "sub %s () { %d }\n",,$err,$err{$err};
176 }
177
178 print <<'ESQ';
179
180sub TIEHASH { bless [] }
181
182sub FETCH {
183 my ($self, $errname) = @_;
184 my $proto = prototype("Errno::$errname");
185 if (defined($proto) && $proto eq "") {
186 no strict 'refs';
187 return $! == &$errname;
188 }
189 require Carp;
190 Carp::confess("No errno $errname");
191}
192
193sub STORE {
194 require Carp;
195 Carp::confess("ERRNO hash is read only!");
196}
197
198*CLEAR = \&STORE;
199*DELETE = \&STORE;
200
201sub NEXTKEY {
202 my($k,$v);
203 while(($k,$v) = each %Errno::) {
204 my $proto = prototype("Errno::$k");
205 last if (defined($proto) && $proto eq "");
206
207 }
208 $k
209}
210
211sub FIRSTKEY {
212 my $s = scalar keys %Errno::;
213 goto &NEXTKEY;
214}
215
216sub EXISTS {
217 my ($self, $errname) = @_;
218 my $proto = prototype($errname);
219 defined($proto) && $proto eq "";
220}
221
222tie %!, __PACKAGE__;
223
2241;
225__END__
226
227=head1 NAME
228
229Errno - System errno constants
230
231=head1 SYNOPSIS
232
233 use Errno qw(EINTR EIO :POSIX);
234
235=head1 DESCRIPTION
236
237C<Errno> defines and conditionally exports all the error constants
238defined in your system C<errno.h> include file. It has a single export
239tag, C<:POSIX>, which will export all POSIX defined error numbers.
240
241C<Errno> also makes C<%!> magic such that each element of C<%!> has a non-zero
242value only if C<$!> is set to that value, eg
243
244 use Errno;
245
246 unless (open(FH, "/fangorn/spouse")) {
247 if ($!{ENOENT}) {
248 warn "Get a wife!\n";
249 } else {
250 warn "This path is barred: $!";
251 }
252 }
253
254=head1 AUTHOR
255
256Graham Barr <gbarr@pobox.com>
257
258=head1 COPYRIGHT
259
260Copyright (c) 1997-8 Graham Barr. All rights reserved.
261This program is free software; you can redistribute it and/or modify it
262under the same terms as Perl itself.
263
264=cut
265
266ESQ
267
268}