[p5sagit/p5-mst-13.2.git] / ext / Errno / Errno_pm.PL

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

our $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 and -f $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;
	}     
    } elsif ($Config{gccversion} ne '') { 
	# With the -dM option, gcc outputs every #define it finds
	unless(open(FH,"$Config{cc} -E -dM $file |")) {
            warn "Cannot open '$file'";
            return;
	}     
    } else {
	unless(open(FH,"< $file")) {
	    # This file could be a temporary 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);
}

my $cppstdin;

sub default_cpp {
    unless (defined $cppstdin) {
	use File::Spec;
	$cppstdin = $Config{cppstdin};
	my $upup_cppstdin = File::Spec->catfile(File::Spec->updir,
						File::Spec->updir,
						"cppstdin");
	my $cppstdin_is_wrapper =
	    ($cppstdin eq 'cppstdin'
		and -f $upup_cppstdin
		    and -x $upup_cppstdin);
	$cppstdin = $upup_cppstdin if $cppstdin_is_wrapper;
    }
    return "$cppstdin $Config{cppflags} $Config{cppminus}";
}

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;
    } elsif ($^O eq 'linux') {
	# Some Linuxes have weird errno.hs which generate
	# no #file or #line directives
	$file{'/usr/include/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 = default_cpp();
	    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 = '^#\s*(?:line)?\s*\d+\s+"([^"]+)"';
	}
	while(<CPPO>) {
	    if ($^O eq 'os2' or $^O eq 'MSWin32') {
		if (/$pat/o) {
		   my $f = $1;
		   $f =~ s,\\\\,/,g;
		   $file{$f} = 1;
		}
	    }
	    else {
		$file{$1} = 1 if /$pat/o;
	    }
	}
	close(CPPO);
    }
    return keys %file;
}

sub write_errno_pm {
    my $err;

    # quick sanity check

    die "No error definitions found" unless keys %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 = default_cpp();
	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;
our (\@EXPORT_OK,\%EXPORT_TAGS,\@ISA,\$VERSION,\%errno,\$AUTOLOAD);
use Exporter ();
use Config;
use strict;

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

\$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");
    my $errno = "";
    if (defined($proto) && $proto eq "") {
	no strict 'refs';
	$errno = &$errname;
        $errno = 0 unless $! == $errno;
    }
    return $errno;
}

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::;	# initialize iterator
    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. For example:

    use Errno;

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

If a specified constant C<EFOO> does not exist on the system, C<$!{EFOO}>
returns C<"">.  You may use C<exists $!{EFOO}> to check whether the
constant is available on the system.

=head1 CAVEATS

Importing a particular constant may not be very portable, because the
import will fail on platforms that do not have that constant.  A more
portable way to set C<$!> to a valid value is to use:

    if (exists &Errno::EFOO) {
        $! = &Errno::EFOO;
    }

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