5.002 beta 1

If you're adventurous, have a look at ftp://ftp.sems.com/pub/outgoing/perl5.0/perl5.002beta1.tar.gz Many thanks to Andy for doing the integration. Obviously, if you consult the bugs database, you'll note there are still plenty of buglets that need fixing, and several enhancements that I've intended to put in still haven't made it in (Hi, Tim and Ilya). But I think it'll be pretty stable. And you can start to fiddle around with prototypes (which are, of course, still totally undocumented). Packrats, don't worry too much about readvertising this widely. Nowadays we're on a T1 here, so our bandwidth is okay. Have the appropriate amount of jollity. Larry
author: Larry Wall <lwall@scalpel.netlabs.com> 1995-11-21 10:01:00 +1200
committer: Larry <lwall@scalpel.netlabs.com> 1995-11-21 10:01:00 +1200
commit: 4633a7c4bad06b471d9310620b7fe8ddd158cccd (patch)
tree: 37ebeb26a64f123784fd8fac6243b124767243b0 /lib
parent: 8e07c86ebc651fe92eb7e3b25f801f57cfb8dd6f (diff)
download: perl-4633a7c4bad06b471d9310620b7fe8ddd158cccd.tar.gz
22 files changed, 2121 insertions, 281 deletions
diff --git a/lib/AutoLoader.pm b/lib/AutoLoader.pm
index b38915872c..ea19e502a0 100644
--- a/lib/AutoLoader.pm
+++ b/lib/AutoLoader.pm
@@ -33,7 +33,8 @@ AUTOLOAD {
 	    eval {require $name};
 	}
 	elsif ($AUTOLOAD =~ /::DESTROY$/) {
-	    eval "sub $AUTOLOAD {}";
+	    # eval "sub $AUTOLOAD {}";
+	    *$AUTOLOAD = sub {};
 	}
 	if ($@){
 	    $@ =~ s/ at .*\n//;
diff --git a/lib/AutoSplit.pm b/lib/AutoSplit.pm
index 72f897d1b1..46cf68985a 100644
--- a/lib/AutoSplit.pm
+++ b/lib/AutoSplit.pm
@@ -56,6 +56,7 @@ sub autosplit_lib_modules{
 
     foreach(@modules){
 	s#::#/#g;	# incase specified as ABC::XYZ
+	s|\\|/|g;		# bug in ksh OS/2
 	s#^lib/##; # incase specified as lib/*.pm
 	if ($vms && /[:>\]]/) { # may need to convert VMS-style filespecs
 	    my ($dir,$name) = (/(.*])(.*)/);
@@ -77,6 +78,9 @@ sub autosplit_file{
 
     # where to write output files
     $autodir = "lib/auto" unless $autodir;
+    if ($Config{'osname'} eq 'VMS') {
+	($autodir = VMS::Filespec::unixpath($autodir)) =~ s#/$##;
+    }
     unless (-d $autodir){
 	local($", @p)="/";
 	foreach(split(/\//,$autodir)){
@@ -107,7 +111,6 @@ sub autosplit_file{
 	$package = $1 if (m/^\s*package\s+([\w:]+)\s*;/);
 	++$autoloader_seen if m/^\s*(use|require)\s+AutoLoader\b/;
 	++$autoloader_seen if m/\bISA\s*=.*\bAutoLoader\b/;
-	++$autoloader_seen if m/^\s*sub\s+AUTOLOAD\b/;
 	last if /^__END__/;
     }
     if ($check_for_autoloader && !$autoloader_seen){
@@ -174,14 +177,15 @@ sub autosplit_file{
     # For now both of these produce warnings.
 
     open(OUT,">/dev/null") || open(OUT,">nla0:"); # avoid 'not opened' warning
-    my(@subnames);
+    my(@subnames, %proto);
     while (<IN>) {
 	if (/^package ([\w:]+)\s*;/) {
 	    warn "package $1; in AutoSplit section ignored. Not currently supported.";
 	}
-	if (/^sub ([\w:]+)/) {
+	if (/^sub\s+([\w:]+)(\s*\(.*?\))?/) {
 	    print OUT "1;\n";
-	    my($subname) = $1;
+	    my $subname = $1;
+	    $proto{$1} = $2 or '';
 	    if ($subname =~ m/::/){
 		warn "subs with package names not currently supported in AutoSplit section";
 	    }
@@ -229,7 +233,7 @@ sub autosplit_file{
 	carp "AutoSplit: unable to create timestamp file ($al_idx_file): $!";
     print TS "# Index created by AutoSplit for $filename (file acts as timestamp)\n";
     print TS "package $package;\n";
-    print TS map("sub $_ ;\n", @subnames);
+    print TS map("sub $_$proto{$_} ;\n", @subnames);
     print TS "1;\n";
     close(TS);
 
diff --git a/lib/Cwd.pm b/lib/Cwd.pm
index af1167dfc8..6b845108c2 100644
--- a/lib/Cwd.pm
+++ b/lib/Cwd.pm
@@ -1,7 +1,11 @@
 package Cwd;
 require 5.000;
 require Exporter;
-use Config;
+require Config;
+
+# Use osname for portability switches (doubled to cheaply avoid -w warning)
+my $osname = $Config::Config{'osname'} || $Config::Config{'osname'};
+
 
 =head1 NAME
 
@@ -9,11 +13,14 @@ getcwd - get pathname of current working directory
 
 =head1 SYNOPSIS
 
-    require Cwd;
-    $dir = Cwd::getcwd();
+    use Cwd;
+    $dir = cwd;
+
+    use Cwd;
+    $dir = getcwd;
 
     use Cwd;
-    $dir = getcwd();
+    $dir = fastgetcwd;
 
     use Cwd 'chdir';
     chdir "/tmp";
@@ -22,29 +29,42 @@ getcwd - get pathname of current working directory
 =head1 DESCRIPTION
 
 The getcwd() function re-implements the getcwd(3) (or getwd(3)) functions
-in Perl.  If you ask to override your chdir() built-in function, then your
-PWD environment variable will be kept up to date.  (See
-L<perlsub/Overriding builtin functions>.)
+in Perl.
 
 The fastgetcwd() function looks the same as getcwd(), but runs faster.
 It's also more dangerous because you might conceivably chdir() out of a
 directory that you can't chdir() back into.
 
+The cwd() function looks the same as getcwd and fastgetcwd but is
+implemented using the most natural and safe form for the current
+architecture. For most systems it is identical to `pwd` (but without
+the trailing line terminator). It is recommended that cwd (or another
+*cwd() function) is used in I<all> code to ensure portability.
+
+If you ask to override your chdir() built-in function, then your PWD
+environment variable will be kept up to date.  (See
+L<perlsub/Overriding builtin functions>.) Note that it will only be
+kept up to date it all packages which use chdir import it from Cwd.
+
 =cut
 
 @ISA = qw(Exporter);
-@EXPORT = qw(getcwd fastcwd);
+@EXPORT = qw(cwd getcwd fastcwd);
 @EXPORT_OK = qw(chdir);
 
+# use strict;
+
+sub _backtick_pwd {  # The 'natural and safe form' for UNIX (pwd may be setuid root)
+    my $cwd;
+    chop($cwd = `pwd`);
+    $cwd;
+} 
+
+# Since some ports may predefine cwd internally (e.g., NT)
+# we take care not to override an existing definition for cwd().
+
+*cwd = \&_backtick_pwd unless defined &cwd;
 
-# VMS: $ENV{'DEFAULT'} points to default directory at all times
-# 08-Dec-1994  Charles Bailey  bailey@genetics.upenn.edu
-# Note: Use of Cwd::getcwd() or Cwd::chdir() (but not Cwd::fastcwd())
-#   causes the logical name PWD to be defined in the process 
-#   logical name table as the default device and directory 
-#   seen by Perl. This may not be the same as the default device 
-#   and directory seen by DCL after Perl exits, since the effects
-#   the CRTL chdir() function persist only until Perl exits.
 
 # By Brandon S. Allbery
 #
@@ -52,8 +72,6 @@ directory that you can't chdir() back into.
 
 sub getcwd
 {
-    if($Config{'osname'} eq 'VMS') { return $ENV{'PWD'} = $ENV{'DEFAULT'} }
-
     my($dotdots, $cwd, @pst, @cst, $dir, @tst);
 
     unless (@cst = stat('.'))
@@ -120,8 +138,6 @@ sub getcwd
 # you might chdir out of a directory that you can't chdir back into.
 
 sub fastcwd {
-    if($Config{'osname'} eq 'VMS') { return $ENV{'DEFAULT'} }
-
     my($odev, $oino, $cdev, $cino, $tdev, $tino);
     my(@path, $path);
     local(*DIR);
@@ -151,29 +167,25 @@ sub fastcwd {
 }
 
 
-# keeps track of current working directory in PWD environment var
-#
-# $RCSfile: pwd.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:11 $
-#
-# $Log:	pwd.pl,v $
-#
+# Keeps track of current working directory in PWD environment var
 # Usage:
 #	use Cwd 'chdir';
 #	chdir $newdir;
 
-$chdir_init = 0;
+my $chdir_init = 0;
 
-sub chdir_init{
-    if ($ENV{'PWD'}) {
+sub chdir_init {
+    if ($ENV{'PWD'} and $osname ne 'os2') {
 	my($dd,$di) = stat('.');
 	my($pd,$pi) = stat($ENV{'PWD'});
 	if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
-	    chop($ENV{'PWD'} = `pwd`);
+	    $ENV{'PWD'} = cwd();
 	}
     }
     else {
-	chop($ENV{'PWD'} = `pwd`);
+	$ENV{'PWD'} = cwd();
     }
+    # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
     if ($ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|) {
 	my($pd,$pi) = stat($2);
 	my($dd,$di) = stat($1);
@@ -185,17 +197,18 @@ sub chdir_init{
 }
 
 sub chdir {
-    my($newdir) = shift;
-    $newdir =~ s|/{2,}|/|g;
+    my $newdir = shift || '';	# allow for no arg (chdir to HOME dir)
+    $newdir =~ s|///*|/|g;
     chdir_init() unless $chdir_init;
-    return 0 unless (CORE::chdir $newdir);
-    if ($Config{'osname'} eq 'VMS') { return $ENV{PWD} = $ENV{DEFAULT} }
+    return 0 unless CORE::chdir $newdir;
+    if ($osname eq 'VMS') { return $ENV{'PWD'} = $ENV{'DEFAULT'} }
 
     if ($newdir =~ m#^/#) {
 	$ENV{'PWD'} = $newdir;
-    }else{
-	my(@curdir) = split(m#/#,$ENV{'PWD'});
-	@curdir = '' unless @curdir;
+    } else {
+	my @curdir = split(m#/#,$ENV{'PWD'});
+	@curdir = ('') unless @curdir;
+	my $component;
 	foreach $component (split(m#/#, $newdir)) {
 	    next if $component eq '.';
 	    pop(@curdir),next if $component eq '..';
@@ -203,7 +216,60 @@ sub chdir {
 	}
 	$ENV{'PWD'} = join('/',@curdir) || '/';
     }
+    1;
 }
 
+
+# --- PORTING SECTION ---
+
+# VMS: $ENV{'DEFAULT'} points to default directory at all times
+# 08-Dec-1994  Charles Bailey  bailey@genetics.upenn.edu
+# Note: Use of Cwd::getcwd() or Cwd::chdir() (but not Cwd::fastcwd())
+#   causes the logical name PWD to be defined in the process 
+#   logical name table as the default device and directory 
+#   seen by Perl. This may not be the same as the default device 
+#   and directory seen by DCL after Perl exits, since the effects
+#   the CRTL chdir() function persist only until Perl exits.
+# This does not apply to other systems (where only chdir() sets PWD).
+
+sub _vms_cwd {
+    return $ENV{'DEFAULT'}
+}
+sub _vms_pwd {
+    return $ENV{'PWD'} = $ENV{'DEFAULT'}
+}
+sub _os2_cwd {
+    $ENV{'PWD'} = `cmd /c cd`;
+    chop $ENV{'PWD'};
+    $ENV{'PWD'} =~ s:\\:/:g ;
+    return $ENV{'PWD'};
+}
+
+if ($osname eq 'VMS') {
+
+    *cwd        = \&_vms_pwd;
+    *getcwd     = \&_vms_pwd;
+    *fastgetcwd = \&_vms_cwd;
+}
+elsif ($osname eq 'NT') {
+
+    *getcwd     = \&cwd;
+    *fastgetcwd = \&cwd;
+}
+elsif ($osname eq 'os2') {
+    *cwd     = \&_os2_cwd;
+    *getcwd     = \&_os2_cwd;
+    *fastgetcwd = \&_os2_cwd;
+    *fastcwd = \&_os2_cwd;
+}
+
+# package main; eval join('',<DATA>) || die $@;	# quick test
+
 1;
 
+__END__
+BEGIN { import Cwd qw(:DEFAULT chdir); }
+print join("\n", cwd, getcwd, fastcwd, "");
+chdir('..');
+print join("\n", cwd, getcwd, fastcwd, "");
+print "$ENV{PWD}\n";
diff --git a/lib/Exporter.pm b/lib/Exporter.pm
index 0a7abc5286..8c4368c0ef 100644
--- a/lib/Exporter.pm
+++ b/lib/Exporter.pm
@@ -64,6 +64,10 @@ sub export {
 	local $Carp::CarpLevel = 1;	# ignore package calling us too.
 	Carp::carp($text);
     };
+    local $SIG{__DIE__} = sub {
+	Carp::croak("$_[0]Illegal null symbol in \@${1}::EXPORT")
+	    if $_[0] =~ /^Unable to create sub named "(.*?)::"/;
+    };
 
     my $pkg = shift;
     my $callpkg = shift;
diff --git a/lib/ExtUtils/Liblist.pm b/lib/ExtUtils/Liblist.pm
index 7672f5ef31..d9b1e35b1d 100644
--- a/lib/ExtUtils/Liblist.pm
+++ b/lib/ExtUtils/Liblist.pm
@@ -4,11 +4,15 @@ package ExtUtils::Liblist;
 
 use Config;
 use Cwd;
+use File::Basename;
+
+my $Config_libext = $Config{lib_ext} || ".a";
+
 # --- Determine libraries to use and how to use them ---
 
 sub ext {
     my($potential_libs, $Verbose) = @_;
-    return ("", "", "") unless $potential_libs;
+    return ("", "", "", "") unless $potential_libs;
     print STDOUT "Potential libraries are '$potential_libs':\n" if $Verbose;
 
     my($so)   = $Config{'so'};
@@ -21,7 +25,7 @@ sub ext {
 
     my(@searchpath); # from "-L/path" entries in $potential_libs
     my(@libpath) = split " ", $Config{'libpth'};
-    my(@ldloadlibs, @bsloadlibs, @extralibs);
+    my(@ldloadlibs, @bsloadlibs, @extralibs, @ld_run_path, %ld_run_path_seen);
     my($fullname, $thislib, $thispth, @fullname);
     my($pwd) = fastcwd(); # from Cwd.pm
     my($found) = 0;
@@ -90,22 +94,24 @@ sub ext {
 			$mb cmp $ma;} @fullname)[0];
 	    } elsif (-f ($fullname="$thispth/lib$thislib.$so")
 		 && (($Config{'dlsrc'} ne "dl_dld.xs") || ($thislib eq "m"))){
-	    } elsif (-f ($fullname="$thispth/lib${thislib}_s.a")
+	    } elsif (-f ($fullname="$thispth/lib${thislib}_s$Config_libext")
 		 && ($thislib .= "_s") ){ # we must explicitly use _s version
-	    } elsif (-f ($fullname="$thispth/lib$thislib.a")){
-	    } elsif (-f ($fullname="$thispth/Slib$thislib.a")){
+	    } elsif (-f ($fullname="$thispth/lib$thislib$Config_libext")){
+	    } elsif (-f ($fullname="$thispth/Slib$thislib$Config_libext")){
 	    } else {
 		print STDOUT "$thislib not found in $thispth\n" if $Verbose;
 		next;
 	    }
 	    print STDOUT "'-l$thislib' found at $fullname\n" if $Verbose;
+	    my($fullnamedir) = dirname($fullname);
+	    push @ld_run_path, $fullnamedir unless $ld_run_path_seen{$fullnamedir}++;
 	    $found++;
 	    $found_lib++;
 
 	    # Now update library lists
 
 	    # what do we know about this library...
-	    my $is_dyna = ($fullname !~ /\.a$/);
+	    my $is_dyna = ($fullname !~ /\Q$Config_libext\E$/);
 	    my $in_perl = ($libs =~ /\B-l${thislib}\b/s);
 
 	    # Do not add it into the list if it is already linked in
@@ -142,8 +148,8 @@ sub ext {
 	print STDOUT "Warning (non-fatal): No library found for -l$thislib\n"
 	    unless $found_lib>0;
     }
-    return ('','','') unless $found;
-    ("@extralibs", "@bsloadlibs", "@ldloadlibs");
+    return ('','','','') unless $found;
+    ("@extralibs", "@bsloadlibs", "@ldloadlibs",join(":",@ld_run_path));
 }
 
 sub lsdir { #yes, duplicate code seems less hassle than having an
diff --git a/lib/ExtUtils/MakeMaker.pm b/lib/ExtUtils/MakeMaker.pm
index a03e4b8a60..feb3cf010c 100644
--- a/lib/ExtUtils/MakeMaker.pm
+++ b/lib/ExtUtils/MakeMaker.pm
@@ -14,21 +14,21 @@ sub TIEHASH {
 }
 
 sub FETCH {
-    print "Warning (non-fatal): Importing of %att is depreciated [$_[1]]
+    print "Warning (non-fatal): Importing of %att is deprecated [$_[1]]
 	use \$self instead\n" unless ++$Enough>$Enough_limit;
     print "Further ExtUtils::MakeMaker::TieAtt warnings suppressed\n" if $Enough==$Enough_limit;
     $_[0]->{SECRETHASH}->{$_[1]};
 }
 
 sub STORE {
-    print "Warning (non-fatal): Importing of %att is depreciated [$_[1]][$_[2]]
+    print "Warning (non-fatal): Importing of %att is deprecated [$_[1]][$_[2]]
 	use \$self instead\n" unless ++$Enough>$Enough_limit;
     print "Further ExtUtils::MakeMaker::TieAtt warnings suppressed\n" if $Enough==$Enough_limit;
     $_[0]->{SECRETHASH}->{$_[1]} = $_[2];
 }
 
 sub FIRSTKEY {
-    print "Warning (non-fatal): Importing of %att is depreciated [FIRSTKEY]
+    print "Warning (non-fatal): Importing of %att is deprecated [FIRSTKEY]
 	use \$self instead\n" unless ++$Enough>$Enough_limit;
     print "Further ExtUtils::MakeMaker::TieAtt warnings suppressed\n" if $Enough==$Enough_limit;
     each %{$_[0]->{SECRETHASH}};
@@ -44,38 +44,26 @@ sub DESTROY {
 sub warndirectuse {
     my($caller) = @_;
     return if $Enough>$Enough_limit;
-    print STDOUT "Warning (non-fatal): Direct use of class methods depreciated; use\n";
+    print STDOUT "Warning (non-fatal): Direct use of class methods deprecated; use\n";
     my($method) = $caller =~ /.*:(\w+)$/;
     print STDOUT 
 '		my $self = shift;
-		local *', $method, ';
 		$self->MM::', $method, "();
 	instead\n";
     print "Further ExtUtils::MakeMaker::TieAtt warnings suppressed\n"
 	if ++$Enough==$Enough_limit;
 }
 
-package ExtUtils::MakeMaker::TieVersion;
-sub TIESCALAR { my $x = "5.00"; bless \$x }
-sub FETCH { ${$_[0]} }
-sub STORE { warn "You just tried to alter \$ExtUtils::MakeMaker::Version.
-Please check your Makefile.PL"; $_[1]; }
-sub DESTROY {}
-
 package ExtUtils::MakeMaker;
 
-# Last edited $Date: 1995/10/26 16:24:47 $ by Andreas Koenig
+# Last edited $Date: 1995/11/12 10:05:55 $ by Andreas Koenig
+# $Id: MakeMaker.pm,v 1.105 1995/11/12 10:05:55 k Exp $
 
-# The tie will go away again inlater versions
-$ExtUtils::MakeMaker::Version = $ExtUtils::MakeMaker::VERSION;
-tie $ExtUtils::MakeMaker::Version, ExtUtils::MakeMaker::TieVersion;
-tie $ExtUtils::MakeMaker::VERSION, ExtUtils::MakeMaker::TieVersion;
+$Version = $VERSION = "5.06";
 
 $ExtUtils::MakeMaker::Version_OK = 4.13;	# Makefiles older than $Version_OK will die
 			# (Will be checked from MakeMaker version 4.13 onwards)
 
-# $Id: MakeMaker.pm,v 1.93 1995/10/26 16:24:47 k Exp $
-
 use Config;
 use Carp;
 use Cwd;
@@ -96,12 +84,12 @@ eval {require DynaLoader;};	# Get mod2fname, if defined. Will fail
 @EXPORT = qw(&WriteMakefile &writeMakefile $Verbose &prompt);
 @EXPORT_OK = qw($Version $VERSION &Version_check
 		&help &neatvalue &mkbootstrap &mksymlists
-		%att  ## Import of %att is depreciated, please use OO features!
+		%att  ## Import of %att is deprecated, please use OO features!
 );
 
 $Is_VMS = $Config::Config{osname} eq 'VMS';
 require ExtUtils::MM_VMS if $Is_VMS;
-$Is_OS2 = $Config::Config{'osname'} =~ m|^os/?2$|i ;
+$Is_OS2 = $Config::Config{osname} =~ m|^os/?2$|i ;
 $ENV{EMXSHELL} = 'sh' if $Is_OS2; # to run `commands`
 
 $ExtUtils::MakeMaker::Verbose = 0;
@@ -119,11 +107,10 @@ unshift(@MY::ISA, qw(MM));
 # MY::XYZ->func() can call MM->func() and get the proper
 # default routine without having to know under what OS
 # it's running.
-#unshift(@MM::ISA, $Is_VMS ? qw(ExtUtils::MM_VMS MM_Unix) : qw(MM_Unix));
-unshift @MM::ISA, 'MM_Unix';
+
+@MM::ISA = qw[MM_Unix ExtUtils::MakeMaker];
 unshift @MM::ISA, 'ExtUtils::MM_VMS' if $Is_VMS;
 unshift @MM::ISA, 'ExtUtils::MM_OS2' if $Is_OS2;
-push @MM::ISA, qw[ExtUtils::MakeMaker];
 
 
 @ExtUtils::MakeMaker::MM_Sections_spec = (
@@ -185,6 +172,7 @@ foreach(split(/\n/,attrib_help())){
 
 %ExtUtils::MakeMaker::Prepend_dot_dot = qw(
 INST_LIB 1 INST_ARCHLIB 1 INST_EXE 1 MAP_TARGET 1 INST_MAN1DIR 1 INST_MAN3DIR 1
+PERL_SRC 1 PERL 1 FULLPERL 1
 );
 $PACKNAME = "PACK000";
 
@@ -196,10 +184,12 @@ most probably outdated. We detect that from the fact, that a
 subroutine "writeMakefile" is called, and this subroutine is not
 supported anymore since about October 1994.
 
-Please contact the author or ask archie for a more recent version of
-the extension. If you're really desperate, you can try to change the
-subroutine name from writeMakefile to WriteMakefile and rerun 'perl
-akefile.PL', but you're most probably left alone, when you do so.
+Please contact the author or look into CPAN (details about CPAN can be
+found in the FAQ and at http:/www.perl.com) for a more recent version
+of the extension. If you're really desperate, you can try to change
+the subroutine name from writeMakefile to WriteMakefile and rerun
+'perl Makefile.PL', but you're most probably left alone, when you do
+so.
 
 The MakeMaker team
 
@@ -221,10 +211,10 @@ sub new {
 	check_manifest();
     }
 
-    check_hints();
-
     $self = {} unless (defined $self);
 
+    check_hints();
+
     my(%initial_att) = %$self; # record initial attributes
 
     if (defined $self->{CONFIGURE}) {
@@ -257,6 +247,7 @@ sub new {
 	$self->{PARENT} = $ExtUtils::MakeMaker::Parent[-2];
 	my $key;
 	for $key (keys %ExtUtils::MakeMaker::Prepend_dot_dot) {
+	    next unless defined $self->{PARENT}{$key};
 	    $self->{$key} = $self->{PARENT}{$key};
 	    $self->{$key} = $self->catdir("..",$self->{$key})
 		unless $self->{$key} =~ m!^/!;
@@ -319,6 +310,7 @@ END
     unless ($self->{NORECURS}) {
 	foreach $dir (@{$self->{DIR}}){
 	    chdir $dir;
+	    package main;
 	    local *FH;
 	    open FH, "Makefile.PL";
 	    eval join "", <FH>;
@@ -385,13 +377,14 @@ sub parse_args{
 		 (getpwuid($>))[7]
 		 ]ex;
 	}
-	# This will go away:
+	# This may go away, in mid 1996
 	if ($self->{Correct_relativ_directories}){
 	    $value = $self->catdir("..",$value)
-		if $ExtUtils::MakeMaker::Prepend_dot_dot{$name} &&! $value =~ m!^/!;
+		if $ExtUtils::MakeMaker::Prepend_dot_dot{$name} && ! $value =~ m!^/!;
 	}
 	$self->{$name} = $value;
     }
+    # This may go away, in mid 1996
     delete $self->{Correct_relativ_directories};
 
     # catch old-style 'potential_libs' and inform user how to 'upgrade'
@@ -419,6 +412,13 @@ sub parse_args{
 	$self->{LDFROM} = $self->{LDTARGET};
 	delete $self->{LDTARGET};
     }
+    # Turn a DIR argument on the command line into an array
+    if (defined $self->{DIR} && ref \$self->{DIR} eq 'SCALAR') {
+	# So they can choose from the command line, which extensions they want
+	# the grep enables them to have some colons too much in case they
+	# have to build a list with the shell
+	$self->{DIR} = [grep $_, split ":", $self->{DIR}];
+    }
     my $mmkey;
     foreach $mmkey (sort keys %$self){
 	print STDOUT "	$mmkey => ", neatvalue($self->{$mmkey}), "\n" if $ExtUtils::MakeMaker::Verbose;
@@ -449,6 +449,7 @@ sub check_hints {
     return unless -f "hints/$hint.pl";    # really there
 
     # execute the hintsfile:
+    local *HINTS;
     open HINTS, "hints/$hint.pl";
     @goodhints = <HINTS>;
     close HINTS;
@@ -462,7 +463,7 @@ sub mv_all_methods {
     my($method);
 #    no strict;
 
-    foreach $method (@ExtUtils::MakeMaker::MM_Sections, qw[ dir_target exescan extliblist
+    foreach $method (@ExtUtils::MakeMaker::MM_Sections, qw[ dir_target exescan
 fileparse fileparse_set_fstype init_dirscan init_main init_others
 installpm_x libscan makeaperl mksymlists needs_linking runsubdirpl
 subdir_x test_via_harness test_via_script writedoc ]) {
@@ -505,13 +506,18 @@ subdir_x test_via_harness test_via_script writedoc ]) {
 
 sub prompt {
     my($mess,$def)=@_;
-    local $|=1;
-    die "prompt function called without an argument" unless defined $mess;
+    BEGIN { my $ISA_TTY = -t STDIN && -t STDOUT }
+    Carp::confess("prompt function called without an argument") unless defined $mess;
     $def = "" unless defined $def;
     my $dispdef = "[$def] ";
-    print "$mess $dispdef";
-    chop(my $ans = <STDIN>);
-    $ans || $def;
+    my $ans;
+    if ($ISA_TTY) {
+	local $|=1;
+	print "$mess $dispdef";
+	chop($ans = <STDIN>);
+    }
+    return $ans if defined $ans;
+    return $def;
 }
 
 sub attrib_help {
@@ -587,7 +593,7 @@ Current Version is $ExtUtils::MakeMaker::VERSION. There have been considerable
 changes in the meantime.
 Please rerun 'perl Makefile.PL' to regenerate the Makefile.\n"
     if $checkversion < $ExtUtils::MakeMaker::Version_OK;
-    printf STDOUT "%s %.2f %s %.2f.\n", "Makefile built with ExtUtils::MakeMaker v",
+    printf STDOUT "%s %s %s %s.\n", "Makefile built with ExtUtils::MakeMaker v",
     $checkversion, "Current Version is", $ExtUtils::MakeMaker::VERSION
 	unless $checkversion == $ExtUtils::MakeMaker::VERSION;
 }
@@ -736,7 +742,7 @@ sub init_main {
     ($self->{ROOTEXT} =
      $self->{FULLEXT}) =~ s#/?\Q$self->{BASEEXT}\E$## ;      #eg. /BSD/Foo
 
-	 $self->{ROOTEXT} = ($Is_VMS ? '' : '/') . $self->{ROOTEXT} if $self->{ROOTEXT};
+    $self->{ROOTEXT} = ($Is_VMS ? '' : '/') . $self->{ROOTEXT} if $self->{ROOTEXT};
 
 
     # --- Initialize PERL_LIB, INST_LIB, PERL_SRC
@@ -749,18 +755,18 @@ sub init_main {
     # not be the case (e.g., installing into project libraries etc).
 
     # Perl Macro:    With source    No source
-    # PERL_LIB       ../../lib      /usr/local/lib/perl5
-    # PERL_ARCHLIB   ../../lib      /usr/local/lib/perl5/sun4-sunos
     # PERL_SRC       ../..          (undefined)
+    # PERL_LIB       PERL_SRC/lib   /usr/local/lib/perl5
+    # PERL_ARCHLIB   PERL_SRC/lib   /usr/local/lib/perl5/sun4-sunos
 
     # INST Macro:    For standard   for any other
     #                modules        module
-    # INST_LIB       ../../lib      ./blib
-    # INST_ARCHLIB   ../../lib      ./blib/<archname>
+    # INST_LIB       PERL_SRC/lib   ./blib
+    # INST_ARCHLIB   PERL_SRC/lib   ./blib/<archname>
 
     unless ($self->{PERL_SRC}){
 	my($dir);
-	foreach $dir (qw(../.. ../../.. ../../../..)){
+	foreach $dir (qw(.. ../.. ../../..)){
 	    if ( -f "$dir/config.sh" 
 		&& -f "$dir/perl.h" 
 		&& -f "$dir/lib/Exporter.pm") {
@@ -814,6 +820,10 @@ EOM
     # perl has been built and installed. Setting INST_LIB allows
     # you to build directly into, say $Config::Config{privlibexp}.
     unless ($self->{INST_LIB}){
+
+
+	##### XXXXX We have to change this nonsense
+
 	if (defined $self->{PERL_SRC}) {
 	    $self->{INST_LIB} = $self->{PERL_LIB};
 	} else {
@@ -845,8 +855,8 @@ EOM
     if ($self->{PREFIX}){
 	$self->{INSTALLPRIVLIB} = $self->catdir($self->{PREFIX},"lib","perl5");
 	$self->{INSTALLBIN} = $self->catdir($self->{PREFIX},"bin");
-	$self->{INSTALLMAN1DIR} = $self->catdir($self->{PREFIX},"perl5","man","man1");
-	$self->{INSTALLMAN3DIR} = $self->catdir($self->{PREFIX},"perl5","man","man3");
+	$self->{INSTALLMAN3DIR} = $self->catdir($self->{PREFIX},"perl5","man","man3")
+	    unless defined $self->{INSTALLMAN3DIR};
     }
 
     if( $self->{INSTALLPRIVLIB} && ! $self->{INSTALLARCHLIB} ){
@@ -862,25 +872,39 @@ EOM
     $self->{INSTALLARCHLIB} ||= $Config::Config{installarchlib};
     $self->{INSTALLBIN}     ||= $Config::Config{installbin};
 
-    $self->{INST_MAN1DIR}   ||= $self->catdir('.','blib','man','man1');
-    $self->{INSTALLMAN1DIR} ||= $Config::Config{installman1dir};
-    $self->{MAN1EXT}        ||= $Config::Config{man1ext};
+    $self->{INSTALLMAN1DIR} = $Config::Config{installman1dir}
+	unless defined $self->{INSTALLMAN1DIR};
+    unless (defined $self->{INST_MAN1DIR}){
+	if ($self->{INSTALLMAN1DIR} =~ /^(none|\s*)$/){
+	    $self->{INST_MAN1DIR} = $self->{INSTALLMAN1DIR};
+	} else {
+	    $self->{INST_MAN1DIR} = $self->catdir('.','blib','man','man1');
+	}
+    }
+    $self->{MAN1EXT} ||= $Config::Config{man1ext};
 
-    $self->{INST_MAN3DIR}   ||= $self->catdir('.','blib','man','man3');
-    $self->{INSTALLMAN3DIR} ||= $Config::Config{installman3dir};
-    $self->{MAN3EXT}        ||= $Config::Config{man3ext};
+    $self->{INSTALLMAN3DIR} = $Config::Config{installman3dir}
+	unless defined $self->{INSTALLMAN3DIR};
+    unless (defined $self->{INST_MAN3DIR}){
+	if ($self->{INSTALLMAN3DIR} =~ /^(none|\s*)$/){
+	    $self->{INST_MAN3DIR} = $self->{INSTALLMAN3DIR};
+	} else {
+	    $self->{INST_MAN3DIR} = $self->catdir('.','blib','man','man3');
+	}
+    }
+    $self->{MAN3EXT} ||= $Config::Config{man3ext};
 
     $self->{MAP_TARGET} = "perl" unless $self->{MAP_TARGET};
 
-    $self->{LIB_EXT}  = $Config::Config{lib_ext} || "a";
-    $self->{OBJ_EXT}  = $Config::Config{obj_ext} || "o";
+    $self->{LIB_EXT}  = $Config::Config{lib_ext} || ".a";
+    $self->{OBJ_EXT}  = $Config::Config{obj_ext} || ".o";
     $self->{AR}       = $Config::Config{ar}      || "ar";
 
     unless ($self->{LIBPERL_A}){
 	if ($Is_VMS) {
 	    $self->{LIBPERL_A} = 'libperl.olb';
 	} else {
-	    $self->{LIBPERL_A} = "libperl.$self->{LIB_EXT}";
+	    $self->{LIBPERL_A} = "libperl$self->{LIB_EXT}";
 	}
     }
 
@@ -1015,7 +1039,7 @@ sub init_dirscan {	# --- File and Directory Lists (.xs .pm .pod etc)
     $self->{PM}  = \%pm             unless $self->{PM};
     $self->{C}   = [sort keys %c]   unless $self->{C};
     my(@o_files) = @{$self->{C}};
-    $self->{O_FILES} = [grep s/\.c$/\.$self->{OBJ_EXT}/, @o_files] ;
+    $self->{O_FILES} = [grep s/\.c$/$self->{OBJ_EXT}/, @o_files] ;
     $self->{H}   = [sort keys %h]   unless $self->{H};
     $self->{PL_FILES} = \%pl_files unless $self->{PL_FILES};
     
@@ -1115,15 +1139,8 @@ sub init_others {	# --- Initialize Other Attributes
 	$libs =~ s/^\s*(.*\S)\s*$/$1/; # remove leading and trailing whitespace
 	my(@libs) = $self->extliblist($libs);
 	if ($libs[0] or $libs[1] or $libs[2]){
-	    ($self->{EXTRALIBS}, $self->{BSLOADLIBS}, $self->{LDLOADLIBS}) = @libs;
-	    if ($libs[2]) {
-		my @splitted = split(" ", $libs[2]);
-		my $splitted;
-		foreach $splitted (@splitted) {
-		    $splitted =~ s/^-L//;
-		}
-		$self->{LD_RUN_PATH} = join ":", @splitted;
-	    }
+	    # LD_RUN_PATH now computed by ExtUtils::Liblist
+	    ($self->{EXTRALIBS}, $self->{BSLOADLIBS}, $self->{LDLOADLIBS}, $self->{LD_RUN_PATH}) = @libs;
 	    last;
 	}
     }
@@ -1139,10 +1156,11 @@ sub init_others {	# --- Initialize Other Attributes
 
     unless ( $self->{OBJECT} ){
 	# init_dirscan should have found out, if we have C files
-	$self->{OBJECT} = '$(BASEEXT).$(OBJ_EXT)' if @{$self->{C}||[]};
+	$self->{OBJECT} = '$(BASEEXT)$(OBJ_EXT)' if @{$self->{C}||[]};
     }
     $self->{OBJECT} =~ s/\n+/ \\\n\t/g;
     $self->{BOOTDEP}  = (-f "$self->{BASEEXT}_BS") ? "$self->{BASEEXT}_BS" : "";
+    $self->{PERLMAINCC} ||= '$(CC)';
     $self->{LD}       = ($Config::Config{ld} || 'ld') unless $self->{LD};
     $self->{LDFROM} = '$(OBJECT)' unless $self->{LDFROM};
 
@@ -1158,7 +1176,9 @@ sub init_others {	# --- Initialize Other Attributes
 
     # These get overridden for VMS and maybe some other systems
     $self->{NOOP}  = "";
-    $self->{MAKEFILE} ||= "Makefile";
+    $self->{FIRST_MAKEFILE} ||= "Makefile";
+    $self->{MAKEFILE} ||= $self->{FIRST_MAKEFILE};
+    $self->{MAKE_APERL_FILE} ||= "Makefile.aperl";
     $self->{RM_F}  = "rm -f";
     $self->{RM_RF} = "rm -rf";
     $self->{TOUCH} = "touch";
@@ -1188,14 +1208,13 @@ in these dirs:
 	    my $abs;
 	    if ($name =~ m|^/|) {
 		$abs = $name;
+	    } elsif ($name =~ m|/|) {
+		$abs = $self->catfile(".", $name); # not absolute
 	    } else {
 		$abs = $self->catfile($dir, $name);
 	    }
 	    print "Checking $abs\n" if ($trace >= 2);
-	    if ($Is_OS2) {
-		$abs .= ".exe" unless -x $abs;
-	    }
-	    next unless -x "$abs";
+	    next unless $self->maybe_command($abs);
 	    print "Executing $abs\n" if ($trace >= 2);
 	    if (`$abs -e 'require $ver; print "VER_OK\n" ' 2>&1` =~ /VER_OK/) {
 	        print "Using PERL=$abs\n" if $trace;
@@ -1207,6 +1226,12 @@ in these dirs:
     0; # false and not empty
 }
 
+sub maybe_command {
+    my($self,$file) = @_;
+    return 1 if -x $file && ! -d $file;
+    return;
+}
+
 sub post_initialize {
     my($self) = shift;
     unless (ref $self){
@@ -1279,9 +1304,12 @@ LIBPERL_A = $self->{LIBPERL_A}
 
 MAKEMAKER = \$(PERL_LIB)/ExtUtils/MakeMaker.pm
 MM_VERSION = $ExtUtils::MakeMaker::VERSION
+FIRST_MAKEFILE  = $self->{FIRST_MAKEFILE}
+MAKE_APERL_FILE = $self->{MAKE_APERL_FILE}
 
 OBJ_EXT = $self->{OBJ_EXT}
 LIB_EXT = $self->{LIB_EXT}
+PERLMAINCC = $self->{PERLMAINCC}
 AR = $self->{AR}
 ";
 
@@ -1333,9 +1361,9 @@ MAN3EXT	= $self->{MAN3EXT}
 # work around a famous dec-osf make(1) feature(?):
 makemakerdflt: all
 
-.SUFFIXES: .xs .c .\$(OBJ_EXT)
+.SUFFIXES: .xs .c \$(OBJ_EXT)
 
-.PRECIOUS: Makefile
+# .PRECIOUS: Makefile    # seems to be not necessary anymore
 
 .PHONY: all config static dynamic test linkext
 
@@ -1357,7 +1385,7 @@ INST_ARCHAUTODIR  = $(INST_ARCHLIB)/auto/$(FULLEXT)
 
     if ($self->has_link_code()) {
 	push @m, '
-INST_STATIC  = $(INST_ARCHAUTODIR)/$(BASEEXT).$(LIB_EXT)
+INST_STATIC  = $(INST_ARCHAUTODIR)/$(BASEEXT)$(LIB_EXT)
 INST_DYNAMIC = $(INST_ARCHAUTODIR)/$(DLBASE).$(DLEXT)
 INST_BOOT    = $(INST_ARCHAUTODIR)/$(BASEEXT).bs
 ';
@@ -1449,8 +1477,8 @@ sub const_cccmd {
     }
     return $self->{CONST_CCCMD} if $self->{CONST_CCCMD};
     return '' unless $self->needs_linking();
-    $libperl or $libperl = $self->{LIBPERL_A} || "libperl.$self->{LIB_EXT}" ;
-    $libperl =~ s/\.\$\(A\)$/.$self->{LIB_EXT}/;
+    $libperl or $libperl = $self->{LIBPERL_A} || "libperl$self->{LIB_EXT}" ;
+    $libperl =~ s/\.\$\(A\)$/$self->{LIB_EXT}/;
     # This is implemented in the same manner as extliblist,
     # e.g., do both and compare results during the transition period.
     my($cc,$ccflags,$optimize,$large,$split, $shflags)
@@ -1471,7 +1499,7 @@ sub const_cccmd {
 		DM =>  '-DDEBUGGING -DEMBED -DMULTIPLICITY',
 		);
 
-    if ($libperl =~ /libperl(\w*)\.$self->{LIB_EXT}/){
+    if ($libperl =~ /libperl(\w*)\Q$self->{LIB_EXT}/){
 	$uc = uc($1);
     } else {
 	$uc = ""; # avoid warning
@@ -1522,21 +1550,21 @@ sub const_cccmd {
 	$optimize = $optdebug;
     }
 
-    my($new) = "$cc -c $ccflags $optimize $perltype $large $split";
+    my($new) = "$cc -c \$(INC) $ccflags $optimize $perltype $large $split";
     $new =~ s/^\s+//; $new =~ s/\s+/ /g; $new =~ s/\s+$//;
-    if (defined($old)){
-	$old =~ s/^\s+//; $old =~ s/\s+/ /g; $old =~ s/\s+$//;
-	if ($new ne $old) {
-	    print STDOUT "Warning (non-fatal): cflags evaluation in ",
-	      "MakeMaker ($ExtUtils::MakeMaker::VERSION) ",
-	      "differs from shell output\n",
-	      "   package: $self->{NAME}\n",
-	      "   old: $old\n",
-	      "   new: $new\n",
-	      "   Using 'old' set.\n",
-	      Config::myconfig(), "\n";
-	}
-    }
+#    if (defined($old)){
+#	 $old =~ s/^\s+//; $old =~ s/\s+/ /g; $old =~ s/\s+$//;
+#	 if ($new ne $old) {
+#	     print STDOUT "Warning (non-fatal): cflags evaluation in ",
+#	       "MakeMaker ($ExtUtils::MakeMaker::VERSION) ",
+#	       "differs from shell output\n",
+#	       "   package: $self->{NAME}\n",
+#	       "   old: $old\n",
+#	       "   new: $new\n",
+#	       "   Using 'old' set.\n",
+#	       Config::myconfig(), "\n";
+#	 }
+#    }
     my($cccmd)=($old) ? $old : $new;
     $cccmd =~ s/^\s*\Q$Config::Config{cc}\E\s/\$(CC) /;
     $cccmd .= " \$(DEFINE_VERSION)";
@@ -1582,6 +1610,9 @@ sub tool_xsubpp {
     }
     push(@tmdeps, "typemap") if -f "typemap";
     my(@tmargs) = map("-typemap $_", @tmdeps);
+    if( exists $self->{XSOPT} ){
+	unshift( @tmargs, $self->{XSOPT} );
+    }
     "
 XSUBPPDIR = $xsdir
 XSUBPP = \$(XSUBPPDIR)/xsubpp
@@ -1634,7 +1665,7 @@ sub dist {
     my($postop)   = $attribs{POSTOP}   || '@ true';     # eg remove the distdir
     my($ci)       = $attribs{CI}       || 'ci -u';
     my($rcs_label)= $attribs{RCS_LABEL}|| 'rcs -Nv$(VERSION_SYM): -q';
-    my($dist_cp)  = $attribs{DIST_CP}  || 'cp';
+    my($dist_cp)  = $attribs{DIST_CP}  || 'best';
     my($dist_default) = $attribs{DIST_DEFAULT} || 'tardist';
 
     push @m, "
@@ -1684,10 +1715,11 @@ sub pasthru {
     }
     my(@m,$key);
 
-    my(@pasthru); # 1 was for runsubdirpl, 2 for normal make in subdirectories
+    my(@pasthru);
 
     foreach $key (qw(INSTALLPRIVLIB INSTALLARCHLIB INSTALLBIN 
-		     INSTALLMAN1DIR INSTALLMAN3DIR LIBPERL_A LINKTYPE)){
+		     INSTALLMAN1DIR INSTALLMAN3DIR LIBPERL_A
+		     LINKTYPE)){
 	push @pasthru, "$key=\"\$($key)\"";
     }
 
@@ -1706,8 +1738,8 @@ sub c_o {
     return '' unless $self->needs_linking();
     my(@m);
     push @m, '
-.c.$(OBJ_EXT):
-	$(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $(INC) $*.c
+.c$(OBJ_EXT):
+	$(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.c
 ';
     join "", @m;
 }
@@ -1733,9 +1765,9 @@ sub xs_o {	# many makes are too dumb to use xs_c then c_o
     }
     return '' unless $self->needs_linking();
     '
-.xs.$(OBJ_EXT):
+.xs$(OBJ_EXT):
 	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSUBPPARGS) $*.xs >xstmp.c && mv xstmp.c $*.c
-	$(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $(INC) $*.c
+	$(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.c
 ';
 }
 
@@ -1802,7 +1834,7 @@ help:
 Version_check:
 	@$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \
 		-e 'use ExtUtils::MakeMaker qw($$Version &Version_check);' \
-		-e '&Version_check($(MM_VERSION))'
+		-e '&Version_check("$(MM_VERSION)")'
 };
 
     join('',@m);
@@ -1849,9 +1881,9 @@ static :: $self->{BASEEXT}.exp
     push(@m,"
 $self->{BASEEXT}.exp: Makefile.PL
 ",'	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e \'use ExtUtils::MakeMaker qw(&mksymlists); \\
-	&mksymlists(DL_FUNCS => ',
+	MM->mksymlists({DL_FUNCS => ',
 	%$funcs ? neatvalue($funcs) : '""',', DL_VARS => ',
-	@$vars  ? neatvalue($vars)  : '""', ", NAME => \"$self->{NAME}\")'
+	@$vars  ? neatvalue($vars)  : '""', ", NAME => \"$self->{NAME}\"})'
 ");
 
     join('',@m);
@@ -1930,7 +1962,7 @@ OTHERLDFLAGS = '.$otherldflags.'
 $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists $(EXPORT_LIST) $(PERL_ARCHIVE)
 ');
     if ($armaybe ne ':'){
-	$ldfrom = "tmp.$(LIB_EXT)";
+	$ldfrom = 'tmp$(LIB_EXT)';
 	push(@m,'	$(ARMAYBE) cr '.$ldfrom.' $(OBJECT)'."\n");
 	push(@m,'	$(RANLIB) '."$ldfrom\n");
     }
@@ -2053,13 +2085,31 @@ sub manifypods {
 	ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]);
 	$self = $ExtUtils::MakeMaker::Parent[-1];
     }
+    return "\nmanifypods :\n" unless %{$self->{MANPODS}};
     my($dist);
+    my($pod2man_exe);
+    if (defined $self->{PERL_SRC}) {
+	$pod2man_exe = "$self->{PERL_SRC}/pod/pod2man";
+    } else {
+	$pod2man_exe = "$Config{bin}/pod2man";
+    }
+    unless ($self->maybe_command($pod2man_exe)) {
+	# No pod2man but some MANPODS to be installed
+	print <<END;
+
+Warning: I could not locate your pod2man program. Please make sure,
+         your pod2man program is in your PATH before you execute 'make'
+
+END
+        $pod2man_exe = "-S pod2man";
+    }
     my(@m);
-    push @m, 
+    push @m,
+qq[POD2MAN_EXE = $pod2man_exe\n],
 q[POD2MAN = $(PERL) -we '%m=@ARGV;for (keys %m){' \\
 -e 'next if -e $$m{$$_} && -M $$m{$$_} < -M "].$self->{MAKEFILE}.q[";' \\
 -e 'print "Installing $$m{$$_}\n";' \\
--e 'system("pod2man $$_>$$m{$$_}")==0 or warn "Couldn\\047t install $$m{$$_}\n";' \\
+-e 'system("$(PERL) $(POD2MAN_EXE) $$_>$$m{$$_}")==0 or warn "Couldn\\047t install $$m{$$_}\n";' \\
 -e 'chmod 0644, $$m{$$_} or warn "chmod 644 $$m{$$_}: $$!\n";}'
 ];
     push @m, "\nmanifypods :";
@@ -2141,7 +2191,7 @@ sub subdirs {
     # It calls the subdir_x() method for each subdirectory.
     foreach $dir (@{$self->{DIR}}){
 	push(@m, $self->subdir_x($dir));
-	print "Including $dir subdirectory\n" if $ExtUtils::MakeMaker::Verbose;
+####	print "Including $dir subdirectory\n";
     }
     if (@m){
 	unshift(@m, "
@@ -2177,7 +2227,7 @@ sub subdir_x {
     qq{
 
 subdirs ::
-	\@ -cd $subdir && \$(MAKE) all \$(PASTHRU)
+	\@-cd $subdir && \$(MAKE) all \$(PASTHRU)
 
 };
 }
@@ -2207,7 +2257,7 @@ clean ::
     push(@otherfiles, qw[./blib Makeaperlfile $(INST_ARCHAUTODIR)/extralibs.all
 			 perlmain.c mon.out core so_locations
 			 *~ */*~ */*/*~ 
-			 *.$(OBJ_EXT) *.$(LIB_EXT)
+			 *$(OBJ_EXT) *$(LIB_EXT)
 			 perl.exe $(BOOTSTRAP) $(BASEEXT).bso $(BASEEXT).def $(BASEEXT).exp 
 			]);
     push @m, "\t-$self->{RM_RF} @otherfiles\n";
@@ -2265,6 +2315,12 @@ distcheck :
 };
 
     push @m, q{
+skipcheck :
+	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use ExtUtils::Manifest "&skipcheck";' \\
+		-e 'skipcheck();'
+};
+
+    push @m, q{
 manifest :
 	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use ExtUtils::Manifest "&mkmanifest";' \\
 		-e 'mkmanifest();'
@@ -2467,7 +2523,7 @@ sub makefile {
     # must force a manual rerun to be sure. But as it should only
     # happen very rarely it is not a significant problem.
     push @m, '
-$(OBJECT) : '.$self->{MAKEFILE}.'
+$(OBJECT) : $(FIRST_MAKEFILE)
 ' if $self->{OBJECT};
 
     push @m, '
@@ -2500,7 +2556,7 @@ sub staticmake {
     # And as it's not yet built, we add the current extension
     # but only if it has some C code (or XS code, which implies C code)
     if (@{$self->{C}}) {
-	@static="$self->{INST_ARCHLIB}/auto/$self->{FULLEXT}/$self->{BASEEXT}.$self->{LIB_EXT}";
+	@static="$self->{INST_ARCHLIB}/auto/$self->{FULLEXT}/$self->{BASEEXT}$self->{LIB_EXT}";
     }
 
     # Either we determine now, which libraries we will produce in the
@@ -2609,13 +2665,23 @@ FULLPERL      = $self->{FULLPERL}
 ";
     return join '', @m if $self->{PARENT};
 
+    my($dir) = join ":", @{$self->{DIR}};
+
     unless ($self->{MAKEAPERL}) {
-	push @m, '
-$(MAP_TARGET) ::
-	$(MAKE) LINKTYPE=static all
-	$(PERL) Makefile.PL MAKEFILE=Makefile.aperl LINKTYPE=static MAKEAPERL=1 NORECURS=1
-	$(MAKE) -f Makefile.aperl $(MAP_TARGET)
-';
+	push @m, q{
+$(MAP_TARGET) :: $(MAKE_APERL_FILE)
+	$(MAKE) -f Makefile.aperl static $@
+
+$(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
+	@ echo Writing \"Makefile.aperl\" for this $(MAP_TARGET)
+	@ $(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \
+		Makefile.PL DIR=}, $dir, q{ \
+		MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
+		MAKEAPERL=1 NORECURS=1};
+
+	push @m, map( " \\\n\t\t$_", @ARGV );
+	push @m, "\n";
+
 	return join '', @m;
     }
 
@@ -2626,7 +2692,7 @@ $(MAP_TARGET) ::
 
     $cccmd = $self->const_cccmd($libperl);
     $cccmd =~ s/^CCCMD\s*=\s*//;
-    $cccmd =~ s/\s/ -I$self->{PERL_INC} /;
+    $cccmd =~ s/\$\(INC\)/ -I$self->{PERL_INC} /;
     $cccmd .= " $Config::Config{cccdlflags}" if ($Config::Config{d_shrplib});
     $cccmd =~ s/\n/ /g; # yes I've seen "\n", don't ask me where it came from. A.K.
 
@@ -2638,7 +2704,7 @@ $(MAP_TARGET) ::
     # Which *.a files could we make use of...
     local(%static);
     File::Find::find(sub {
-	return unless m/\.$self->{LIB_EXT}$/;
+	return unless m/\Q$self->{LIB_EXT}$/;
 	return if m/^libperl/;
 	# don't include the installed version of this extension. I
 	# leave this line here, although it is not necessary anymore:
@@ -2647,7 +2713,7 @@ $(MAP_TARGET) ::
 
 	# Once the patch to minimod.PL is in the distribution, I can
 	# drop it
-	return if $File::Find::name =~ m:auto/$self->{FULLEXT}/$self->{BASEEXT}.$self->{LIB_EXT}$:;
+	return if $File::Find::name =~ m:auto/$self->{FULLEXT}/$self->{BASEEXT}$self->{LIB_EXT}$:;
 	$static{fastcwd() . "/" . $_}++;
     }, grep( -d $_, @{$searchdirs || []}) );
 
@@ -2657,7 +2723,7 @@ $(MAP_TARGET) ::
 
     $extra = [] unless $extra && ref $extra eq 'ARRAY';
     for (sort keys %static) {
-	next unless /\.$self->{LIB_EXT}$/;
+	next unless /\Q$self->{LIB_EXT}$/;
 	$_ = dirname($_) . "/extralibs.ld";
 	push @$extra, $_;
     }
@@ -2674,7 +2740,7 @@ $(MAP_TARGET) ::
 MAP_LINKCMD   = $linkcmd
 MAP_PERLINC   = @{$perlinc || []}
 MAP_STATIC    = ",
-join(" \\\n\t", sort keys %static), "
+join(" \\\n\t", reverse sort keys %static), "
 
 MAP_PRELIBS   = $Config::Config{libs} $Config::Config{cryptlib}
 ";
@@ -2684,9 +2750,9 @@ MAP_PRELIBS   = $Config::Config{libs} $Config::Config{cryptlib}
     }
     unless ($libperl && -f $lperl) { # Could quite follow your idea her, Ilya
 	my $dir = $self->{PERL_SRC} || "$self->{PERL_ARCHLIB}/CORE";
-	$libperl ||= "libperl.$self->{LIB_EXT}";
+	$libperl ||= "libperl$self->{LIB_EXT}";
 	$libperl   = "$dir/$libperl";
-	$lperl   ||= "libperl.$self->{LIB_EXT}";
+	$lperl   ||= "libperl$self->{LIB_EXT}";
 	$lperl     = "$dir/$lperl";
 	print STDOUT "Warning: $libperl not found
     If you're going to build a static perl binary, make sure perl is installed
@@ -2710,21 +2776,21 @@ MAP_LIBPERL = $libperl
     }
 
     push @m, "
-\$(MAP_TARGET) :: $tmp/perlmain.\$(OBJ_EXT) \$(MAP_LIBPERL) \$(MAP_STATIC) \$(INST_ARCHAUTODIR)/extralibs.all
-	\$(MAP_LINKCMD) -o \$\@ $tmp/perlmain.\$(OBJ_EXT) \$(MAP_LIBPERL) \$(MAP_STATIC) `cat \$(INST_ARCHAUTODIR)/extralibs.all` \$(MAP_PRELIBS)
+\$(MAP_TARGET) :: $tmp/perlmain\$(OBJ_EXT) \$(MAP_LIBPERL) \$(MAP_STATIC) \$(INST_ARCHAUTODIR)/extralibs.all
+	\$(MAP_LINKCMD) -o \$\@ $tmp/perlmain\$(OBJ_EXT) \$(MAP_LIBPERL) \$(MAP_STATIC) `cat \$(INST_ARCHAUTODIR)/extralibs.all` \$(MAP_PRELIBS)
 	@ echo 'To install the new \"\$(MAP_TARGET)\" binary, call'
 	@ echo '    make -f $makefilename inst_perl MAP_TARGET=\$(MAP_TARGET)'
 	@ echo 'To remove the intermediate files say'
 	@ echo '    make -f $makefilename map_clean'
 
-$tmp/perlmain.\$(OBJ_EXT): $tmp/perlmain.c
+$tmp/perlmain\$(OBJ_EXT): $tmp/perlmain.c
 ";
-    push @m, "\tcd $tmp && $cccmd perlmain.c\n";
+    push @m, "\tcd $tmp && $cccmd -I\$(PERL_INC) perlmain.c\n";
 
     push @m, qq{
 $tmp/perlmain.c: $makefilename}, q{
 	@ echo Writing $@
-	@ $(FULLPERL) $(MAP_PERLINC) -e 'use ExtUtils::Miniperl; \\
+	@ $(PERL) $(MAP_PERLINC) -e 'use ExtUtils::Miniperl; \\
 		writemain(grep s#.*/auto/##, qw|$(MAP_STATIC)|)' > $@.tmp && mv $@.tmp $@
 
 };
@@ -2748,7 +2814,7 @@ pure_inst_perl: \$(MAP_TARGET)
 clean :: map_clean
 
 map_clean :
-	$self->{RM_F} $tmp/perlmain.\$(OBJ_EXT) $tmp/perlmain.c \$(MAP_TARGET) $makefilename \$(INST_ARCHAUTODIR)/extralibs.all
+	$self->{RM_F} $tmp/perlmain\$(OBJ_EXT) $tmp/perlmain.c \$(MAP_TARGET) $makefilename \$(INST_ARCHAUTODIR)/extralibs.all
 };
 
     join '', @m;
@@ -2849,7 +2915,7 @@ sub needs_linking { # Does this module need linking? Looks into
 #    print "DEBUG:\n";
 #    print Carp::longmess();
 #    print "EO_DEBUG\n";
-    if ($self->has_link_code){
+    if ($self->has_link_code or $self->{MAKEAPERL}){
 	$self->{NEEDS_LINKING} = 1;
 	return 1;
     }
@@ -2865,7 +2931,7 @@ sub needs_linking { # Does this module need linking? Looks into
 sub has_link_code {
     my($self) = shift;
     return $self->{HAS_LINK_CODE} if defined $self->{HAS_LINK_CODE};
-    if ($self->{OBJECT} or @{$self->{C} || []} or $self->{MYEXTLIB} or $self->{MAKEAPERL}){
+    if ($self->{OBJECT} or @{$self->{C} || []} or $self->{MYEXTLIB}){
 	$self->{HAS_LINK_CODE} = 1;
 	return 1;
     }
@@ -2933,6 +2999,13 @@ sub replace_manpage_seperator {
     $man;
 }
 
+sub maybe_command {
+    my($self,$file) = @_;
+    return 1 if -x $file && ! -d _;
+    return 1 if -x "$file.exe" && ! -d _;
+    return;
+}
+
 # the following keeps AutoSplit happy
 package ExtUtils::MakeMaker;
 1;
@@ -2963,6 +3036,8 @@ It splits the task of generating the Makefile into several subroutines
 that can be individually overridden.  Each subroutine returns the text
 it wishes to have written to the Makefile.
 
+=head2 Hintsfile support
+
 MakeMaker.pm uses the architecture specific information from
 Config.pm. In addition it evaluates architecture specific hints files
 in a C<hints/> directory. The hints files are expected to be named
@@ -2972,6 +3047,13 @@ MakeMaker within the WriteMakefile() subroutine, and can be used to
 execute commands as well as to include special variables. The rules
 which hintsfile is chosen are the same as in Configure.
 
+The hintsfile is eval()ed immediately after the arguments given to
+WriteMakefile are stuffed into a hash reference $self but before this
+reference becomes blessed. So if you want to do the equivalent to
+override or create an attribute you would say something like
+
+    $self->{LIBS} = ['-ldbm -lucb -lc'];
+
 =head2 What's new in version 5 of MakeMaker
 
 MakeMaker 5 is pure object oriented. This allows us to write an
@@ -2998,7 +3080,7 @@ There are no incompatibilities in the short term, as all changes are
 accompanied by short-term workarounds that guarantee full backwards
 compatibility.
 
-You are likely to face a few warnings that expose depreciations which
+You are likely to face a few warnings that expose deprecations which
 will result in incompatibilities in the long run:
 
 You should not use %att directly anymore. Instead any subroutine you
@@ -3079,14 +3161,14 @@ the macros INST_LIB, INST_ARCHLIB, INST_EXE, INST_MAN1DIR, and
 INST_MAN3DIR. All these default to ./blib or something below blib if
 you are I<not> building below the perl source directory. If you I<are>
 building below the perl source, INST_LIB and INST_ARCHLIB default to
-../../lib, and INST_EXE is not defined.
+ ../../lib, and INST_EXE is not defined.
 
 The I<install> target of the generated Makefile is a recursive call to
 make which sets
 
     INST_LIB     to INSTALLPRIVLIB
     INST_ARCHLIB to INSTALLARCHLIB
-    INST_EXE     to INSTALLBIN
+    INST_EXE     to INSTALLBIN    
     INST_MAN1DIR to INSTALLMAN1DIR
     INST_MAN3DIR to INSTALLMAN3DIR
 
@@ -3179,7 +3261,11 @@ is built. You can invoke the corresponding section of the makefile with
 
 That produces a new perl binary in the current directory with all
 extensions linked in that can be found in INST_ARCHLIB (which usually
-is C<./blib>) and PERL_ARCHLIB.
+is C<./blib>) and PERL_ARCHLIB. To do that, MakeMaker writes a new
+Makefile, on UNIX, this is called Makefile.aperl (may be system
+dependent). If you want to force the creation of a new perl, it is
+recommended, that you delete this Makefile.aperl, so INST_ARCHLIB and
+PERL_ARCHLIB are searched-through for linkable libraries again.
 
 The binary can be installed into the directory where perl normally
 resides on your machine with
@@ -3383,7 +3469,7 @@ Something like C<"-DHAVE_UNISTD_H">
 
 =item OBJECT
 
-List of object files, defaults to '$(BASEEXT).$(OBJ_EXT)', but can be a long
+List of object files, defaults to '$(BASEEXT)$(OBJ_EXT)', but can be a long
 string containing all object files, e.g. "tkpBind.o
 tkpButton.o tkpCanvas.o"
 
@@ -3452,6 +3538,12 @@ Hashref of .xs files. MakeMaker will default this.  e.g.
 The .c files will automatically be included in the list of files
 deleted by a make clean.
 
+=item XSOPT
+
+String of options to pass to xsubpp.  This might include C<-C++> or
+C<-extern>.  Do not include typemaps here; the TYPEMAP parameter exists for
+that purpose.
+
 =item C
 
 Ref to array of *.c file names. Initialised from a directory scan
@@ -3569,10 +3661,17 @@ Boolean which tells MakeMaker, that it should include the rules to
 make a perl. This is handled automatically as a switch by
 MakeMaker. The user normally does not need it.
 
+=item FIRST_MAKEFILE
+
 =item MAKEFILE
 
 The name of the Makefile to be produced.
 
+=item PERLMAINCC
+
+The call to the program that is able to compile perlmain.c. Defaults
+to $(CC).
+
 =back
 
 =head2 Additional lowercase attributes
@@ -3616,9 +3715,12 @@ holding together several subdirectories specify
   {TARFLAGS => 'cvfF', COMPRESS => 'gzip', SUFFIX => 'gz',
   SHAR => 'shar -m', DIST_CP => 'ln'}
 
-If you specify COMPRESS, then SUFFIX should also be altered, as it
-is needed to tell make the target file of the compression. DIST_CP
-can be useful, if you need to preserve the timestamps on your files.
+If you specify COMPRESS, then SUFFIX should also be altered, as it is
+needed to tell make the target file of the compression. Setting
+DIST_CP to ln can be useful, if you need to preserve the timestamps on
+your files. DIST_CP can take the values 'cp', which copies the file,
+'ln', which links the file, and 'best' which copies symbolic links and
+links the rest. Default is 'best'.
 
 =item tool_autosplit
 
@@ -3673,6 +3775,12 @@ reports which files are below the build directory but not in the
 MANIFEST file and vice versa. (See ExtUtils::Manifest::fullcheck() for
 details)
 
+=item    make skipcheck
+
+reports which files are skipped due to the entries in the
+C<MANIFEST.SKIP> file (See ExtUtils::Manifest::skipcheck() for
+details)
+
 =item    make distclean
 
 does a realclean first and then the distcheck. Note that this is not
@@ -3693,7 +3801,7 @@ exists, it will be removed first.
 =item	make disttest
 
 Makes a distdir first, and runs a C<perl Makefile.PL>, a make, and
-a make install in that directory.
+a make test in that directory.
 
 =item    make tardist
 
diff --git a/lib/ExtUtils/Manifest.pm b/lib/ExtUtils/Manifest.pm
index 027ead5e1b..d19b332c7a 100644
--- a/lib/ExtUtils/Manifest.pm
+++ b/lib/ExtUtils/Manifest.pm
@@ -16,6 +16,10 @@ C<ExtUtils::Manifest::filecheck;>
 
 C<ExtUtils::Manifest::fullcheck;>
 
+C<ExtUtils::Manifest::skipcheck;>
+
+C<ExtUtild::Manifest::manifind();>
+
 C<ExtUtils::Manifest::maniread($file);>
 
 C<ExtUtils::Manifest::manicopy($read,$target,$how);>
@@ -45,6 +49,12 @@ file will not be reported as missing in the C<MANIFEST> file.
 
 Fullcheck() does both a manicheck() and a filecheck().
 
+Skipcheck() lists all the files that are skipped due to your
+C<MANIFEST.SKIP> file.
+
+Manifind() retruns a hash reference. The keys of the hash are the
+files found below the current directory.
+
 Maniread($file) reads a named C<MANIFEST> file (defaults to
 C<MANIFEST> in the current directory) and returns a HASH reference
 with files being the keys and comments being the values of the HASH.
@@ -54,8 +64,10 @@ the HASH I<%$read> to the named target directory. The HASH reference
 I<$read> is typically returned by the maniread() function. This
 function is useful for producing a directory tree identical to the
 intended distribution tree. The third parameter $how can be used to
-specify a different system call to do the copying (eg. C<ln> instead
-of C<cp>, which is the default).
+specify a different methods of "copying". Valid values are C<cp>,
+which actually copies the files, C<ln> which creates hard links, and
+C<best> which mostly links the files but copies any symbolic link to
+make a tree without any symbolic link. Best is the default.
 
 =head1 MANIFEST.SKIP
 
@@ -124,8 +136,7 @@ $Debug = 0;
 $Verbose = 1;
 $Is_VMS = $Config{'osname'} eq 'VMS';
 
-($Version) = sprintf("%d.%02d", q$Revision: 1.11 $ =~ /(\d+)\.(\d+)/);
-$Version = $Version; #avoid warning
+$VERSION = $VERSION = substr(q$Revision: 1.15 $,10,4);
 
 $Quiet = 0;
 
@@ -157,7 +168,7 @@ sub mkmanifest {
 
 sub manifind {
     local $found = {};
-    find(sub {return if -d $File::Find::name;
+    find(sub {return if -d $_;
 	      (my $name = $File::Find::name) =~ s|./||;
 	      warn "Debug: diskfile $name\n" if $Debug;
 	      $name  =~ s#(.*)\.$#\L$1# if $Is_VMS;
@@ -339,4 +350,13 @@ sub ln {
     chmod(  $mode | ( $mode & 0100 ? 0111 : 0 ),  $_  );
 }
 
+sub best {
+    my ($srcFile, $dstFile) = @_;
+    if (-l $srcFile) {
+	cp($srcFile, $dstFile);
+    } else {
+	ln($srcFile, $dstFile);
+    }
+}
+
 1;
diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp
index 44a3bf191b..9ed4fe102f 100755
--- a/lib/ExtUtils/xsubpp
+++ b/lib/ExtUtils/xsubpp
@@ -65,7 +65,7 @@ perl(1), perlapi(1)
 =cut
 
 # Global Constants
-$XSUBPP_version = "1.922";
+$XSUBPP_version = "1.923";
 require 5.001;
 
 $usage = "Usage: xsubpp [-v] [-C++] [-except] [-s pattern] [-typemap typemap]... file.xs\n";
@@ -349,7 +349,7 @@ sub check_cpp {
 
 sub Q {
     my($text) = @_;
-    $text =~ tr/#//d;
+    $text =~ s/^#//gm;
     $text =~ s/\[\[/{/g;
     $text =~ s/\]\]/}/g;
     $text;
@@ -598,7 +598,8 @@ EOF
 
 	# do code
 	if (/^\s*NOT_IMPLEMENTED_YET/) {
-		print "\ncroak(\"$pname: not implemented yet\");\n";
+		print "\n\tcroak(\"$pname: not implemented yet\");\n";
+		$_ = '' ;
 	} else {
 		if ($ret_type ne "void") {
 			print "\t" . &map_type($ret_type) . "\tRETVAL;\n"
@@ -698,8 +699,10 @@ EOF
 }
 
 # print initialization routine
-print qq/extern "C"\n/ if $cplusplus;
 print Q<<"EOF";
+##ifdef __cplusplus
+#extern "C"
+##endif
 #XS(boot_$Module_cname)
 #[[
 #    dXSARGS;
diff --git a/lib/File/Find.pm b/lib/File/Find.pm
index ba495a140a..c151bcc891 100644
--- a/lib/File/Find.pm
+++ b/lib/File/Find.pm
@@ -63,6 +63,8 @@ that don't resolve:
 @ISA = qw(Exporter);
 @EXPORT = qw(find finddepth $name $dir);
 
+$dont_use_nlink = 1 if $Config{osname} =~ m:^os/?2$:i ;
+
 # Usage:
 #	use File::Find;
 #
@@ -236,7 +238,7 @@ sub finddepth {
 sub finddepthdir {
     my($wanted,$dir,$nlink) = @_;
     my($dev,$ino,$mode,$subcount);
-    my($name);
+    local($name); # so &wanted sees current value
 
     # Get the list of files in the current directory.
 
diff --git a/lib/File/Path.pm b/lib/File/Path.pm
index ec117b8de9..438a08e820 100644
--- a/lib/File/Path.pm
+++ b/lib/File/Path.pm
@@ -147,7 +147,10 @@ sub rmtree {
                next;
            }
            print "unlink $root\n" if $verbose;
-           (unlink($root) && ++$count) or carp "Can't unlink file $root: $!";
+           while (-e $root) { # delete all versions under VMS
+               (unlink($root) && ++$count)
+                   or carp "Can't unlink file $root: $!";
+           }
         }
     }
 
diff --git a/lib/IPC/Open3.pm b/lib/IPC/Open3.pm
index 8d324ccb62..db8652ee78 100644
--- a/lib/IPC/Open3.pm
+++ b/lib/IPC/Open3.pm
@@ -1,5 +1,5 @@
 package IPC::Open3;
-require 5.000;
+require 5.001;
 require Exporter;
 use Carp;
 
@@ -19,8 +19,8 @@ connects RDRFH for reading, WTRFH for writing, and ERRFH for errors.  If
 ERRFH is '', or the same as RDRFH, then STDOUT and STDERR of the child are
 on the same file handle.
 
-If WTRFH begins with ">&", then WTRFH will be closed in the parent, and
-the child will read from it directly.  if RDRFH or ERRFH begins with
+If WTRFH begins with "<&", then WTRFH will be closed in the parent, and
+the child will read from it directly.  If RDRFH or ERRFH begins with
 ">&", then the child will send output directly to that file handle.  In both
 cases, there will be a dup(2) instead of a pipe(2) made.
 
@@ -33,6 +33,7 @@ All caveats from open2() continue to apply.  See L<open2> for details.
 
 # &open3: Marc Horowitz <marc@mit.edu>
 # derived mostly from &open2 by tom christiansen, <tchrist@convex.com>
+# fixed for 5.001 by Ulrich Kunitz <kunitz@mai-koeln.com>
 #
 # $Id: open3.pl,v 1.1 1993/11/23 06:26:15 marc Exp $
 #
@@ -45,7 +46,7 @@ All caveats from open2() continue to apply.  See L<open2> for details.
 # of child, or 0 on failure.
 
 
-# if wtr begins with '>&', then wtr will be closed in the parent, and
+# if wtr begins with '<&', then wtr will be closed in the parent, and
 # the child will read from it directly.  if rdr or err begins with
 # '>&', then the child will send output directly to that fd.  In both
 # cases, there will be a dup() instead of a pipe() made.
@@ -63,27 +64,27 @@ All caveats from open2() continue to apply.  See L<open2> for details.
 $fh = 'FHOPEN000';  # package static in case called more than once
 
 sub open3 {
-    local($kidpid);
-    local($dad_wtr, $dad_rdr, $dad_err, @cmd) = @_;
-    local($dup_wtr, $dup_rdr, $dup_err);
+    my($kidpid);
+    my($dad_wtr, $dad_rdr, $dad_err, @cmd) = @_;
+    my($dup_wtr, $dup_rdr, $dup_err);
 
     $dad_wtr			|| croak "open3: wtr should not be null";
     $dad_rdr			|| croak "open3: rdr should not be null";
     $dad_err = $dad_rdr if ($dad_err eq '');
 
-    $dup_wtr = ($dad_wtr =~ s/^\>\&//);
-    $dup_rdr = ($dad_rdr =~ s/^\>\&//);
-    $dup_err = ($dad_err =~ s/^\>\&//);
+    $dup_wtr = ($dad_wtr =~ s/^[<>]&//);
+    $dup_rdr = ($dad_rdr =~ s/^[<>]&//);
+    $dup_err = ($dad_err =~ s/^[<>]&//);
 
     # force unqualified filehandles into callers' package
-    local($package) = caller;
-    $dad_wtr =~ s/^[^']+$/$package'$&/;
-    $dad_rdr =~ s/^[^']+$/$package'$&/;
-    $dad_err =~ s/^[^']+$/$package'$&/;
+    my($package) = caller;
+    $dad_wtr =~ s/^[^:]+$/$package\:\:$&/;
+    $dad_rdr =~ s/^[^:]+$/$package\:\:$&/;
+    $dad_err =~ s/^[^:]+$/$package\:\:$&/;
 
-    local($kid_rdr) = ++$fh;
-    local($kid_wtr) = ++$fh;
-    local($kid_err) = ++$fh;
+    my($kid_rdr) = ++$fh;
+    my($kid_wtr) = ++$fh;
+    my($kid_err) = ++$fh;
 
     if (!$dup_wtr) {
 	pipe($kid_rdr, $dad_wtr)    || croak "open3: pipe 1 (stdin) failed: $!";
@@ -99,10 +100,10 @@ sub open3 {
         croak "open2: fork failed: $!";
     } elsif ($kidpid == 0) {
 	if ($dup_wtr) {
-	    open(STDIN,  ">&$dad_wtr") if (fileno(STDIN) != fileno($dad_wtr));
+	    open(STDIN,  "<&$dad_wtr") if (fileno(STDIN) != fileno($dad_wtr));
 	} else {
 	    close($dad_wtr);
-	    open(STDIN,  ">&$kid_rdr");
+	    open(STDIN,  "<&$kid_rdr");
 	}
 	if ($dup_rdr) {
 	    open(STDOUT, ">&$dad_rdr") if (fileno(STDOUT) != fileno($dad_rdr));
diff --git a/lib/Shell.pm b/lib/Shell.pm
index 8098bf2892..021f175947 100644
--- a/lib/Shell.pm
+++ b/lib/Shell.pm
@@ -1,5 +1,7 @@
 package Shell;
 
+use Config;
+
 sub import {
     my $self = shift;
     my ($callpack, $callfile, $callline) = caller;
@@ -20,8 +22,36 @@ AUTOLOAD {
     $cmd =~ s/^.*:://;
     eval qq {
 	sub $AUTOLOAD {
-	    if (\@_ < 2) {
-		`$cmd \@_`;
+	    if (\@_ < 1) {
+		`$cmd`;
+	    }
+	    elsif (\$Config{'archname'} eq 'os2') {
+		local(\*SAVEOUT, \*READ, \*WRITE);
+
+		open SAVEOUT, '>&STDOUT' or die;
+		pipe READ, WRITE or die;
+		open STDOUT, '>&WRITE' or die;
+		close WRITE;
+
+		my \$pid = system(1, \$cmd, \@_);
+		die "Can't execute $cmd: \$!\n" if \$pid < 0;
+
+		open STDOUT, '>&SAVEOUT' or die;
+		close SAVEOUT;
+
+		if (wantarray) {
+		    my \@ret = <READ>;
+		    close READ;
+		    waitpid \$pid, 0;
+		    \@ret;
+		}
+		else {
+		    local(\$/) = undef;
+		    my \$ret = <READ>;
+		    close READ;
+		    waitpid \$pid, 0;
+		    \$ret;
+		}
 	    }
 	    else {
 		open(SUBPROC, "-|")
diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm
index 8422f8e4bc..635febdca5 100644
--- a/lib/Test/Harness.pm
+++ b/lib/Test/Harness.pm
@@ -2,6 +2,13 @@ package Test::Harness;
 
 use Exporter;
 use Benchmark;
+use Config;
+
+$Is_OS2 = $Config{'osname'} =~ m|^os/?2$|i ;
+
+$ENV{EMXSHELL} = 'sh' if $Is_OS2; # to run commands
+$path_s = $Is_OS2 ? ';' : ':' ;
+
 @ISA=(Exporter);
 @EXPORT= qw(&runtests &test_lib);
 @EXPORT_OK= qw($verbose $switches);
@@ -16,7 +23,7 @@ sub runtests {
     my $bad = 0;
     my $good = 0;
     my $total = @tests;
-    local($ENV{'PERL5LIB'}) = join(':', @INC); # pass -I flags to children
+    local($ENV{'PERL5LIB'}) = join($path_s, @INC); # pass -I flags to children
 
     my $t_start = new Benchmark;
     while ($test = shift(@tests)) {
@@ -69,7 +76,7 @@ sub runtests {
     } else {
       $pct = sprintf("%.2f", $good / $total * 100);
       if ($bad == 1) {
-          warn "Failed 1 test, $pct% okay.\n";
+          die "Failed 1 test, $pct% okay.\n";
       } else {
           die "Failed $bad/$total tests, $pct% okay.\n";
       }
diff --git a/lib/Text/Tabs.pm b/lib/Text/Tabs.pm
index fa866988cf..7cfb478b75 100644
--- a/lib/Text/Tabs.pm
+++ b/lib/Text/Tabs.pm
@@ -2,11 +2,13 @@
 # expand and unexpand tabs as per the unix expand and 
 # unexpand programs.
 #
-# expand and unexpand operate on arrays of lines.  
+# expand and unexpand operate on arrays of lines.  Do not
+# feed strings that contain newlines to them.
 #
 # David Muir Sharnoff <muir@idiom.com>
-# Version: 4/19/95
 # 
+# Version: 9/21/95
+#
 
 package Text::Tabs;
 
@@ -19,45 +21,31 @@ $tabstop = 8;
 
 sub expand
 {
-	my (@l) = @_;
-	my $l, @k;
-	my $nl;
-	for $l (@l) {
-		$nl = $/ if chomp($l);
-		@k = split($/,$l);
-		for $_ (@k) {
-			1 while s/^([^\t]*)(\t+)/
-				$1 . (" " x 
-					($tabstop * length($2)
-					- (length($1) % $tabstop)))
-				/e;
-		}
-		$l = join("\n",@k).$nl;
+	my @l = @_;
+	for $_ (@l) {
+		1 while s/^([^\t]*)(\t+)/
+			$1 . (" " x 
+				($tabstop * length($2)
+				- (length($1) % $tabstop)))
+			/e;
 	}
-	return @l if $#l > 0;
-	return $l[0];
+	return @l if wantarray;
+	return @l[0];
 }
 
 sub unexpand
 {
-	my (@l) = &expand(@_);
+	my @l = &expand(@_);
 	my @e;
-	my $k, @k;
-	my $nl;
-	for $k (@l) {
-		$nl = $/ if chomp($k);
-		@k = split($/,$k);
-		for $x (@k) {
-			@e = split(/(.{$tabstop})/,$x);
-			for $_ (@e) {
-				s/  +$/\t/;
-			}
-			$x = join('',@e);
+	for $x (@l) {
+		@e = split(/(.{$tabstop})/,$x);
+		for $_ (@e) {
+			s/  +$/\t/;
 		}
-		$k = join("\n",@k).$nl;
+		$x = join('',@e);
 	}
-	return @l if $#l > 0;
-	return $l[0];
+	return @l if wantarray;
+	return @l[0];
 }
 
 1;
diff --git a/lib/Text/Wrap.pm b/lib/Text/Wrap.pm
new file mode 100644
index 0000000000..9b1d054704
--- /dev/null
+++ b/lib/Text/Wrap.pm
@@ -0,0 +1,68 @@
+
+package Text::Wrap;
+
+#
+# This is a very simple paragraph formatter.  It formats one 
+# paragraph at a time by wrapping and indenting text.
+#
+# Usage:
+#
+#	use Text::Wrap;
+#
+#	print wrap($initial_tab,$subsequent_tab,@text);
+#
+# You can also set the number of columns to wrap before:
+#
+#	$Text::Wrap::columns = 135; # <= width of screen
+#
+#	use Text::Wrap qw(wrap $columns); 
+#	$columns = 70;
+#	
+#
+# The first line will be printed with $initial_tab prepended.  All
+# following lines will have $subsequent_tab prepended.
+#
+# Example:
+#
+#	print wrap("\t","","This is a bit of text that ...");
+#
+# David Muir Sharnoff <muir@idiom.com>
+# Version: 9/21/95
+#
+
+require Exporter;
+
+@ISA = (Exporter);
+@EXPORT = qw(wrap);
+@EXPORT_OK = qw($columns);
+
+BEGIN	{
+	$Text::Wrap::columns = 76;  # <= screen width
+}
+
+use Text::Tabs;
+use strict;
+
+sub wrap
+{
+	my ($ip, $xp, @t) = @_;
+
+	my $r;
+	my $t = expand(join(" ",@t));
+	my $lead = $ip;
+	my $ll = $Text::Wrap::columns - length(expand($lead)) - 1;
+	if ($t =~ s/^([^\n]{0,$ll})\s//) {
+		$r .= unexpand($lead . $1 . "\n");
+		$lead = $xp;
+		my $ll = $Text::Wrap::columns - length(expand($lead)) - 1;
+		while ($t =~ s/^([^\n]{0,$ll})\s//) {
+			$r .= unexpand($lead . $1 . "\n");
+		}
+	} 
+	die "couldn't wrap '$t'" 
+		if length($t) > $ll;
+	$r .= $t;
+	return $r;
+}
+
+1;
diff --git a/lib/TieHash.pm b/lib/TieHash.pm
index 1abbe8379a..446cbcb25b 100644
--- a/lib/TieHash.pm
+++ b/lib/TieHash.pm
@@ -2,27 +2,27 @@ package TieHash;
 use Carp;
 
 sub new {
-    my $pack = shift;
-    $pack->TIEHASH(@_);
+    my $pkg = shift;
+    $pkg->TIEHASH(@_);
 }
 
 # Grandfather "new"
 
 sub TIEHASH {
-    my $pack = shift;
-    if (defined &{"$pack\::new"}) {
-	carp "WARNING: calling $pack\->new since $pack\->TIEHASH is missing"
+    my $pkg = shift;
+    if (defined &{"{$pkg}::new"}) {
+	carp "WARNING: calling ${pkg}->new since ${pkg}->TIEHASH is missing"
 	    if $^W;
-	$pack->new(@_);
+	$pkg->new(@_);
     }
     else {
-	croak "$pack doesn't define a TIEHASH method";
+	croak "$pkg doesn't define a TIEHASH method";
     }
 }
 
 sub EXISTS {
-    my $pack = ref $_[0];
-    croak "$pack doesn't define an EXISTS method";
+    my $pkg = ref $_[0];
+    croak "$pkg doesn't define an EXISTS method";
 }
 
 sub CLEAR {
diff --git a/lib/diagnostics.pm b/lib/diagnostics.pm
new file mode 100755
index 0000000000..073a456c81
--- /dev/null
+++ b/lib/diagnostics.pm
@@ -0,0 +1,502 @@
+#!/usr/local/bin/perl
+eval 'exec perl -S $0  ${1+"$@"}'
+    if $0;
+
+use Config;
+$diagnostics::PODFILE= $Config{privlib} . "/pod/perldiag.pod";
+
+package diagnostics;
+require 5.001;
+use English;
+use Carp;
+
+=head1 NAME
+
+diagnostics - Perl compiler pragma to force verbose warning diagnostics
+
+splain - standalone program to do the same thing
+
+=head1 SYNOPSIS
+
+As a pragma:
+
+    use diagnostics;
+    use diagnostics -verbose;
+
+    enable  diagnostics;
+    disable diagnostics;
+
+Aa a program:
+
+    perl program 2>diag.out
+    splain [-v] [-p] diag.out
+
+
+=head1 DESCRIPTION
+
+=head2 The C<diagnostics> Pragma
+
+This module extends the terse diagnostics normally emitted by both the
+perl compiler and the perl interpeter, augmenting them wtih the more
+explicative and endearing descriptions found in L<perldiag>.  Like the
+other pragmata, it affects to compilation phase of your program rather
+than merely the execution phase.
+
+To use in your program as a pragma, merely invoke
+
+    use diagnostics;
+
+at the start (or near the start) of your program.  (Note 
+that this I<does> enable perl's B<-w> flag.)  Your whole
+compilation will then be subject(ed :-) to the enhanced diagnostics.
+These still go out B<STDERR>.
+
+Due to the interaction between runtime and compiletime issues,
+and because it's probably not a very good idea anyway,
+you may not use C<no diagnostics> to turn them off at compiletime.
+However, you may control there behaviour at runtime using the 
+disable() and enable() methods to turn them off and on respectively.
+
+The B<-verbose> flag first prints out the L<perldiag> introduction before
+any other diagnostics.  The $diagnostics::PRETTY can generate nicer escape
+sequences for pgers.
+
+=head2 The I<splain> Program
+
+While apparently a whole nuther program, I<splain> is actually nothing
+more than a link to the (executable) F<diagnostics.pm> module, as well as
+a link to the F<diagnostics.pod> documentation.  The B<-v> flag is like
+the C<use diagnostics -verbose> directive.
+The B<-p> flag is like the
+$diagnostics::PRETTY variable.  Since you're post-processing with 
+I<splain>, there's no sense in being able to enable() or disable() processing.
+
+Output from I<splain> is directed to B<STDOUT>, unlike the pragma.
+
+=head1 EXAMPLES
+
+The following file is certain to trigger a few errors at both
+runtime and compiletime:
+
+    use diagnostics;
+    print NOWHERE "nothing\n";
+    print STDERR "\n\tThis message should be unadorned.\n";
+    warn "\tThis is a user warning";
+    print "\nDIAGNOSTIC TESTER: Please enter a <CR> here: ";
+    my $a, $b = scalar <STDIN>;
+    print "\n";
+    print $x/$y;
+
+If you prefer to run your program first and look at its problem
+afterwards, do this:
+
+    perl -w test.pl 2>test.out
+    ./splain < test.out
+
+Note that this is not in general possible in shells of more dubious heritage, 
+as the theorectical 
+
+    (perl -w test.pl >/dev/tty) >& test.out
+    ./splain < test.out
+
+Because you just moved the existing B<stdout> to somewhere else.
+
+If you don't want to modify your source code, but still have on-the-fly
+warnings, do this:
+
+    exec 3>&1; perl -w test.pl 2>&1 1>&3 3>&- | splain 1>&2 3>&- 
+
+Nifty, eh?
+
+If you want to control warnings on the fly, do something like this.
+Make sure you do the C<use> first, or you won't be able to get
+at the enable() or disable() methods.
+
+    use diagnostics; # checks entire compilation phase 
+	print "\ntime for 1st bogus diags: SQUAWKINGS\n";
+	print BOGUS1 'nada';
+	print "done with 1st bogus\n";
+
+    disable diagnostics; # only turns off runtime warnings
+	print "\ntime for 2nd bogus: (squelched)\n";
+	print BOGUS2 'nada';
+	print "done with 2nd bogus\n";
+
+    enable diagnostics; # turns back on runtime warnings
+	print "\ntime for 3rd bogus: SQUAWKINGS\n";
+	print BOGUS3 'nada';
+	print "done with 3rd bogus\n";
+
+    disable diagnostics;
+	print "\ntime for 4th bogus: (squelched)\n";
+	print BOGUS4 'nada';
+	print "done with 4th bogus\n";
+
+=head1 INTERNALS
+
+Diagnostic messages derive from the F<perldiag.pod> file when available at
+runtime.  Otherwise, they may be embedded in the file itself when the
+splain package is built.   See the F<Makefile> for details.
+
+If an extant $SIG{__WARN__} handler is discovered, it will continue
+to be honored, but only after the diagnostic::splainthis() function 
+(the module's $SIG{__WARN__} interceptor) has had its way with your
+warnings.
+
+There is a $diagnostics::DEBUG variable you may set if you're desperately
+curious what sorts of things are being intercepted.
+
+    BEGIN { $diagnostics::DEBUG = 1 } 
+
+
+=head1 BUGS
+
+Not being able to say "no diagnostics" is annoying, but may not be
+insurmountable.
+
+The C<-pretty> directive is called too late to affect matters.
+You have to to this instead, and I<before> you load the module.
+
+    BEGIN { $diagnostics::PRETTY = 1 } 
+
+I could start up faster by delaying compilation until it should be
+needed, but this gets a "panic: top_level"
+when using the pragma form in 5.001e.  
+
+While it's true that this documentation is somewhat subserious, if you use
+a program named I<splain>, you should expect a bit of whimsy.
+
+=head1 AUTHOR
+
+Tom Christiansen F<E<lt>tchrist@mox.perl.comE<gt>>, 25 June 1995.
+
+=cut
+
+$DEBUG ||= 0;
+my $WHOAMI = ref bless [];  # nobody's business, prolly not even mine
+
+$OUTPUT_AUTOFLUSH = 1;
+
+local $_;
+
+CONFIG: {
+    $opt_p = $opt_d = $opt_v = $opt_f = '';
+    %HTML_2_Troff = %HTML_2_Latin_1 = %HTML_2_ASCII_7 = ();  
+    %exact_duplicate = ();
+
+    unless (caller) { 
+	$standalone++;
+	require Getopt::Std;
+	Getopt::Std::getopts('pdvf:') || die "Usage: $0 [-v] [-p] [-f splainpod]";
+	$PODFILE = $opt_f if $opt_f;
+	$DEBUG = 2 if $opt_d;
+	$VERBOSE = $opt_v;
+	$PRETTY = $opt_p;
+    } 
+
+    if (open(POD_DIAG, $PODFILE)) {
+	warn "Happy happy podfile from real $PODFILE\n" if $DEBUG;
+	last CONFIG;
+    } 
+
+    if (caller) {
+	INCPATH: {
+	    for $file ( (map { "$_/$WHOAMI.pm" } @INC), $0) {
+		warn "Checking $file\n" if $DEBUG;
+		if (open(POD_DIAG, $file)) {
+		    while (<POD_DIAG>) {
+			next unless /^__END__\s*# wish diag dbase were more accessible/;
+			print STDERR "podfile is $file\n" if $DEBUG;
+			last INCPATH;
+		    }
+		}
+	    } 
+	}
+    } else { 
+	print STDERR "podfile is <DATA>\n" if $DEBUG;
+	*POD_DIAG = *main::DATA;
+    }
+}
+if (eof(POD_DIAG)) { 
+    die "couldn't find diagnostic data in $PODFILE @INC $0";
+}
+
+
+%HTML_2_Troff = (
+    'amp'	=>	'&',	#   ampersand
+    'lt'	=>	'<',	#   left chevron, less-than
+    'gt'	=>	'>',	#   right chevron, greater-than
+    'quot'	=>	'"',	#   double quote
+
+    "Aacute"	=>	"A\\*'",	#   capital A, acute accent
+    # etc
+
+);
+
+%HTML_2_Latin_1 = (
+    'amp'	=>	'&',	#   ampersand
+    'lt'	=>	'<',	#   left chevron, less-than
+    'gt'	=>	'>',	#   right chevron, greater-than
+    'quot'	=>	'"',	#   double quote
+
+    "Aacute"	=>	"\xC1"	#   capital A, acute accent
+
+    # etc
+);
+
+%HTML_2_ASCII_7 = (
+    'amp'	=>	'&',	#   ampersand
+    'lt'	=>	'<',	#   left chevron, less-than
+    'gt'	=>	'>',	#   right chevron, greater-than
+    'quot'	=>	'"',	#   double quote
+
+    "Aacute"	=>	"A"	#   capital A, acute accent
+    # etc
+);
+
+*HTML_Escapes = do {
+    if ($standalone) {
+	$PRETTY ? \%HTML_2_Latin_1 : \%HTML_2_ASCII_7; 
+    } else {
+	\%HTML_2_Latin_1; 
+    }
+}; 
+
+*THITHER = $standalone ? *STDOUT : *STDERR;
+
+$transmo = <<EOFUNC;
+sub transmo {
+    local \$^W = 0;  # recursive warnings we do NOT need!
+    study;
+EOFUNC
+
+### sub finish_compilation {  # 5.001e panic: top_level for embedded version
+    print STDERR "FINISHING COMPILATION for $_\n" if $DEBUG;
+    ### local 
+    $RS = '';
+    local $_;
+    while (<POD_DIAG>) {
+	#s/(.*)\n//;
+	#$header = $1;
+
+	unescape();
+	if ($PRETTY) {
+	    sub noop   { return $_[0] }  # spensive for a noop
+	    sub bold   { my $str =$_[0];  $str =~ s/(.)/$1\b$1/g; return $str; } 
+	    sub italic { my $str = $_[0]; $str =~ s/(.)/_\b$1/g;  return $str; } 
+	    s/[BC]<(.*?)>/bold($1)/ges;
+	    s/[LIF]<(.*?)>/italic($1)/ges;
+	} else {
+	    s/[BC]<(.*?)>/$1/gs;
+	    s/[LIF]<(.*?)>/$1/gs;
+	} 
+	unless (/^=/) {
+	    if (defined $header) { 
+		if ( $header eq 'DESCRIPTION' && 
+		    (   /Optional warnings are enabled/ 
+		     || /Some of these messages are generic./
+		    ) )
+		{
+		    next;
+		} 
+		s/^/    /gm;
+		$msg{$header} .= $_;
+	    }
+	    next;
+	} 
+	unless ( s/=item (.*)\s*\Z//) {
+
+	    if ( s/=head1\sDESCRIPTION//) {
+		$msg{$header = 'DESCRIPTION'} = '';
+	    }
+	    next;
+	}
+	$header = $1;
+
+	if ($header =~ /%[sd]/) {
+	    $rhs = $lhs = $header;
+	    #if ($lhs =~ s/(.*?)%d(?!%d)(.*)/\Q$1\E\\d+\Q$2\E\$/g)  {
+	    if ($lhs =~ s/(.*?)%d(?!%d)(.*)/\Q$1\E\\d+\Q$2\E/g)  {
+		$lhs =~ s/\\%s/.*?/g;
+	    } else {
+		# if i had lookbehind negations, i wouldn't have to do this \377 noise
+		$lhs =~ s/(.*?)%s/\Q$1\E.*?\377/g;
+		#$lhs =~ s/\377([^\377]*)$/\Q$1\E\$/;
+		$lhs =~ s/\377([^\377]*)$/\Q$1\E/;
+		$lhs =~ s/\377//g;
+	    } 
+	    $transmo .= "    s{^$lhs}\n     {\Q$rhs\E}\n\t&& return 1;\n";
+	} else {
+	    $transmo .= "    m{^\Q$header\E} && return 1;\n";
+	} 
+
+	print STDERR "Already saw $header" if $msg{$header};
+
+	$msg{$header} = '';
+    } 
+
+
+    close POD_DIAG unless *main::DATA eq *POD_DIAG;
+
+    die "No diagnostics?" unless %msg;
+
+    $transmo .= "    return 0;\n}\n";
+    print STDERR $transmo if $DEBUG;
+    eval $transmo;
+    die $@ if $@;
+    $RS = "\n";
+### }
+
+if ($standalone) {
+    if (!@ARGV and -t STDIN) { print STDERR "$0: Reading from STDIN\n" } 
+    while ($error = <>) {
+	splainthis($error) || print THITHER $error;
+    } 
+    exit;
+} else { 
+    $old_w = 0; $oldwarn = ''; $olddie = '';
+}
+
+sub import {
+    shift;
+    $old_w = $^W;
+    $^W = 1; # yup, clobbered the global variable; tough, if you
+	     # want diags, you want diags.
+    return if $SIG{__WARN__} eq \&warn_trap;
+
+    for (@_) {
+
+	/^-d(ebug)?$/ 	   	&& do {
+				    $DEBUG++;
+				    next;
+				   };
+
+	/^-v(erbose)?$/ 	&& do {
+				    $VERBOSE++;
+				    next;
+				   };
+
+	/^-p(retty)?$/ 		&& do {
+				    print STDERR "$0: I'm afraid it's too late for prettiness.\n";
+				    $PRETTY++;
+				    next;
+			       };
+
+	warn "Unknown flag: $_";
+    } 
+
+    $oldwarn = $SIG{__WARN__};
+    $olddie = $SIG{__DIE__};
+    $SIG{__WARN__} = \&warn_trap;
+    $SIG{__DIE__} = \&death_trap;
+} 
+
+sub enable { &import }
+
+sub disable {
+    shift;
+    $^W = $old_w;
+    return unless $SIG{__WARN__} eq \&warn_trap;
+    $SIG{__WARN__} = $oldwarn;
+    $SIG{__DIE__} = $olddie;
+} 
+
+sub warn_trap {
+    my $warning = $_[0];
+    if (caller eq $WHOAMI or !splainthis($warning)) {
+	print STDERR $warning;
+    } 
+    &$oldwarn if $oldwarn and $oldwarn ne \&warn_trap;
+};
+
+sub death_trap {
+    my $exception = $_[0];
+    splainthis($exception);
+    if (caller eq $WHOAMI) { print STDERR "INTERNAL EXCEPTION: $exception"; } 
+    &$olddie if defined $olddie and $olddie ne \&death_trap;
+    $SIG{__DIE__} = $SIG{__WARN__} = '';
+    confess "Uncaught exception from user code:\n\t$exception    Bailing out";
+	# up we go; where we stop, nobody knows, but i think we die now
+	# but i'm deeply afraid of the &$olddie guy reraising and us getting
+	# into an indirect recursion loop
+};
+
+sub splainthis {
+    local $_ = shift;
+    ### &finish_compilation unless %msg;
+    s/\.?\n+$//;
+    my $orig = $_;
+    # return unless defined;
+    if ($exact_duplicate{$_}++) {
+	return 1;
+    } 
+    s/, <.*?> (?:line|chunk).*$//;
+    $real = s/(.*?) at .*? (?:line|chunk) \d+.*/$1/;
+    s/^\((.*)\)$/$1/;
+    return 0 unless &transmo;
+    $orig = shorten($orig);
+    if ($old_diag{$_}) {
+	autodescribe();
+	print THITHER "$orig (#$old_diag{$_})\n";
+	$wantspace = 1;
+    } else {
+	autodescribe();
+	$old_diag{$_} = ++$count;
+	print THITHER "\n" if $wantspace;
+	$wantspace = 0;
+	print THITHER "$orig (#$old_diag{$_})\n";
+	if ($msg{$_}) {
+	    print THITHER $msg{$_};
+	} else {
+	    if (0 and $standalone) { 
+		print THITHER "    **** Error #$old_diag{$_} ",
+			($real ? "is" : "appears to be"),
+			" an unknown diagnostic message.\n\n";
+	    }
+	    return 0;
+	} 
+    }
+    return 1;
+} 
+
+sub autodescribe {
+    if ($VERBOSE and not $count) {
+	print THITHER &{$PRETTY ? \&bold : \&noop}("DESCRIPTION OF DIAGNOSTICS"),
+		"\n$msg{DESCRIPTION}\n";
+    } 
+} 
+
+sub unescape { 
+    s {
+            E<  
+            ( [A-Za-z]+ )       
+            >   
+    } { 
+         do {   
+             exists $HTML_Escapes{$1}
+                ? do { $HTML_Escapes{$1} }
+                : do {
+                    warn "Unknown escape: $& in $_";
+                    "E<$1>";
+                } 
+         } 
+    }egx;
+}
+
+sub shorten {
+    my $line = $_[0];
+    if (length $line > 79) {
+	my $space_place = rindex($line, ' ', 79);
+	if ($space_place != -1) {
+	    substr($line, $space_place, 1) = "\n\t";
+	} 
+    } 
+    return $line;
+} 
+
+
+# have to do this: RS isn't set until run time, but we're executing at compile time
+$RS = "\n";
+
+1 unless $standalone;  # or it'll complain about itself
+__END__ # wish diag dbase were more accessible
diff --git a/lib/dotsh.pl b/lib/dotsh.pl
index 4db85e742b..8e9d9620e5 100644
--- a/lib/dotsh.pl
+++ b/lib/dotsh.pl
@@ -59,7 +59,7 @@ sub dotsh {
    close (_SH_ENV);
    system "rm -f /tmp/_sh_env$$";
 
-   foreach $key (keys(ENV)) {
+   foreach $key (keys(%ENV)) {
        $tmp .= "\$$key = \$ENV{'$key'};" if $key =~ /^[A-Za-z]\w*$/;
    }
    eval $tmp;
diff --git a/lib/lib.pm b/lib/lib.pm
index a0fe89b13d..ab19426b04 100644
--- a/lib/lib.pm
+++ b/lib/lib.pm
@@ -1,12 +1,21 @@
 package lib;
 
+use Config;
+
+my $archname = $Config{'archname'};
+
 @ORIG_INC = ();		# (avoid typo warning)
 @ORIG_INC = @INC;	# take a handy copy of 'original' value
 
 
 sub import {
     shift;
-    unshift(@INC, @_);
+    foreach (@_) {
+	unshift(@INC, $_);
+	# Put a corresponding archlib directory infront of $_ if it
+	# looks like $_ has an archlib directory below it.
+	unshift(@INC, "$_/$archname") if -d "$_/$archname/auto";
+    }
 }
 
 
@@ -15,7 +24,10 @@ sub unimport {
     my $mode = shift if $_[0] =~ m/^:[A-Z]+/;
 
     my %names;
-    foreach(@_) { ++$names{$_} };
+    foreach(@_) {
+	++$names{$_};
+	++$names{"$_/$archname"} if -d "$_/$archname/auto";
+    }
 
     if ($mode and $mode eq ':ALL') {
 	# Remove ALL instances of each named directory.
@@ -26,6 +38,7 @@ sub unimport {
     }
 }
 
+1;
 __END__
 
 =head1 NAME
@@ -55,10 +68,18 @@ path. Saying
 
     use lib LIST;
 
-is the same as saying
+is I<almost> the same as saying
 
     BEGIN { unshift(@INC, LIST) }
 
+For each directory in LIST (called $dir here) the lib module also
+checks to see if a directory called $dir/$archname/auto exists.
+If so the $dir/$archname directory is assumed to be a corresponding
+architecture specific directory and is added to @INC in front of $dir.
+
+If LIST includes both $dir and $dir/$archname then $dir/$archname will
+be added to @INC twice (if $dir/$archname/auto exists).
+
 
 =head2 DELETING DIRECTORIES FROM @INC
 
@@ -77,19 +98,23 @@ specify ':ALL' as the first parameter of C<no lib>. For example:
 
     no lib qw(:ALL .);
 
+For each directory in LIST (called $dir here) the lib module also
+checks to see if a directory called $dir/$archname/auto exists.
+If so the $dir/$archname directory is assumed to be a corresponding
+architecture specific directory and is also deleted from @INC.
+
+If LIST includes both $dir and $dir/$archname then $dir/$archname will
+be deleted from @INC twice (if $dir/$archname/auto exists).
+
 
 =head2 RESTORING ORIGINAL @INC
 
 When the lib module is first loaded it records the current value of @INC
 in an array C<@lib::ORIG_INC>. To restore @INC to that value you
-can say either
+can say
 
     @INC = @lib::ORIG_INC;
 
-or
-
-    no  lib @INC;
-    use lib @lib::ORIG_INC;
 
 =head1 SEE ALSO
 
diff --git a/lib/overload.pm b/lib/overload.pm
new file mode 100644
index 0000000000..3c9562aca5
--- /dev/null
+++ b/lib/overload.pm
@@ -0,0 +1,489 @@
+package overload;
+
+sub OVERLOAD {
+  $package = shift;
+  my %arg = @_;
+  my $hash = \%{$package . "::OVERLOAD"};
+  for (keys %arg) {
+    $hash->{$_} = $arg{$_};
+  }
+}
+
+sub import {
+  $package = (caller())[0];
+  # *{$package . "::OVERLOAD"} = \&OVERLOAD;
+  shift;
+  $package->overload::OVERLOAD(@_);
+}
+
+sub unimport {
+  $package = (caller())[0];
+  my $hash = \%{$package . "::OVERLOAD"};
+  shift;
+  for (@_) {
+    delete $hash->{$_};
+  }
+}
+
+sub Overloaded {
+  defined ($package = ref $_[0]) and defined %{$package . "::OVERLOAD"};
+}
+
+sub OverloadedStringify {
+  defined ($package = ref $_[0]) and 
+    defined %{$package . "::OVERLOAD"} and 
+      exists $ {$package . "::OVERLOAD"}{'""'} and
+	defined &{$ {$package . "::OVERLOAD"}{'""'}};
+}
+
+sub Method {
+  defined ($package = ref $_[0]) and 
+    defined %{$package . "::OVERLOAD"} and 
+      $ {$package . "::OVERLOAD"}{$_[1]};
+}
+
+sub AddrRef {
+  $package = ref $_[0];
+  bless $_[0], Overload::Fake;	# Non-overloaded package
+  my $str = "$_[0]";
+  bless $_[0], $package;	# Back
+  $str;
+}
+
+sub StrVal {
+  (OverloadedStringify) ?
+    (AddrRef) :
+    "$_[0]";
+}
+
+1;
+
+__END__
+
+=head1 NAME 
+
+C<overload.pm> - Package for overloading perl operations
+
+=head1 SYNOPSIS
+
+    package SomeThing;
+
+    use overload 
+	'+' => \&myadd,
+	'-' => \&mysub;
+	# etc
+    ...
+
+    package main;
+    $a = new SomeThing 57;
+    $b=5+$a;
+    ...
+    if (overload::Overloaded $b) {...}
+    ...
+    $strval = overload::StrVal $b;
+
+=head1 CAVEAT SCRIPTOR
+
+Overloading of operators is a subject not to be taken lightly.
+Neither its precise implementation, syntax, nor semantics are
+100% endorsed by Larry Wall.  So any of these may be changed 
+at some point in the future.
+
+=head1 DESCRIPTION
+
+=head2 Declaration of overloaded functions
+
+The compilation directive
+
+    package Number;
+    use overload
+	"+" => \&add, 
+	"*=" => "muas";
+
+declares function Number::add() for addition, and method muas() in
+the "class" C<Number> (or one of its base classes)
+for the assignment form C<*=> of multiplication.  
+
+Arguments of this directive come in (key, value) pairs.  Legal values
+are values legal inside a C<&{ ... }> call, so the name of a subroutine,
+a reference to a subroutine, or an anonymous subroutine will all work.
+Legal keys are listed below.
+
+The subroutine C<add> will be called to execute C<$a+$b> if $a
+is a reference to an object blessed into the package C<Number>, or if $a is
+not an object from a package with defined mathemagic addition, but $b is a
+reference to a C<Number>.  It can also be called in other situations, like
+C<$a+=7>, or C<$a++>.  See L<MAGIC AUTOGENERATION>.  (Mathemagical
+methods refer to methods triggered by an overloaded mathematical
+operator.)
+
+=head2 Calling Conventions for Binary Operations
+
+The functions specified in the C<use overload ...> directive are called
+with three (in one particular case with four, see L<Last Resort>)
+arguments.  If the corresponding operation is binary, then the first
+two arguments are the two arguments of the operation.  However, due to
+general object calling conventions, the first argument should always be
+an object in the package, so in the situation of C<7+$a>, the
+order of the arguments is interchanged.  It probably does not matter
+when implementing the addition method, but whether the arguments
+are reversed is vital to the subtraction method.  The method can
+query this information by examining the third argument, which can take
+three different values:
+
+=over 7
+
+=item FALSE
+
+the order of arguments is as in the current operation.
+
+=item TRUE
+
+the arguments are reversed.
+
+=item C<undef>
+
+the current operation is an assignment variant (as in
+C<$a+=7>), but the usual function is called instead.  This additional
+information can be used to generate some optimizations.
+
+=back
+
+=head2 Calling Conventions for Unary Operations
+
+Unary operation are considered binary operations with the second
+argument being C<undef>.  Thus the functions that overloads C<{"++"}>
+is called with arguments C<($a,undef,'')> when $a++ is executed.
+
+=head2 Overloadable Operations
+
+The following symbols can be specified in C<use overload>:
+
+=over 5
+
+=item * I<Arithmetic operations>
+
+    "+", "+=", "-", "-=", "*", "*=", "/", "/=", "%", "%=",
+    "**", "**=", "<<", "<<=", ">>", ">>=", "x", "x=", ".", ".=",
+
+For these operations a substituted non-assignment variant can be called if
+the assignment variant is not available.  Methods for operations "C<+>",
+"C<->", "C<+=>", and "C<-=>" can be called to automatically generate
+increment and decrement methods.  The operation "C<->" can be used to
+autogenerate missing methods for unary minus or C<abs>.
+
+=item * I<Comparison operations>
+
+    "<",  "<=", ">",  ">=", "==", "!=", "<=>",
+    "lt", "le", "gt", "ge", "eq", "ne", "cmp",
+
+If the corresponding "spaceship" variant is available, it can be
+used to substitute for the missing operation.  During C<sort>ing
+arrays, C<cmp> is used to compare values subject to C<use overload>.
+
+=item * I<Bit operations>
+
+    "&", "^", "|", "neg", "!", "~",
+
+"C<neg>" stands for unary minus.  If the method for C<neg> is not
+specified, it can be autogenerated using the method for subtraction.
+
+=item * I<Increment and decrement>
+
+    "++", "--",
+
+If undefined, addition and subtraction methods can be
+used instead.  These operations are called both in prefix and
+postfix form.
+
+=item * I<Transcendental functions>
+
+    "atan2", "cos", "sin", "exp", "abs", "log", "sqrt",
+
+If C<abs> is unavailable, it can be autogenerated using methods
+for "<" or "<=>" combined with either unary minus or subtraction.
+
+=item * I<Boolean, string and numeric conversion>
+
+    "bool", "\"\"", "0+",
+
+If one or two of these operations are unavailable, the remaining ones can
+be used instead.  C<bool> is used in the flow control operators
+(like C<while>) and for the ternary "C<?:>" operation.  These functions can
+return any arbitrary Perl value.  If the corresponding operation for this value
+is overloaded too, that operation will be called again with this value.
+
+=item * I<Special>
+
+    "nomethod", "fallback", "=",
+
+see L<SPECIAL SYMBOLS FOR C<use overload>>.
+
+=back
+
+See L<"Fallback"> for an explanation of when a missing method can be autogenerated.
+
+=head1 SPECIAL SYMBOLS FOR C<use overload>
+
+Three keys are recognized by Perl that are not covered by the above
+description.
+
+=head2  Last Resort
+
+C<"nomethod"> should be followed by a reference to a function of four
+parameters.  If defined, it is called when the overloading mechanism
+cannot find a method for some operation.  The first three arguments of
+this function coincide with the arguments for the corresponding method if
+it were found, the fourth argument is the symbol
+corresponding to the missing method.  If several methods are tried,
+the last one is used.  Say, C<1-$a> can be equivalent to
+
+	&nomethodMethod($a,1,1,"-")
+
+if the pair C<"nomethod" =E<gt> "nomethodMethod"> was specified in the
+C<use overload> directive.
+
+If some operation cannot be resolved, and there is no function
+assigned to C<"nomethod">, then an exception will be raised via die()--
+unless C<"fallback"> was specified as a key in C<use overload> directive.
+
+=head2 Fallback 
+
+The key C<"fallback"> governs what to do if a method for a particular
+operation is not found.  Three different cases are possible depending on
+the value of C<"fallback">:
+
+=over 16
+
+=item * C<undef>
+
+Perl tries to use a
+substituted method (see L<MAGIC AUTOGENERATION>).  If this fails, it
+then tries to calls C<"nomethod"> value; if missing, an exception
+will be raised.
+
+=item * TRUE
+
+The same as for the C<undef> value, but no exception is raised.  Instead,
+it silently reverts to what it would have done were there no C<use overload>
+present.
+
+=item * defined, but FALSE
+
+No autogeneration is tried.  Perl tries to call
+C<"nomethod"> value, and if this is missing, raises an exception. 
+
+=back
+
+=head2 Copy Constructor
+
+The value for C<"="> is a reference to a function with three
+arguments, i.e., it looks like the other values in C<use
+overload>. However, it does not overload the Perl assignment
+operator. This would go against Camel hair.
+
+This operation is called in the situations when a mutator is applied
+to a reference that shares its object with some other reference, such
+as
+
+	$a=$b; 
+	$a++;
+
+To make this change $a and not change $b, a copy of C<$$a> is made,
+and $a is assigned a reference to this new object.  This operation is
+done during execution of the C<$a++>, and not during the assignment,
+(so before the increment C<$$a> coincides with C<$$b>).  This is only
+done if C<++> is expressed via a method for C<'++'> or C<'+='>.  Note
+that if this operation is expressed via C<'+'> a nonmutator, i.e., as
+in
+
+	$a=$b; 
+	$a=$a+1;
+
+then C<$a> does not reference a new copy of C<$$a>, since $$a does not
+appear as lvalue when the above code is executed.
+
+If the copy constructor is required during the execution of some mutator,
+but a method for C<'='> was not specified, it can be autogenerated as a
+string copy if the object is a plain scalar.
+
+=over 5
+
+=item B<Example>
+
+The actually executed code for 
+
+	$a=$b; 
+        Something else which does not modify $a or $b....
+	++$a;
+
+may be
+
+	$a=$b; 
+        Something else which does not modify $a or $b....
+	$a = $a->clone(undef,"");
+        $a->incr(undef,"");
+
+if $b was mathemagical, and C<'++'> was overloaded with C<\&incr>,
+C<'='> was overloaded with C<\&clone>.
+
+=back
+
+=head1 MAGIC AUTOGENERATION
+
+If a method for an operation is not found, and the value for  C<"fallback"> is
+TRUE or undefined, Perl tries to autogenerate a substitute method for
+the missing operation based on the defined operations.  Autogenerated method
+substitutions are possible for the following operations:
+
+=over 16
+
+=item I<Assignment forms of arithmetic operations>
+
+C<$a+=$b> can use the method for C<"+"> if the method for C<"+=">
+is not defined.
+
+=item I<Conversion operations> 
+
+String, numeric, and boolean conversion are calculated in terms of one
+another if not all of them are defined.
+
+=item I<Increment and decrement>
+
+The C<++$a> operation can be expressed in terms of C<$a+=1> or C<$a+1>,
+and C<$a--> in terms of C<$a-=1> and C<$a-1>.
+
+=item C<abs($a)>
+
+can be expressed in terms of C<$aE<lt>0> and C<-$a> (or C<0-$a>).
+
+=item I<Unary minus>
+
+can be expressed in terms of subtraction.
+
+=item I<Concatenation>
+
+can be expressed in terms of string conversion.
+
+=item I<Comparison operations> 
+
+can be expressed in terms of its "spaceship" counterpart: either
+C<E<lt>=E<gt>> or C<cmp>:
+ 
+    <, >, <=, >=, ==, != 	in terms of <=>
+    lt, gt, le, ge, eq, ne 	in terms of cmp
+
+=item I<Copy operator>
+
+can be expressed in terms of an assignment to the dereferenced value, if this
+value is a scalar and not a reference.
+
+=back
+
+=head1 WARNING
+
+The restriction for the comparison operation is that even if, for example,
+`C<cmp>' should return a blessed reference, the autogenerated `C<lt>'
+function will produce only a standard logical value based on the
+numerical value of the result of `C<cmp>'.  In particular, a working
+numeric conversion is needed in this case (possibly expressed in terms of
+other conversions).
+
+Similarly, C<.=>  and C<x=> operators lose their mathemagical properties
+if the string conversion substitution is applied.
+
+When you chop() a mathemagical object it is promoted to a string and its
+mathemagical properties are lost.  The same can happen with other
+operations as well.
+
+=head1 Run-time Overloading
+
+Since all C<use> directives are executed at compile-time, the only way to
+change overloading during run-time is to
+
+    eval 'use overload "+" => \&addmethod';
+
+You can also use
+
+    eval 'no overload "+", "--", "<="';
+
+though the use of these constructs during run-time is questionable.
+
+=head1 Public functions
+
+Package C<overload.pm> provides the following public functions:
+
+=over 5
+
+=item overload::StrVal(arg)
+
+Gives string value of C<arg> as in absence of stringify overloading.
+
+=item overload::Overloaded(arg)
+
+Returns true if C<arg> is subject to overloading of some operations.
+
+=item overload::Method(obj,op)
+
+Returns C<undef> or a reference to the method that implements C<op>.
+
+=back
+
+=head1 IMPLEMENTATION
+
+What follows is subject to change RSN.
+
+The table of methods for all operations is cached as magic in the
+symbol table hash for the package.  The table is rechecked for changes due to
+C<use overload>, C<no overload>, and @ISA only during
+C<bless>ing; so if they are changed dynamically, you'll need an
+additional fake C<bless>ing to update the table.
+
+(Every SVish thing has a magic queue, and magic is an entry in that queue.
+This is how a single variable may participate in multiple forms of magic
+simultaneously.  For instance, environment variables regularly have two
+forms at once: their %ENV magic and their taint magic.)
+
+If an object belongs to a package using overload, it carries a special
+flag.  Thus the only speed penalty during arithmetic operations without
+overloading is the checking of this flag.
+
+In fact, if C<use overload> is not present, there is almost no overhead for
+overloadable operations, so most programs should not suffer measurable
+performance penalties.  A considerable effort was made to minimize the overhead
+when overload is used and the current operation is overloadable but
+the arguments in question do not belong to packages using overload.  When
+in doubt, test your speed with C<use overload> and without it.  So far there
+have been no reports of substantial speed degradation if Perl is compiled
+with optimization turned on.
+
+There is no size penalty for data if overload is not used. 
+
+Copying (C<$a=$b>) is shallow; however, a one-level-deep copying is 
+carried out before any operation that can imply an assignment to the
+object $a (or $b) refers to, like C<$a++>.  You can override this
+behavior by defining your own copy constructor (see L<"Copy Constructor">).
+
+It is expected that arguments to methods that are not explicitly supposed
+to be changed are constant (but this is not enforced).
+
+=head1 AUTHOR
+
+Ilya Zakharevich <F<ilya@math.mps.ohio-state.edu>>.
+
+=head1 DIAGNOSTICS
+
+When Perl is run with the B<-Do> switch or its equivalent, overloading
+induces diagnostic messages.
+
+=head1 BUGS
+
+Because it is used for overloading, the per-package associative array
+%OVERLOAD now has a special meaning in Perl.
+
+As shipped, mathemagical properties are not inherited via the @ISA tree.
+
+This document is confusing.
+
+=cut
+
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 358b548a3c..b5be230eed 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -15,6 +15,12 @@ $header = '$RCSfile: perl5db.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:07 $';
 #
 # $Log:	perldb.pl,v $
 
+# Is Perl being run from Emacs?
+$emacs = ((defined $main::ARGV[0]) and ($main::ARGV[0] eq '-emacs'));
+shift(@main::ARGV) if $emacs;
+
+#require Term::ReadLine;
+
 local($^W) = 0;
 
 if (-e "/dev/tty") {
@@ -30,6 +36,15 @@ else {
     $rcfile="perldb.ini";
 }
 
+# Around a bug:
+if (defined $ENV{'OS2_SHELL'}) { # In OS/2
+  if ($DB::emacs) {
+    $console = undef;
+  } else {
+    $console = "/dev/con";
+  }
+}
+
 open(IN, "<$console") || open(IN,  "<&STDIN");	# so we don't dingle stdin
 open(OUT,">$console") || open(OUT, ">&STDERR")
     || open(OUT, ">&STDOUT");	# so we don't dongle stdout
@@ -39,10 +54,6 @@ select(STDOUT);
 $| = 1;				# for real STDOUT
 $sub = '';
 
-# Is Perl being run from Emacs?
-$emacs = $main::ARGV[0] eq '-emacs';
-shift(@main::ARGV) if $emacs;
-
 $header =~ s/.Header: ([^,]+),v(\s+\S+\s+\S+).*$/$1$2/;
 print OUT "\nLoading DB routines from $header\n";
 print OUT ("Emacs support ",
diff --git a/lib/splain b/lib/splain
new file mode 100755
index 0000000000..073a456c81
--- /dev/null
+++ b/lib/splain
@@ -0,0 +1,502 @@
+#!/usr/local/bin/perl
+eval 'exec perl -S $0  ${1+"$@"}'
+    if $0;
+
+use Config;
+$diagnostics::PODFILE= $Config{privlib} . "/pod/perldiag.pod";
+
+package diagnostics;
+require 5.001;
+use English;
+use Carp;
+
+=head1 NAME
+
+diagnostics - Perl compiler pragma to force verbose warning diagnostics
+
+splain - standalone program to do the same thing
+
+=head1 SYNOPSIS
+
+As a pragma:
+
+    use diagnostics;
+    use diagnostics -verbose;
+
+    enable  diagnostics;
+    disable diagnostics;
+
+Aa a program:
+
+    perl program 2>diag.out
+    splain [-v] [-p] diag.out
+
+
+=head1 DESCRIPTION
+
+=head2 The C<diagnostics> Pragma
+
+This module extends the terse diagnostics normally emitted by both the
+perl compiler and the perl interpeter, augmenting them wtih the more
+explicative and endearing descriptions found in L<perldiag>.  Like the
+other pragmata, it affects to compilation phase of your program rather
+than merely the execution phase.
+
+To use in your program as a pragma, merely invoke
+
+    use diagnostics;
+
+at the start (or near the start) of your program.  (Note 
+that this I<does> enable perl's B<-w> flag.)  Your whole
+compilation will then be subject(ed :-) to the enhanced diagnostics.
+These still go out B<STDERR>.
+
+Due to the interaction between runtime and compiletime issues,
+and because it's probably not a very good idea anyway,
+you may not use C<no diagnostics> to turn them off at compiletime.
+However, you may control there behaviour at runtime using the 
+disable() and enable() methods to turn them off and on respectively.
+
+The B<-verbose> flag first prints out the L<perldiag> introduction before
+any other diagnostics.  The $diagnostics::PRETTY can generate nicer escape
+sequences for pgers.
+
+=head2 The I<splain> Program
+
+While apparently a whole nuther program, I<splain> is actually nothing
+more than a link to the (executable) F<diagnostics.pm> module, as well as
+a link to the F<diagnostics.pod> documentation.  The B<-v> flag is like
+the C<use diagnostics -verbose> directive.
+The B<-p> flag is like the
+$diagnostics::PRETTY variable.  Since you're post-processing with 
+I<splain>, there's no sense in being able to enable() or disable() processing.
+
+Output from I<splain> is directed to B<STDOUT>, unlike the pragma.
+
+=head1 EXAMPLES
+
+The following file is certain to trigger a few errors at both
+runtime and compiletime:
+
+    use diagnostics;
+    print NOWHERE "nothing\n";
+    print STDERR "\n\tThis message should be unadorned.\n";
+    warn "\tThis is a user warning";
+    print "\nDIAGNOSTIC TESTER: Please enter a <CR> here: ";
+    my $a, $b = scalar <STDIN>;
+    print "\n";
+    print $x/$y;
+
+If you prefer to run your program first and look at its problem
+afterwards, do this:
+
+    perl -w test.pl 2>test.out
+    ./splain < test.out
+
+Note that this is not in general possible in shells of more dubious heritage, 
+as the theorectical 
+
+    (perl -w test.pl >/dev/tty) >& test.out
+    ./splain < test.out
+
+Because you just moved the existing B<stdout> to somewhere else.
+
+If you don't want to modify your source code, but still have on-the-fly
+warnings, do this:
+
+    exec 3>&1; perl -w test.pl 2>&1 1>&3 3>&- | splain 1>&2 3>&- 
+
+Nifty, eh?
+
+If you want to control warnings on the fly, do something like this.
+Make sure you do the C<use> first, or you won't be able to get
+at the enable() or disable() methods.
+
+    use diagnostics; # checks entire compilation phase 
+	print "\ntime for 1st bogus diags: SQUAWKINGS\n";
+	print BOGUS1 'nada';
+	print "done with 1st bogus\n";
+
+    disable diagnostics; # only turns off runtime warnings
+	print "\ntime for 2nd bogus: (squelched)\n";
+	print BOGUS2 'nada';
+	print "done with 2nd bogus\n";
+
+    enable diagnostics; # turns back on runtime warnings
+	print "\ntime for 3rd bogus: SQUAWKINGS\n";
+	print BOGUS3 'nada';
+	print "done with 3rd bogus\n";
+
+    disable diagnostics;
+	print "\ntime for 4th bogus: (squelched)\n";
+	print BOGUS4 'nada';
+	print "done with 4th bogus\n";
+
+=head1 INTERNALS
+
+Diagnostic messages derive from the F<perldiag.pod> file when available at
+runtime.  Otherwise, they may be embedded in the file itself when the
+splain package is built.   See the F<Makefile> for details.
+
+If an extant $SIG{__WARN__} handler is discovered, it will continue
+to be honored, but only after the diagnostic::splainthis() function 
+(the module's $SIG{__WARN__} interceptor) has had its way with your
+warnings.
+
+There is a $diagnostics::DEBUG variable you may set if you're desperately
+curious what sorts of things are being intercepted.
+
+    BEGIN { $diagnostics::DEBUG = 1 } 
+
+
+=head1 BUGS
+
+Not being able to say "no diagnostics" is annoying, but may not be
+insurmountable.
+
+The C<-pretty> directive is called too late to affect matters.
+You have to to this instead, and I<before> you load the module.
+
+    BEGIN { $diagnostics::PRETTY = 1 } 
+
+I could start up faster by delaying compilation until it should be
+needed, but this gets a "panic: top_level"
+when using the pragma form in 5.001e.  
+
+While it's true that this documentation is somewhat subserious, if you use
+a program named I<splain>, you should expect a bit of whimsy.
+
+=head1 AUTHOR
+
+Tom Christiansen F<E<lt>tchrist@mox.perl.comE<gt>>, 25 June 1995.
+
+=cut
+
+$DEBUG ||= 0;
+my $WHOAMI = ref bless [];  # nobody's business, prolly not even mine
+
+$OUTPUT_AUTOFLUSH = 1;
+
+local $_;
+
+CONFIG: {
+    $opt_p = $opt_d = $opt_v = $opt_f = '';
+    %HTML_2_Troff = %HTML_2_Latin_1 = %HTML_2_ASCII_7 = ();  
+    %exact_duplicate = ();
+
+    unless (caller) { 
+	$standalone++;
+	require Getopt::Std;
+	Getopt::Std::getopts('pdvf:') || die "Usage: $0 [-v] [-p] [-f splainpod]";
+	$PODFILE = $opt_f if $opt_f;
+	$DEBUG = 2 if $opt_d;
+	$VERBOSE = $opt_v;
+	$PRETTY = $opt_p;
+    } 
+
+    if (open(POD_DIAG, $PODFILE)) {
+	warn "Happy happy podfile from real $PODFILE\n" if $DEBUG;
+	last CONFIG;
+    } 
+
+    if (caller) {
+	INCPATH: {
+	    for $file ( (map { "$_/$WHOAMI.pm" } @INC), $0) {
+		warn "Checking $file\n" if $DEBUG;
+		if (open(POD_DIAG, $file)) {
+		    while (<POD_DIAG>) {
+			next unless /^__END__\s*# wish diag dbase were more accessible/;
+			print STDERR "podfile is $file\n" if $DEBUG;
+			last INCPATH;
+		    }
+		}
+	    } 
+	}
+    } else { 
+	print STDERR "podfile is <DATA>\n" if $DEBUG;
+	*POD_DIAG = *main::DATA;
+    }
+}
+if (eof(POD_DIAG)) { 
+    die "couldn't find diagnostic data in $PODFILE @INC $0";
+}
+
+
+%HTML_2_Troff = (
+    'amp'	=>	'&',	#   ampersand
+    'lt'	=>	'<',	#   left chevron, less-than
+    'gt'	=>	'>',	#   right chevron, greater-than
+    'quot'	=>	'"',	#   double quote
+
+    "Aacute"	=>	"A\\*'",	#   capital A, acute accent
+    # etc
+
+);
+
+%HTML_2_Latin_1 = (
+    'amp'	=>	'&',	#   ampersand
+    'lt'	=>	'<',	#   left chevron, less-than
+    'gt'	=>	'>',	#   right chevron, greater-than
+    'quot'	=>	'"',	#   double quote
+
+    "Aacute"	=>	"\xC1"	#   capital A, acute accent
+
+    # etc
+);
+
+%HTML_2_ASCII_7 = (
+    'amp'	=>	'&',	#   ampersand
+    'lt'	=>	'<',	#   left chevron, less-than
+    'gt'	=>	'>',	#   right chevron, greater-than
+    'quot'	=>	'"',	#   double quote
+
+    "Aacute"	=>	"A"	#   capital A, acute accent
+    # etc
+);
+
+*HTML_Escapes = do {
+    if ($standalone) {
+	$PRETTY ? \%HTML_2_Latin_1 : \%HTML_2_ASCII_7; 
+    } else {
+	\%HTML_2_Latin_1; 
+    }
+}; 
+
+*THITHER = $standalone ? *STDOUT : *STDERR;
+
+$transmo = <<EOFUNC;
+sub transmo {
+    local \$^W = 0;  # recursive warnings we do NOT need!
+    study;
+EOFUNC
+
+### sub finish_compilation {  # 5.001e panic: top_level for embedded version
+    print STDERR "FINISHING COMPILATION for $_\n" if $DEBUG;
+    ### local 
+    $RS = '';
+    local $_;
+    while (<POD_DIAG>) {
+	#s/(.*)\n//;
+	#$header = $1;
+
+	unescape();
+	if ($PRETTY) {
+	    sub noop   { return $_[0] }  # spensive for a noop
+	    sub bold   { my $str =$_[0];  $str =~ s/(.)/$1\b$1/g; return $str; } 
+	    sub italic { my $str = $_[0]; $str =~ s/(.)/_\b$1/g;  return $str; } 
+	    s/[BC]<(.*?)>/bold($1)/ges;
+	    s/[LIF]<(.*?)>/italic($1)/ges;
+	} else {
+	    s/[BC]<(.*?)>/$1/gs;
+	    s/[LIF]<(.*?)>/$1/gs;
+	} 
+	unless (/^=/) {
+	    if (defined $header) { 
+		if ( $header eq 'DESCRIPTION' && 
+		    (   /Optional warnings are enabled/ 
+		     || /Some of these messages are generic./
+		    ) )
+		{
+		    next;
+		} 
+		s/^/    /gm;
+		$msg{$header} .= $_;
+	    }
+	    next;
+	} 
+	unless ( s/=item (.*)\s*\Z//) {
+
+	    if ( s/=head1\sDESCRIPTION//) {
+		$msg{$header = 'DESCRIPTION'} = '';
+	    }
+	    next;
+	}
+	$header = $1;
+
+	if ($header =~ /%[sd]/) {
+	    $rhs = $lhs = $header;
+	    #if ($lhs =~ s/(.*?)%d(?!%d)(.*)/\Q$1\E\\d+\Q$2\E\$/g)  {
+	    if ($lhs =~ s/(.*?)%d(?!%d)(.*)/\Q$1\E\\d+\Q$2\E/g)  {
+		$lhs =~ s/\\%s/.*?/g;
+	    } else {
+		# if i had lookbehind negations, i wouldn't have to do this \377 noise
+		$lhs =~ s/(.*?)%s/\Q$1\E.*?\377/g;
+		#$lhs =~ s/\377([^\377]*)$/\Q$1\E\$/;
+		$lhs =~ s/\377([^\377]*)$/\Q$1\E/;
+		$lhs =~ s/\377//g;
+	    } 
+	    $transmo .= "    s{^$lhs}\n     {\Q$rhs\E}\n\t&& return 1;\n";
+	} else {
+	    $transmo .= "    m{^\Q$header\E} && return 1;\n";
+	} 
+
+	print STDERR "Already saw $header" if $msg{$header};
+
+	$msg{$header} = '';
+    } 
+
+
+    close POD_DIAG unless *main::DATA eq *POD_DIAG;
+
+    die "No diagnostics?" unless %msg;
+
+    $transmo .= "    return 0;\n}\n";
+    print STDERR $transmo if $DEBUG;
+    eval $transmo;
+    die $@ if $@;
+    $RS = "\n";
+### }
+
+if ($standalone) {
+    if (!@ARGV and -t STDIN) { print STDERR "$0: Reading from STDIN\n" } 
+    while ($error = <>) {
+	splainthis($error) || print THITHER $error;
+    } 
+    exit;
+} else { 
+    $old_w = 0; $oldwarn = ''; $olddie = '';
+}
+
+sub import {
+    shift;
+    $old_w = $^W;
+    $^W = 1; # yup, clobbered the global variable; tough, if you
+	     # want diags, you want diags.
+    return if $SIG{__WARN__} eq \&warn_trap;
+
+    for (@_) {
+
+	/^-d(ebug)?$/ 	   	&& do {
+				    $DEBUG++;
+				    next;
+				   };
+
+	/^-v(erbose)?$/ 	&& do {
+				    $VERBOSE++;
+				    next;
+				   };
+
+	/^-p(retty)?$/ 		&& do {
+				    print STDERR "$0: I'm afraid it's too late for prettiness.\n";
+				    $PRETTY++;
+				    next;
+			       };
+
+	warn "Unknown flag: $_";
+    } 
+
+    $oldwarn = $SIG{__WARN__};
+    $olddie = $SIG{__DIE__};
+    $SIG{__WARN__} = \&warn_trap;
+    $SIG{__DIE__} = \&death_trap;
+} 
+
+sub enable { &import }
+
+sub disable {
+    shift;
+    $^W = $old_w;
+    return unless $SIG{__WARN__} eq \&warn_trap;
+    $SIG{__WARN__} = $oldwarn;
+    $SIG{__DIE__} = $olddie;
+} 
+
+sub warn_trap {
+    my $warning = $_[0];
+    if (caller eq $WHOAMI or !splainthis($warning)) {
+	print STDERR $warning;
+    } 
+    &$oldwarn if $oldwarn and $oldwarn ne \&warn_trap;
+};
+
+sub death_trap {
+    my $exception = $_[0];
+    splainthis($exception);
+    if (caller eq $WHOAMI) { print STDERR "INTERNAL EXCEPTION: $exception"; } 
+    &$olddie if defined $olddie and $olddie ne \&death_trap;
+    $SIG{__DIE__} = $SIG{__WARN__} = '';
+    confess "Uncaught exception from user code:\n\t$exception    Bailing out";
+	# up we go; where we stop, nobody knows, but i think we die now
+	# but i'm deeply afraid of the &$olddie guy reraising and us getting
+	# into an indirect recursion loop
+};
+
+sub splainthis {
+    local $_ = shift;
+    ### &finish_compilation unless %msg;
+    s/\.?\n+$//;
+    my $orig = $_;
+    # return unless defined;
+    if ($exact_duplicate{$_}++) {
+	return 1;
+    } 
+    s/, <.*?> (?:line|chunk).*$//;
+    $real = s/(.*?) at .*? (?:line|chunk) \d+.*/$1/;
+    s/^\((.*)\)$/$1/;
+    return 0 unless &transmo;
+    $orig = shorten($orig);
+    if ($old_diag{$_}) {
+	autodescribe();
+	print THITHER "$orig (#$old_diag{$_})\n";
+	$wantspace = 1;
+    } else {
+	autodescribe();
+	$old_diag{$_} = ++$count;
+	print THITHER "\n" if $wantspace;
+	$wantspace = 0;
+	print THITHER "$orig (#$old_diag{$_})\n";
+	if ($msg{$_}) {
+	    print THITHER $msg{$_};
+	} else {
+	    if (0 and $standalone) { 
+		print THITHER "    **** Error #$old_diag{$_} ",
+			($real ? "is" : "appears to be"),
+			" an unknown diagnostic message.\n\n";
+	    }
+	    return 0;
+	} 
+    }
+    return 1;
+} 
+
+sub autodescribe {
+    if ($VERBOSE and not $count) {
+	print THITHER &{$PRETTY ? \&bold : \&noop}("DESCRIPTION OF DIAGNOSTICS"),
+		"\n$msg{DESCRIPTION}\n";
+    } 
+} 
+
+sub unescape { 
+    s {
+            E<  
+            ( [A-Za-z]+ )       
+            >   
+    } { 
+         do {   
+             exists $HTML_Escapes{$1}
+                ? do { $HTML_Escapes{$1} }
+                : do {
+                    warn "Unknown escape: $& in $_";
+                    "E<$1>";
+                } 
+         } 
+    }egx;
+}
+
+sub shorten {
+    my $line = $_[0];
+    if (length $line > 79) {
+	my $space_place = rindex($line, ' ', 79);
+	if ($space_place != -1) {
+	    substr($line, $space_place, 1) = "\n\t";
+	} 
+    } 
+    return $line;
+} 
+
+
+# have to do this: RS isn't set until run time, but we're executing at compile time
+$RS = "\n";
+
+1 unless $standalone;  # or it'll complain about itself
+__END__ # wish diag dbase were more accessible
author	Larry Wall <lwall@scalpel.netlabs.com>	1995-11-21 10:01:00 +1200
committer	Larry <lwall@scalpel.netlabs.com>	1995-11-21 10:01:00 +1200
commit	4633a7c4bad06b471d9310620b7fe8ddd158cccd (patch)
tree	37ebeb26a64f123784fd8fac6243b124767243b0 /lib
parent	8e07c86ebc651fe92eb7e3b25f801f57cfb8dd6f (diff)
download	perl-4633a7c4bad06b471d9310620b7fe8ddd158cccd.tar.gz