1use ExtUtils::MakeMaker;
2use Config;
3use strict;
4
5our $VERSION = "1.37";
6
7my %err = ();
8
9my $IsMSWin32 = $^O eq 'MSWin32';
10
11unlink "Errno.pm" if -f "Errno.pm";
12unlink "Errno.tmp" if -f "Errno.tmp";
13open OUT, '>', 'Errno.tmp' or die "Cannot open Errno.tmp: $!";
14select OUT;
15my $file;
16my @files = get_files();
17if ($Config{gccversion} ne '' && $^O eq 'MSWin32') {
18    # MinGW complains "warning: #pragma system_header ignored outside include
19    # file" if the header files are processed individually, so include them
20    # all in .c file and process that instead.
21    open INCS, '>', 'includes.c' or
22	die "Cannot open includes.c";
23    foreach $file (@files) {
24	next if $file eq 'errno.c';
25	next unless -f $file;
26	print INCS qq[#include "$file"\n];
27    }
28    close INCS;
29    process_file('includes.c');
30    unlink 'includes.c';
31}
32else {
33    foreach $file (@files) {
34	process_file($file);
35    }
36}
37write_errno_pm();
38unlink "errno.c" if -f "errno.c";
39close OUT or die "Error closing Errno.tmp: $!";
40select STDOUT;
41rename "Errno.tmp", "Errno.pm" or die "Cannot rename Errno.tmp to Errno.pm: $!";
42
43sub process_file {
44    my($file) = @_;
45
46    # for win32 perl under cygwin, we need to get a windows pathname
47    if ($^O eq 'MSWin32' && $Config{cc} =~ /\B-mno-cygwin\b/ &&
48        defined($file) && !-f $file) {
49        chomp($file = `cygpath -w "$file"`);
50    }
51
52    return unless defined $file and -f $file;
53#    warn "Processing $file\n";
54
55    local *FH;
56    if (($^O eq 'VMS') && ($Config{vms_cc_type} ne 'gnuc')) {
57	unless(open(FH," LIBRARY/EXTRACT=ERRNO/OUTPUT=SYS\$OUTPUT $file |")) {
58            warn "Cannot open '$file'";
59            return;
60	}
61    } elsif ($Config{gccversion} ne '' && $^O ne 'darwin' ) {
62	# With the -dM option, gcc outputs every #define it finds
63	unless(open(FH,"$Config{cc} -E -dM $Config{cppflags} $file |")) {
64            warn "Cannot open '$file'";
65            return;
66	}
67    } else {
68	unless(open(FH, '<', $file)) {
69	    # This file could be a temporary file created by cppstdin
70	    # so only warn under -w, and return
71            warn "Cannot open '$file'" if $^W;
72            return;
73	}
74    }
75
76    my $pat;
77    if ($IsMSWin32) {
78	$pat = '^\s*#\s*define\s+((?:WSA)?E\w+)\s+';
79    }
80    else {
81	$pat = '^\s*#\s*define\s+(E\w+)\s+';
82    }
83    while(<FH>) {
84	$err{$1} = 1
85	    if /$pat/;
86    }
87
88    close(FH);
89}
90
91my $cppstdin;
92
93sub default_cpp {
94    unless (defined $cppstdin) {
95	use File::Spec;
96	$cppstdin = $Config{cppstdin};
97	my $upup_cppstdin = File::Spec->catfile(File::Spec->updir,
98						File::Spec->updir,
99						"cppstdin");
100	my $cppstdin_is_wrapper =
101	    ($cppstdin eq 'cppstdin'
102		and -f $upup_cppstdin
103		    and -x $upup_cppstdin);
104	$cppstdin = $upup_cppstdin if $cppstdin_is_wrapper;
105    }
106    return "$cppstdin $Config{cppflags} $Config{cppminus}";
107}
108
109sub get_files {
110    my @file;
111    # When cross-compiling we may store a path for gcc's "sysroot" option:
112    my $sysroot = $Config{sysroot} || '';
113    my $linux_errno_h;
114    if ($^O eq 'linux') {
115	# Some Linuxes have weird errno.hs which generate
116	# no #file or #line directives
117	($linux_errno_h) = grep { -e $_ } map { "$_/errno.h" }
118	    "$sysroot/usr/include", "$sysroot/usr/local/include",
119	    split / / => $Config{locincpth};
120    }
121
122    # VMS keeps its include files in system libraries
123    if ($^O eq 'VMS') {
124	push(@file, 'Sys$Library:DECC$RTLDEF.TLB');
125    } elsif ($^O eq 'os390') {
126	# OS/390 C compiler doesn't generate #file or #line directives
127        # and it does not tag the header as 1047 (EBCDIC), so make a local
128        # copy and tag it
129        my $cp = `cp /usr/include/errno.h ./errno.h`;
130        my $chtag = `chtag -t -cIBM-1047 ./errno.h`;
131	push(@file, './errno.h');
132    } elsif ($Config{archname} eq 'arm-riscos') {
133	# Watch out for cross compiling for RISC OS
134	my $dep = `echo "#include <errno.h>" | gcc -E -M -`;
135	if ($dep =~ /(\S+errno\.h)/) {
136	     push(@file, $1);
137	}
138    } elsif ($^O eq 'linux' &&
139	      $Config{gccversion} ne '' &&
140	      $Config{gccversion} !~ /intel/i &&
141	      # might be using, say, Intel's icc
142	      $linux_errno_h
143	     ) {
144	push(@file, $linux_errno_h);
145    } elsif ($^O eq 'haiku') {
146	# hidden in a special place
147	push(@file, '/boot/system/develop/headers/posix/errno.h');
148
149    } elsif ($^O eq 'vos') {
150	# avoid problem where cpp returns non-POSIX pathnames
151	push(@file, '/system/include_library/errno.h');
152    } else {
153	open(CPPI, '>', 'errno.c') or
154	    die "Cannot open errno.c";
155
156        print CPPI "#include <errno.h>\n";
157        if ($IsMSWin32) {
158            print CPPI qq[#include "../../win32/include/sys/errno2.h"\n];
159        }
160
161	close(CPPI);
162
163	# invoke CPP and read the output
164	if ($IsMSWin32) {
165	    open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
166		die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
167	} else {
168	    my $cpp = default_cpp();
169	    open(CPPO,"$cpp < errno.c |") or
170		die "Cannot exec $cpp";
171	}
172
173	my $pat = '^#\s*(?:line)?\s*\d+\s+"([^"]+)"';
174	while(<CPPO>) {
175	    if ($^O eq 'os2' or $IsMSWin32) {
176		if (/$pat/o) {
177		   my $f = $1;
178		   $f =~ s,\\\\,/,g;
179		   push(@file, $f);
180		}
181	    }
182	    else {
183		push(@file, $1) if /$pat/o;
184	    }
185	}
186	close(CPPO);
187    }
188    return uniq(@file);
189}
190
191#
192#
193sub uniq
194{
195	# At this point List::Util::uniq appears not to be usable so
196	# roll our own.
197	#
198	# Returns a list with unique values, while keeping the order
199	#
200	return do { my %seen; grep { !$seen{$_}++ } @_ };
201}
202
203sub write_errno_pm {
204    my $err;
205
206    # quick sanity check
207
208    die "No error definitions found" unless keys %err;
209
210    # create the CPP input
211
212    open(CPPI, '>', 'errno.c') or
213	die "Cannot open errno.c";
214
215    print CPPI "#include <errno.h>\n";
216
217    if ($IsMSWin32) {
218	print CPPI qq[#include "../../win32/include/sys/errno2.h"\n];
219    }
220
221    foreach $err (keys %err) {
222	print CPPI '"',$err,'" [[',$err,']]',"\n";
223    }
224
225    close(CPPI);
226
227    {	# BeOS (support now removed) did not enter this block
228    # invoke CPP and read the output
229
230	my $inhibit_linemarkers = '';
231	if ($Config{gccversion} =~ /\A(\d+)\./ and $1 >= 5) {
232	    # GCC 5.0 interleaves expanded macros with line numbers breaking
233	    # each line into multiple lines. RT#123784
234	    $inhibit_linemarkers = ' -P';
235	}
236
237	if ($^O eq 'VMS') {
238	    my $cpp = "$Config{cppstdin} $Config{cppflags}" .
239		$inhibit_linemarkers . " $Config{cppminus}";
240	    $cpp =~ s/sys\$input//i;
241	    open(CPPO,"$cpp  errno.c |") or
242		die "Cannot exec $Config{cppstdin}";
243	} elsif ($IsMSWin32) {
244	    my $cpp = "$Config{cpprun} $Config{cppflags}" .
245		$inhibit_linemarkers;
246	    open(CPPO,"$cpp errno.c |") or
247		die "Cannot run '$cpp errno.c'";
248	} else {
249	    my $cpp = default_cpp() . $inhibit_linemarkers;
250	    open(CPPO,"$cpp < errno.c |")
251		or die "Cannot exec $cpp";
252	}
253
254	%err = ();
255
256	while(<CPPO>) {
257	    my($name,$expr);
258	    next unless ($name, $expr) = /"(.*?)"\s*\[\s*\[\s*(.*?)\s*\]\s*\]/;
259	    next if $name eq $expr;
260	    $expr =~ s/\(?\(\s*[a-z_]\w*\s*\)\(?([^\)]+)\)?\)?/$1/i; # ((type)0xcafebabe) et alia
261	    $expr =~ s/\b((?:0x)?[0-9a-f]+)[LU]+\b/$1/gi; # 2147483647L et alia
262	    next if $expr =~ m/\b[a-z_]\w*\b/i; # skip expressions containing function names etc
263	    if($expr =~ m/^0[xX]/) {
264		$err{$name} = hex $expr;
265	    }
266	    else {
267		$err{$name} = eval $expr;
268	    }
269	    delete $err{$name} unless defined $err{$name};
270	}
271	close(CPPO);
272    }
273
274    # escape $Config{'archname'}
275    my $archname = $Config{'archname'};
276    $archname =~ s/([@%\$])/\\$1/g;
277
278    # Write Errno.pm
279
280    print <<"EDQ";
281# -*- buffer-read-only: t -*-
282#
283# This file is auto-generated by ext/Errno/Errno_pm.PL.
284# ***ANY*** changes here will be lost.
285#
286
287package Errno;
288use Exporter 'import';
289use strict;
290
291EDQ
292
293    # Errno only needs Config to make sure it hasn't changed platforms.
294    # If someone set $ENV{PERL_BUILD_EXPAND_CONFIG_VARS} at build time,
295    # they've already declared perl doesn't need to worry about this risk.
296    if(!$ENV{'PERL_BUILD_EXPAND_CONFIG_VARS'}) {
297        print <<"CONFIG_CHECK_END";
298use Config;
299"\$Config{'archname'}-\$Config{'osvers'}" eq
300"$archname-$Config{'osvers'}" or
301	die "Errno architecture ($archname-$Config{'osvers'}) does not match executable architecture (\$Config{'archname'}-\$Config{'osvers'})";
302
303CONFIG_CHECK_END
304}
305
306    print <<"EDQ";
307our \$VERSION = "$VERSION";
308\$VERSION = eval \$VERSION;
309
310my %err;
311
312BEGIN {
313    %err = (
314EDQ
315
316    my @err = sort { $err{$a} <=> $err{$b} || $a cmp $b }
317	grep { $err{$_} =~ /-?\d+$/ } keys %err;
318
319    foreach $err (@err) {
320	print "\t$err => $err{$err},\n";
321    }
322
323print <<'ESQ';
324    );
325    # Generate proxy constant subroutines for all the values.
326    # Well, almost all the values. Unfortunately we can't assume that at this
327    # point that our symbol table is empty, as code such as if the parser has
328    # seen code such as C<exists &Errno::EINVAL>, it will have created the
329    # typeglob.
330    # Doing this before defining @EXPORT_OK etc means that even if a platform is
331    # crazy enough to define EXPORT_OK as an error constant, everything will
332    # still work, because the parser will upgrade the PCS to a real typeglob.
333    # We rely on the subroutine definitions below to update the internal caches.
334    # Don't use %each, as we don't want a copy of the value.
335    foreach my $name (keys %err) {
336        if ($Errno::{$name}) {
337            # We expect this to be reached fairly rarely, so take an approach
338            # which uses the least compile time effort in the common case:
339            eval "sub $name() { $err{$name} }; 1" or die $@;
340        } else {
341            $Errno::{$name} = \$err{$name};
342        }
343    }
344}
345
346our @EXPORT_OK = keys %err;
347
348our %EXPORT_TAGS = (
349    POSIX => [qw(
350ESQ
351
352    my $k = join(" ", grep { exists $err{$_} }
353	qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT
354	EAGAIN EALREADY EBADF EBUSY ECHILD ECONNABORTED
355	ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT
356	EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS
357	EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK
358	EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH
359	ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM
360	ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
361	ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM
362	EPFNOSUPPORT EPIPE EPROCLIM EPROTONOSUPPORT EPROTOTYPE
363	ERANGE EREMOTE ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT
364	ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS ETXTBSY
365	EUSERS EWOULDBLOCK EXDEV));
366
367    $k =~ s/(.{50,70})\s/$1\n\t/g;
368    print "\t",$k,"\n    )],\n";
369
370    if ($IsMSWin32) {
371	print "    WINSOCK => [qw(\n";
372	$k = join(" ", grep { /^WSAE/ } sort keys %err);
373	$k =~ s/(.{50,70})\s/$1\n\t/g;
374	print "\t",$k,"\n    )],\n";
375    }
376
377    print ");\n\n";
378
379    print <<'ESQ';
380sub TIEHASH { bless \%err }
381
382sub FETCH {
383    my (undef, $errname) = @_;
384    return "" unless exists $err{$errname};
385    my $errno = $err{$errname};
386    return $errno == $! ? $errno : 0;
387}
388
389sub STORE {
390    require Carp;
391    Carp::confess("ERRNO hash is read only!");
392}
393
394# This is the true return value
395*CLEAR = *DELETE = \*STORE; # Typeglob aliasing uses less space
396
397sub NEXTKEY {
398    each %err;
399}
400
401sub FIRSTKEY {
402    my $s = scalar keys %err;	# initialize iterator
403    each %err;
404}
405
406sub EXISTS {
407    my (undef, $errname) = @_;
408    exists $err{$errname};
409}
410
411sub _tie_it {
412    tie %{$_[0]}, __PACKAGE__;
413}
414
415__END__
416
417=head1 NAME
418
419Errno - System errno constants
420
421=head1 SYNOPSIS
422
423    use Errno qw(EINTR EIO :POSIX);
424
425=head1 DESCRIPTION
426
427C<Errno> defines and conditionally exports all the error constants
428defined in your system F<errno.h> include file. It has a single export
429tag, C<:POSIX>, which will export all POSIX defined error numbers.
430
431On Windows, C<Errno> also defines and conditionally exports all the
432Winsock error constants defined in your system F<WinError.h> include
433file. These are included in a second export tag, C<:WINSOCK>.
434
435C<Errno> also makes C<%!> magic such that each element of C<%!> has a
436non-zero value only if C<$!> is set to that value. For example:
437
438    my $fh;
439    unless (open($fh, "<", "/fangorn/spouse")) {
440        if ($!{ENOENT}) {
441            warn "Get a wife!\n";
442        } else {
443            warn "This path is barred: $!";
444        }
445    }
446
447If a specified constant C<EFOO> does not exist on the system, C<$!{EFOO}>
448returns C<"">.  You may use C<exists $!{EFOO}> to check whether the
449constant is available on the system.
450
451Perl automatically loads C<Errno> the first time you use C<%!>, so you don't
452need an explicit C<use>.
453
454=head1 CAVEATS
455
456Importing a particular constant may not be very portable, because the
457import will fail on platforms that do not have that constant.  A more
458portable way to set C<$!> to a valid value is to use:
459
460    if (exists &Errno::EFOO) {
461        $! = &Errno::EFOO;
462    }
463
464=head1 AUTHOR
465
466Graham Barr <gbarr@pobox.com>
467
468=head1 COPYRIGHT
469
470Copyright (c) 1997-8 Graham Barr. All rights reserved.
471This program is free software; you can redistribute it and/or modify it
472under the same terms as Perl itself.
473
474=cut
475
476# ex: set ro:
477ESQ
478
479}
480