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