[perl5.git] / ext / Errno / Errno_pm.PL

use ExtUtils::MakeMaker;
use Config;
use strict;

use vars qw($VERSION);

$VERSION = "1.111";

my %err = ();

unlink "Errno.pm" if -f "Errno.pm";
open OUT, ">Errno.pm" or die "Cannot open Errno.pm: $!";
select OUT;
my $file;
foreach $file (get_files()) {
    process_file($file);
}
write_errno_pm();
unlink "errno.c" if -f "errno.c";

sub process_file {
    my($file) = @_;

    return unless defined $file;

    local *FH;
    if (($^O eq 'VMS') && ($Config{vms_cc_type} ne 'gnuc')) {
	unless(open(FH," LIBRARY/EXTRACT=ERRNO/OUTPUT=SYS\$OUTPUT $file |")) {
            warn "Cannot open '$file'";
            return;
	}     
    } else {
	unless(open(FH,"< $file")) {
	    # This file could be a temporay file created by cppstdin
	    # so only warn under -w, and return
            warn "Cannot open '$file'" if $^W;
            return;
	}
    }
    while(<FH>) {
	$err{$1} = 1
	    if /^\s*#\s*define\s+(E\w+)\s+/;
   }
   close(FH);
}

sub get_files {
    my %file = ();
    # VMS keeps its include files in system libraries (well, except for Gcc)
    if ($^O eq 'VMS') {
	if ($Config{vms_cc_type} eq 'decc') {
	    $file{'Sys$Library:DECC$RTLDEF.TLB'} = 1;
	} elsif ($Config{vms_cc_type} eq 'vaxc') {
	    $file{'Sys$Library:vaxcdef.tlb'} = 1;
	} elsif ($Config{vms_cc_type} eq 'gcc') {
	    $file{'gnu_cc_include:[000000]errno.h'} = 1;
	}
    } elsif ($^O eq 'os390') {
	# OS/390 C compiler doesn't generate #file or #line directives
	$file{'/usr/include/errno.h'} = 1;
    } elsif ($^O eq 'vmesa') {
	# OS/390 C compiler doesn't generate #file or #line directives
	$file{'../../vmesa/errno.h'} = 1;
    } else {
	open(CPPI,"> errno.c") or
	    die "Cannot open errno.c";

	print CPPI "#include <errno.h>\n";

	close(CPPI);

	# invoke CPP and read the output
	if ($^O eq 'MSWin32') {
	    open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
		die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
	} else {
	    my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}";
	    open(CPPO,"$cpp < errno.c |") or
		die "Cannot exec $cpp";
	}

	my $pat;
	if ($^O eq 'MSWin32' and $Config{cc} =~ /^bcc/i) {
	    $pat = '^/\*\s+(.+)\s+\d+\s*:\s+\*/';
	}
	else {
	    $pat = '^#(?:line)?\s*\d+\s+"([^"]+)"';
	}
	while(<CPPO>) {
	    $file{$1} = 1 if /$pat/o;
	}
	close(CPPO);
    }
    return keys %file;
}

sub write_errno_pm {
    my $err;

    # create the CPP input

    open(CPPI,"> errno.c") or
	die "Cannot open errno.c";

    print CPPI "#include <errno.h>\n";

    foreach $err (keys %err) {
	print CPPI '"',$err,'" [[',$err,']]',"\n";
    }

    close(CPPI);

    # invoke CPP and read the output

    if ($^O eq 'VMS') {
	my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}";
	$cpp =~ s/sys\$input//i;
	open(CPPO,"$cpp  errno.c |") or
          die "Cannot exec $Config{cppstdin}";
    } elsif ($^O eq 'MSWin32') {
	open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
	    die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
    } else {
	my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}";
	open(CPPO,"$cpp < errno.c |")
	    or die "Cannot exec $cpp";
    }

    %err = ();

    while(<CPPO>) {
	my($name,$expr);
	next unless ($name, $expr) = /"(.*?)"\s*\[\s*\[\s*(.*?)\s*\]\s*\]/;
	next if $name eq $expr;
	$err{$name} = eval $expr;
    }
    close(CPPO);

    # Write Errno.pm

    print <<"EDQ";
#
# This file is auto-generated. ***ANY*** changes here will be lost
#

package Errno;
use vars qw(\@EXPORT_OK \%EXPORT_TAGS \@ISA \$VERSION \%errno \$AUTOLOAD);
use Exporter ();
use Config;
use strict;

\$Config{'myarchname'} eq "$Config{'myarchname'}" or
	die "Errno architecture ($Config{'myarchname'}) does not match executable architecture (\$Config{'myarchname'})";

\$VERSION = "$VERSION";
\@ISA = qw(Exporter);

EDQ
   
    my $len = 0;
    my @err = sort { $err{$a} <=> $err{$b} } keys %err;
    map { $len = length if length > $len } @err;

    my $j = "\@EXPORT_OK = qw(" . join(" ",keys %err) . ");\n";
    $j =~ s/(.{50,70})\s/$1\n\t/g;
    print $j,"\n";

print <<'ESQ';
%EXPORT_TAGS = (
    POSIX => [qw(
ESQ

    my $k = join(" ", grep { exists $err{$_} } 
	qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT
	EAGAIN EALREADY EBADF EBUSY ECHILD ECONNABORTED
	ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT
	EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS
	EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK
	EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH
	ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM
	ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
	ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM
	EPFNOSUPPORT EPIPE EPROCLIM EPROTONOSUPPORT EPROTOTYPE
	ERANGE EREMOTE ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT
	ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS ETXTBSY
	EUSERS EWOULDBLOCK EXDEV));

    $k =~ s/(.{50,70})\s/$1\n\t/g;
    print "\t",$k,"\n    )]\n);\n\n";

    foreach $err (@err) {
	printf "sub %s () { %d }\n",,$err,$err{$err};
    }

    print <<'ESQ';

sub TIEHASH { bless [] }

sub FETCH {
    my ($self, $errname) = @_;
    my $proto = prototype("Errno::$errname");
    if (defined($proto) && $proto eq "") {
	no strict 'refs';
        return $! == &$errname;
    }
    require Carp;
    Carp::confess("No errno $errname");
} 

sub STORE {
    require Carp;
    Carp::confess("ERRNO hash is read only!");
}

*CLEAR = \&STORE;
*DELETE = \&STORE;

sub NEXTKEY {
    my($k,$v);
    while(($k,$v) = each %Errno::) {
	my $proto = prototype("Errno::$k");
	last if (defined($proto) && $proto eq "");
	
    }
    $k
}

sub FIRSTKEY {
    my $s = scalar keys %Errno::;
    goto &NEXTKEY;
}

sub EXISTS {
    my ($self, $errname) = @_;
    my $proto = prototype($errname);
    defined($proto) && $proto eq "";
}

tie %!, __PACKAGE__;

1;
__END__

=head1 NAME

Errno - System errno constants

=head1 SYNOPSIS

    use Errno qw(EINTR EIO :POSIX);

=head1 DESCRIPTION

C<Errno> defines and conditionally exports all the error constants
defined in your system C<errno.h> include file. It has a single export
tag, C<:POSIX>, which will export all POSIX defined error numbers.

C<Errno> also makes C<%!> magic such that each element of C<%!> has a non-zero
value only if C<$!> is set to that value, eg

    use Errno;
    
    unless (open(FH, "/fangorn/spouse")) {
        if ($!{ENOENT}) {
            warn "Get a wife!\n";
        } else {
            warn "This path is barred: $!";
        } 
    } 

=head1 AUTHOR

Graham Barr <gbarr@pobox.com>

=head1 COPYRIGHT

Copyright (c) 1997-8 Graham Barr. All rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

ESQ

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