[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 ($Config{archname} eq 'epoc') {
	# Watch out for cross compiling for EPOC (usually done on linux)
	$file{'/usr/local/epoc/include/libc/sys/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
f168a5e7	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	}
9ae2e8df	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;
a367e475	86	} elsif ($Config{archname} eq 'epoc') {
	87	# Watch out for cross compiling for EPOC (usually done on linux)
	88	$file{'/usr/local/epoc/include/libc/sys/errno.h'} = 1;
9ae2e8df	89	} elsif ($^O eq 'linux') {
	90	# Some Linuxes have weird errno.hs which generate
	91	# no #file or #line directives
	92	$file{'/usr/include/errno.h'} = 1;
eab60bb1	93	} else {
	94	open(CPPI,"> errno.c") or
	95	die "Cannot open errno.c";
	96
	97	print CPPI "#include <errno.h>\n";
	98
	99	close(CPPI);
	100
	101	# invoke CPP and read the output
6ad8d9a8	102	if ($^O eq 'MSWin32') {
	103	open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c \|") or
	104	die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
	105	} else {
def887e8	106	my $cpp = default_cpp();
6ad8d9a8	107	open(CPPO,"$cpp < errno.c \|") or
	108	die "Cannot exec $cpp";
	109	}
eab60bb1	110
	111	my $pat;
	112	if ($^O eq 'MSWin32' and $Config{cc} =~ /^bcc/i) {
	113	$pat = '^/\\s+(.+)\s+\d+\s:\s+\*/';
	114	}
	115	else {
d0d1d9b9	116	$pat = '^#\s(?:line)?\s\d+\s+"([^"]+)"';
eab60bb1	117	}
eab60bb1	118	while(<CPPO>) {
2449e420	119	if ($^O eq 'os2' or $^O eq 'MSWin32') {
0196e43b	120	if (/$pat/o) {
	121	my $f = $1;
	122	$f =~ s,\\\\,/,g;
	123	$file{$f} = 1;
	124	}
	125	}
	126	else {
	127	$file{$1} = 1 if /$pat/o;
	128	}
eab60bb1	129	}
	130	close(CPPO);
	131	}
	132	return keys %file;
	133	}
	134
	135	sub write_errno_pm {
	136	my $err;
	137
def887e8	138	# quick sanity check
	139
	140	die "No error definitions found" unless keys %err;
	141
eab60bb1	142	# create the CPP input
	143
	144	open(CPPI,"> errno.c") or
	145	die "Cannot open errno.c";
	146
	147	print CPPI "#include <errno.h>\n";
	148
	149	foreach $err (keys %err) {
	150	print CPPI '"',$err,'" [[',$err,']]',"\n";
	151	}
	152
	153	close(CPPI);
	154
	155	# invoke CPP and read the output
dcbf900d	156
eab60bb1	157	if ($^O eq 'VMS') {
	158	my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}";
	159	$cpp =~ s/sys\$input//i;
	160	open(CPPO,"$cpp errno.c \|") or
	161	die "Cannot exec $Config{cppstdin}";
6ad8d9a8	162	} elsif ($^O eq 'MSWin32') {
	163	open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c \|") or
	164	die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
	165	} else {
def887e8	166	my $cpp = default_cpp();
dcbf900d	167	open(CPPO,"$cpp < errno.c \|")
dcbf900d	168	or die "Cannot exec $cpp";
eab60bb1	169	}
	170
	171	%err = ();
	172
	173	while(<CPPO>) {
	174	my($name,$expr);
	175	next unless ($name, $expr) = /"(.?)"\s\[\s\[\s(.?)\s\]\s*\]/;
	176	next if $name eq $expr;
	177	$err{$name} = eval $expr;
	178	}
	179	close(CPPO);
	180
	181	# Write Errno.pm
	182
	183	print <<"EDQ";
	184	#
	185	# This file is auto-generated. *ANY* changes here will be lost
	186	#
	187
	188	package Errno;
f168a5e7	189	our (\@EXPORT_OK,\%EXPORT_TAGS,\@ISA,\$VERSION,\%errno,\$AUTOLOAD);
eab60bb1	190	use Exporter ();
	191	use Config;
	192	use strict;
	193
8bc9d590	194	"\$Config{'archname'}-\$Config{'osvers'}" eq
8bc9d590	195	"$Config{'archname'}-$Config{'osvers'}" or
81be85b8	196	die "Errno architecture ($Config{'archname'}-$Config{'osvers'}) does not match executable architecture (\$Config{'archname'}-\$Config{'osvers'})";
eab60bb1	197
	198	\$VERSION = "$VERSION";
	199	\@ISA = qw(Exporter);
	200
	201	EDQ
	202
	203	my $len = 0;
	204	my @err = sort { $err{$a} <=> $err{$b} } keys %err;
	205	map { $len = length if length > $len } @err;
	206
	207	my $j = "\@EXPORT_OK = qw(" . join(" ",keys %err) . ");\n";
	208	$j =~ s/(.{50,70})\s/$1\n\t/g;
	209	print $j,"\n";
	210
	211	print <<'ESQ';
	212	%EXPORT_TAGS = (
	213	POSIX => [qw(
	214	ESQ
	215
	216	my $k = join(" ", grep { exists $err{$_} }
	217	qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT
	218	EAGAIN EALREADY EBADF EBUSY ECHILD ECONNABORTED
	219	ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT
	220	EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS
	221	EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK
	222	EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH
	223	ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM
	224	ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
	225	ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM
	226	EPFNOSUPPORT EPIPE EPROCLIM EPROTONOSUPPORT EPROTOTYPE
	227	ERANGE EREMOTE ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT
	228	ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS ETXTBSY
	229	EUSERS EWOULDBLOCK EXDEV));
	230
	231	$k =~ s/(.{50,70})\s/$1\n\t/g;
	232	print "\t",$k,"\n )]\n);\n\n";
	233
	234	foreach $err (@err) {
	235	printf "sub %s () { %d }\n",,$err,$err{$err};
	236	}
	237
	238	print <<'ESQ';
	239
	240	sub TIEHASH { bless [] }
	241
	242	sub FETCH {
	243	my ($self, $errname) = @_;
	244	my $proto = prototype("Errno::$errname");
68301627	245	my $errno = "";
eab60bb1	246	if (defined($proto) && $proto eq "") {
eab60bb1	247	no strict 'refs';
68301627	248	$errno = &$errname;
68301627	249	$errno = 0 unless $! == $errno;
eab60bb1	250	}
68301627	251	return $errno;
93014de6	252	}
eab60bb1	253
	254	sub STORE {
	255	require Carp;
	256	Carp::confess("ERRNO hash is read only!");
	257	}
	258
	259	*CLEAR = \&STORE;
	260	*DELETE = \&STORE;
	261
	262	sub NEXTKEY {
	263	my($k,$v);
	264	while(($k,$v) = each %Errno::) {
	265	my $proto = prototype("Errno::$k");
	266	last if (defined($proto) && $proto eq "");
eab60bb1	267	}
	268	$k
	269	}
	270
	271	sub FIRSTKEY {
68301627	272	my $s = scalar keys %Errno::; # initialize iterator
eab60bb1	273	goto &NEXTKEY;
	274	}
	275
	276	sub EXISTS {
	277	my ($self, $errname) = @_;
	278	my $proto = prototype($errname);
	279	defined($proto) && $proto eq "";
	280	}
	281
	282	tie %!, __PACKAGE__;
	283
	284	1;
	285	__END__
	286
	287	=head1 NAME
	288
	289	Errno - System errno constants
	290
	291	=head1 SYNOPSIS
	292
	293	use Errno qw(EINTR EIO :POSIX);
	294
	295	=head1 DESCRIPTION
	296
	297	C<Errno> defines and conditionally exports all the error constants
	298	defined in your system C<errno.h> include file. It has a single export
	299	tag, C<:POSIX>, which will export all POSIX defined error numbers.
	300
93014de6	301	C<Errno> also makes C<%!> magic such that each element of C<%!> has a
68301627	302	non-zero value only if C<$!> is set to that value. For example:
eab60bb1	303
eab60bb1	304	use Errno;
3cb6de81	305
eab60bb1	306	unless (open(FH, "/fangorn/spouse")) {
	307	if ($!{ENOENT}) {
	308	warn "Get a wife!\n";
	309	} else {
	310	warn "This path is barred: $!";
	311	}
	312	}
	313
68301627	314	If a specified constant C<EFOO> does not exist on the system, C<$!{EFOO}>
68301627	315	returns C<"">. You may use C<exists $!{EFOO}> to check whether the
93014de6	316	constant is available on the system.
93014de6	317
68301627	318	=head1 CAVEATS
	319
	320	Importing a particular constant may not be very portable, because the
	321	import will fail on platforms that do not have that constant. A more
	322	portable way to set C<$!> to a valid value is to use:
	323
	324	if (exists &Errno::EFOO) {
	325	$! = &Errno::EFOO;
	326	}
	327
eab60bb1	328	=head1 AUTHOR
	329
	330	Graham Barr <gbarr@pobox.com>
	331
	332	=head1 COPYRIGHT
	333
	334	Copyright (c) 1997-8 Graham Barr. All rights reserved.
	335	This program is free software; you can redistribute it and/or modify it
	336	under the same terms as Perl itself.
	337
	338	=cut
	339
	340	ESQ
	341
	342	}