First stab at 5.003 -> 5.004 integration.

p4raw-id: //depot/perl@18

123 files changed, 23110 insertions, 4341 deletions

diff --git a/lib/AnyDBM_File.pm b/lib/AnyDBM_File.pm
index 50acce412a..aff3c7cdec 100644
--- a/lib/AnyDBM_File.pm
+++ b/lib/AnyDBM_File.pm
@@ -1,18 +1,24 @@
 package AnyDBM_File;
 
+use vars qw(@ISA);
 @ISA = qw(NDBM_File DB_File GDBM_File SDBM_File ODBM_File) unless @ISA;
 
-eval { require NDBM_File } ||
-eval { require DB_File } ||
-eval { require GDBM_File } ||
-eval { require SDBM_File } ||
-eval { require ODBM_File };
+my $mod;
+for $mod (@ISA) {
+    if (eval "require $mod") {
+	@ISA = ($mod);	# if we leave @ISA alone, warnings abound
+	return 1;
+    }
+}
+
+die "No DBM package was successfully found or installed";
+#return 0;
 
 =head1 NAME
 
 AnyDBM_File - provide framework for multiple DBMs
 
-NDBM_File, ODBM_File, SDBM_File, GDBM_File - various DBM implementations
+NDBM_File, DB_File, GDBM_File, SDBM_File, ODBM_File - various DBM implementations
 
 =head1 SYNOPSIS
 
@@ -27,20 +33,14 @@ L<DB_File>), GDBM, SDBM (which is always there--it comes with Perl), and
 finally ODBM.   This way old programs that used to use NDBM via dbmopen()
 can still do so, but new ones can reorder @ISA:
 
-    @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File);
-
-Note, however, that an explicit use overrides the specified order:
-
-    use GDBM_File;
-    @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File);
-
-will only find GDBM_File.
+    BEGIN { @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File) }
+    use AnyDBM_File;
 
 Having multiple DBM implementations makes it trivial to copy database formats:
 
     use POSIX; use NDBM_File; use DB_File;
-    tie %newhash,  DB_File, $new_filename, O_CREAT|O_RDWR;
-    tie %oldhash,  NDBM_File, $old_filename, 1, 0;
+    tie %newhash,  'DB_File', $new_filename, O_CREAT|O_RDWR;
+    tie %oldhash,  'NDBM_File', $old_filename, 1, 0;
     %newhash = %oldhash;
 
 =head2 DBM Comparisons
diff --git a/lib/AutoLoader.pm b/lib/AutoLoader.pm
index 566ca8688e..e2d71700d4 100644
--- a/lib/AutoLoader.pm
+++ b/lib/AutoLoader.pm
@@ -1,54 +1,66 @@
 package AutoLoader;
-use Carp;
-$DB::sub = $DB::sub;	# Avoid warning
-
-=head1 NAME
 
-AutoLoader - load functions only on demand
-
-=head1 SYNOPSIS
-
-    package FOOBAR;
-    use Exporter;
-    use AutoLoader;
-    @ISA = (Exporter, AutoLoader);
-
-=head1 DESCRIPTION
-
-This module tells its users that functions in the FOOBAR package are to be
-autoloaded from F<auto/$AUTOLOAD.al>.  See L<perlsub/"Autoloading">.
+use Carp;
+use vars qw(@EXPORT @EXPORT_OK);
 
-=cut
+BEGIN {
+    require Exporter;
+    @EXPORT = ();
+    @EXPORT_OK = qw(AUTOLOAD);
+}
 
 AUTOLOAD {
-    my $name = "auto/$AUTOLOAD.al";
-    $name =~ s#::#/#g;
+    my $name;
+    # Braces used to preserve $1 et al.
+    {
+     my ($pkg,$func) = $AUTOLOAD =~ /(.*)::([^:]+)$/;
+     $pkg =~ s#::#/#g;
+     if (defined($name=$INC{"$pkg.pm"}))
+      {
+       $name =~ s#^(.*)$pkg\.pm$#$1auto/$pkg/$func.al#;
+       $name = undef unless (-r $name); 
+      }
+     unless (defined $name)
+      {
+       $name = "auto/$AUTOLOAD.al";
+       $name =~ s#::#/#g;
+      }
+    }
+    my $save = $@;
     eval {require $name};
     if ($@) {
-	# The load might just have failed because the filename was too
-	# long for some old SVR3 systems which treat long names as errors.
-	# If we can succesfully truncate a long name then it's worth a go.
-	# There is a slight risk that we could pick up the wrong file here
-	# but autosplit should have warned about that when splitting.
-	if ($name =~ s/(\w{12,})\.al$/substr($1,0,11).".al"/e){
-	    eval {require $name};
-	}
-	elsif ($AUTOLOAD =~ /::DESTROY$/) {
-	    # eval "sub $AUTOLOAD {}";
+	if (substr($AUTOLOAD,-9) eq '::DESTROY') {
 	    *$AUTOLOAD = sub {};
-	}
-	if ($@){
-	    $@ =~ s/ at .*\n//;
-	    croak $@;
+	} else {
+	    # The load might just have failed because the filename was too
+	    # long for some old SVR3 systems which treat long names as errors.
+	    # If we can succesfully truncate a long name then it's worth a go.
+	    # There is a slight risk that we could pick up the wrong file here
+	    # but autosplit should have warned about that when splitting.
+	    if ($name =~ s/(\w{12,})\.al$/substr($1,0,11).".al"/e){
+		eval {require $name};
+	    }
+	    if ($@){
+		$@ =~ s/ at .*\n//;
+		croak $@;
+	    }
 	}
     }
-    $DB::sub = $AUTOLOAD;	# Now debugger know where we are.
+    $@ = $save;
     goto &$AUTOLOAD;
 }
-                            
+
 sub import {
-    my ($callclass, $callfile, $callline,$path,$callpack) = caller(0);
-    ($callpack = $callclass) =~ s#::#/#;
+    my $pkg = shift;
+    my $callpkg = caller;
+
+    #
+    # Export symbols, but not by accident of inheritance.
+    #
+
+    Exporter::export $pkg, $callpkg, @_ if $pkg eq 'AutoLoader';
+
+    #
     # Try to find the autosplit index file.  Eg., if the call package
     # is POSIX, then $INC{POSIX.pm} is something like
     # '/usr/local/lib/perl5/POSIX.pm', and the autosplit index file is in
@@ -59,13 +71,16 @@ sub import {
     # $INC{POSIX.pm} is 'lib/POSIX.pm', and we want to require
     # 'auto/POSIX/autosplit.ix' (without the leading 'lib').
     #
-    if (defined($path = $INC{$callpack . '.pm'})) {
+
+    (my $calldir = $callpkg) =~ s#::#/#;
+    my $path = $INC{$calldir . '.pm'};
+    if (defined($path)) {
 	# Try absolute path name.
-	$path =~ s#^(.*)$callpack\.pm$#$1auto/$callpack/autosplit.ix#;
+	$path =~ s#^(.*)$calldir\.pm$#$1auto/$calldir/autosplit.ix#;
 	eval { require $path; };
 	# If that failed, try relative path with normal @INC searching.
 	if ($@) {
-	    $path ="auto/$callpack/autosplit.ix";
+	    $path ="auto/$calldir/autosplit.ix";
 	    eval { require $path; };
 	}
 	carp $@ if ($@);  
@@ -73,3 +88,156 @@ sub import {
 }
 
 1;
+
+__END__
+
+=head1 NAME
+
+AutoLoader - load subroutines only on demand
+
+=head1 SYNOPSIS
+
+    package Foo;
+    use AutoLoader 'AUTOLOAD';   # import the default AUTOLOAD subroutine
+
+    package Bar;
+    use AutoLoader;              # don't import AUTOLOAD, define our own
+    sub AUTOLOAD {
+        ...
+        $AutoLoader::AUTOLOAD = "...";
+        goto &AutoLoader::AUTOLOAD;
+    }
+
+=head1 DESCRIPTION
+
+The B<AutoLoader> module works with the B<AutoSplit> module and the
+C<__END__> token to defer the loading of some subroutines until they are
+used rather than loading them all at once.
+
+To use B<AutoLoader>, the author of a module has to place the
+definitions of subroutines to be autoloaded after an C<__END__> token.
+(See L<perldata>.)  The B<AutoSplit> module can then be run manually to
+extract the definitions into individual files F<auto/funcname.al>.
+
+B<AutoLoader> implements an AUTOLOAD subroutine.  When an undefined
+subroutine in is called in a client module of B<AutoLoader>,
+B<AutoLoader>'s AUTOLOAD subroutine attempts to locate the subroutine in a
+file with a name related to the location of the file from which the
+client module was read.  As an example, if F<POSIX.pm> is located in
+F</usr/local/lib/perl5/POSIX.pm>, B<AutoLoader> will look for perl
+subroutines B<POSIX> in F</usr/local/lib/perl5/auto/POSIX/*.al>, where
+the C<.al> file has the same name as the subroutine, sans package.  If
+such a file exists, AUTOLOAD will read and evaluate it,
+thus (presumably) defining the needed subroutine.  AUTOLOAD will then
+C<goto> the newly defined subroutine.
+
+Once this process completes for a given funtion, it is defined, so
+future calls to the subroutine will bypass the AUTOLOAD mechanism.
+
+=head2 Subroutine Stubs
+
+In order for object method lookup and/or prototype checking to operate
+correctly even when methods have not yet been defined it is necessary to
+"forward declare" each subroutine (as in C<sub NAME;>).  See
+L<perlsub/"SYNOPSIS">.  Such forward declaration creates "subroutine
+stubs", which are place holders with no code.
+
+The AutoSplit and B<AutoLoader> modules automate the creation of forward
+declarations.  The AutoSplit module creates an 'index' file containing
+forward declarations of all the AutoSplit subroutines.  When the
+AutoLoader module is 'use'd it loads these declarations into its callers
+package.
+
+Because of this mechanism it is important that B<AutoLoader> is always
+C<use>d and not C<require>d.
+
+=head2 Using B<AutoLoader>'s AUTOLOAD Subroutine
+
+In order to use B<AutoLoader>'s AUTOLOAD subroutine you I<must>
+explicitly import it:
+
+    use AutoLoader 'AUTOLOAD';
+
+=head2 Overriding B<AutoLoader>'s AUTOLOAD Subroutine
+
+Some modules, mainly extensions, provide their own AUTOLOAD subroutines.
+They typically need to check for some special cases (such as constants)
+and then fallback to B<AutoLoader>'s AUTOLOAD for the rest.
+
+Such modules should I<not> import B<AutoLoader>'s AUTOLOAD subroutine.
+Instead, they should define their own AUTOLOAD subroutines along these
+lines:
+
+    use AutoLoader;
+
+    sub AUTOLOAD {
+        my $constname;
+        ($constname = $AUTOLOAD) =~ s/.*:://;
+        my $val = constant($constname, @_ ? $_[0] : 0);
+        if ($! != 0) {
+            if ($! =~ /Invalid/) {
+                $AutoLoader::AUTOLOAD = $AUTOLOAD;
+                goto &AutoLoader::AUTOLOAD;
+            }
+            else {
+                croak "Your vendor has not defined constant $constname";
+            }
+        }
+        eval "sub $AUTOLOAD { $val }";
+        goto &$AUTOLOAD;
+    }
+
+If any module's own AUTOLOAD subroutine has no need to fallback to the
+AutoLoader's AUTOLOAD subroutine (because it doesn't have any AutoSplit
+subroutines), then that module should not use B<AutoLoader> at all.
+
+=head2 Package Lexicals
+
+Package lexicals declared with C<my> in the main block of a package
+using B<AutoLoader> will not be visible to auto-loaded subroutines, due to
+the fact that the given scope ends at the C<__END__> marker.  A module
+using such variables as package globals will not work properly under the
+B<AutoLoader>.
+
+The C<vars> pragma (see L<perlmod/"vars">) may be used in such
+situations as an alternative to explicitly qualifying all globals with
+the package namespace.  Variables pre-declared with this pragma will be
+visible to any autoloaded routines (but will not be invisible outside
+the package, unfortunately).
+
+=head2 B<AutoLoader> vs. B<SelfLoader>
+
+The B<AutoLoader> is similar in purpose to B<SelfLoader>: both delay the
+loading of subroutines.
+
+B<SelfLoader> uses the C<__DATA__> marker rather than C<__END__>.
+While this avoids the use of a hierarchy of disk files and the
+associated open/close for each routine loaded, B<SelfLoader> suffers a
+startup speed disadvantage in the one-time parsing of the lines after
+C<__DATA__>, after which routines are cached.  B<SelfLoader> can also
+handle multiple packages in a file.
+
+B<AutoLoader> only reads code as it is requested, and in many cases
+should be faster, but requires a machanism like B<AutoSplit> be used to
+create the individual files.  L<ExtUtils::MakeMaker> will invoke
+B<AutoSplit> automatically if B<AutoLoader> is used in a module source
+file.
+
+=head1 CAVEATS
+
+AutoLoaders prior to Perl 5.002 had a slightly different interface.  Any
+old modules which use B<AutoLoader> should be changed to the new calling
+style.  Typically this just means changing a require to a use, adding
+the explicit C<'AUTOLOAD'> import if needed, and removing B<AutoLoader>
+from C<@ISA>.
+
+On systems with restrictions on file name length, the file corresponding
+to a subroutine may have a shorter name that the routine itself.  This
+can lead to conflicting file names.  The I<AutoSplit> package warns of
+these potential conflicts when used to split a module.
+
+=head1 SEE ALSO
+
+L<SelfLoader> - an autoloader that doesn't use external files.
+
+=cut
diff --git a/lib/AutoSplit.pm b/lib/AutoSplit.pm
index f9e3ad6dc4..2fd0cac32d 100644
--- a/lib/AutoSplit.pm
+++ b/lib/AutoSplit.pm
@@ -5,6 +5,7 @@ require Exporter;
 
 use Config;
 use Carp;
+use File::Path qw(mkpath);
 
 @ISA = qw(Exporter);
 @EXPORT = qw(&autosplit &autosplit_lib_modules);
@@ -16,14 +17,81 @@ AutoSplit - split a package for autoloading
 
 =head1 SYNOPSIS
 
- perl -e 'use AutoSplit; autosplit_modules(@ARGV)'  ...
+ perl -e 'use AutoSplit; autosplit_lib_modules(@ARGV)' ...
+
+ use AutoSplit; autosplit($file, $dir, $keep, $check, $modtime);
+
+for perl versions 5.002 and later:
+
+ perl -MAutoSplit -e 'autosplit($ARGV[0], $ARGV[1], $k, $chk, $modtime)' ...
 
 =head1 DESCRIPTION
 
 This function will split up your program into files that the AutoLoader
-module can handle.  Normally only used to build autoloading Perl library
-modules, especially extensions (like POSIX).  You should look at how
-they're built out for details.
+module can handle. It is used by both the standard perl libraries and by
+the MakeMaker utility, to automatically configure libraries for autoloading.
+
+The C<autosplit> interface splits the specified file into a hierarchy 
+rooted at the directory C<$dir>. It creates directories as needed to reflect
+class hierarchy, and creates the file F<autosplit.ix>. This file acts as
+both forward declaration of all package routines, and as timestamp for the
+last update of the hierarchy.
+
+The remaining three arguments to C<autosplit> govern other options to the
+autosplitter. If the third argument, I<$keep>, is false, then any pre-existing
+C<*.al> files in the autoload directory are removed if they are no longer
+part of the module (obsoleted functions). The fourth argument, I<$check>,
+instructs C<autosplit> to check the module currently being split to ensure
+that it does include a C<use> specification for the AutoLoader module, and
+skips the module if AutoLoader is not detected. Lastly, the I<$modtime>
+argument specifies that C<autosplit> is to check the modification time of the
+module against that of the C<autosplit.ix> file, and only split the module
+if it is newer.
+
+Typical use of AutoSplit in the perl MakeMaker utility is via the command-line
+with:
+
+ perl -e 'use AutoSplit; autosplit($ARGV[0], $ARGV[1], 0, 1, 1)'
+
+Defined as a Make macro, it is invoked with file and directory arguments;
+C<autosplit> will split the specified file into the specified directory and
+delete obsolete C<.al> files, after checking first that the module does use
+the AutoLoader, and ensuring that the module is not already currently split
+in its current form (the modtime test).
+
+The C<autosplit_lib_modules> form is used in the building of perl. It takes
+as input a list of files (modules) that are assumed to reside in a directory
+B<lib> relative to the current directory. Each file is sent to the 
+autosplitter one at a time, to be split into the directory B<lib/auto>.
+
+In both usages of the autosplitter, only subroutines defined following the
+perl special marker I<__END__> are split out into separate files. Some
+routines may be placed prior to this marker to force their immediate loading
+and parsing.
+
+=head1 CAVEATS
+
+Currently, C<AutoSplit> cannot handle multiple package specifications
+within one file.
+
+=head1 DIAGNOSTICS
+
+C<AutoSplit> will inform the user if it is necessary to create the top-level
+directory specified in the invocation. It is preferred that the script or
+installation process that invokes C<AutoSplit> have created the full directory
+path ahead of time. This warning may indicate that the module is being split
+into an incorrect path.
+
+C<AutoSplit> will warn the user of all subroutines whose name causes potential
+file naming conflicts on machines with drastically limited (8 characters or
+less) file name length. Since the subroutine name is used as the file name,
+these warnings can aid in portability to such systems.
+
+Warnings are issued and the file skipped if C<AutoSplit> cannot locate either
+the I<__END__> marker or a "package Name;"-style specification.
+
+C<AutoSplit> will also emit general diagnostics for inability to create
+directories or files.
 
 =cut
 
@@ -53,7 +121,7 @@ sub autosplit{
 
 
 # This function is used during perl building/installation
-# ./miniperl -e 'use AutoSplit; autosplit_modules(@ARGV)' ...
+# ./miniperl -e 'use AutoSplit; autosplit_lib_modules(@ARGV)' ...
 
 sub autosplit_lib_modules{
     my(@modules) = @_; # list of Module names
@@ -82,14 +150,12 @@ sub autosplit_file{
 
     # where to write output files
     $autodir = "lib/auto" unless $autodir;
-    ($autodir = VMS::Filespec::unixpath($autodir)) =~ s#/$## if $Is_VMS;
+    if ($Is_VMS) {
+	($autodir = VMS::Filespec::unixpath($autodir)) =~ s{/$}{};
+	$filename = VMS::Filespec::unixify($filename); # may have dirs
+    }
     unless (-d $autodir){
-	local($", @p)="/";
-	foreach(split(/\//,$autodir)){
-	    push(@p, $_);
-	    next if -d "@p/";
-	    mkdir("@p",0755) or die "AutoSplit unable to mkdir @p: $!";
-	}
+	mkpath($autodir,0,0755);
 	# We should never need to create the auto dir here. installperl
 	# (or similar) should have done it. Expecting it to exist is a valuable
 	# sanity check against autosplitting into some random directory by mistake.
@@ -123,13 +189,20 @@ sub autosplit_file{
 
     $package or die "Can't find 'package Name;' in $filename\n";
 
-    my($modpname) = $package; $modpname =~ s#::#/#g;
-    my($al_idx_file) = "$autodir/$modpname/$IndexFile";
+    my($modpname) = $package; 
+    if ($^O eq 'MSWin32') {
+	$modpname =~ s#::#\\#g; 
+    } else {
+	$modpname =~ s#::#/#g;
+    }
 
-    die "Package $package does not match filename $filename"
-	    unless ($filename =~ m/$modpname.pm$/ or
+    die "Package $package ($modpname.pm) does not match filename $filename"
+	    unless ($filename =~ m/\Q$modpname.pm\E$/ or
+		    ($^O eq "msdos") or ($^O eq 'MSWin32') or
 	            $Is_VMS && $filename =~ m/$modpname.pm/i);
 
+    my($al_idx_file) = "$autodir/$modpname/$IndexFile";
+
     if ($check_mod_time){
 	my($al_ts_time) = (stat("$al_idx_file"))[9] || 1;
 	if ($al_ts_time >= $pm_mod_time){
@@ -144,12 +217,7 @@ sub autosplit_file{
 	if $Verbose;
 
     unless (-d "$autodir/$modpname"){
-	local($", @p)="/";
-	foreach(split(/\//,"$autodir/$modpname")){
-	    push(@p, $_);
-	    next if -d "@p/";
-	    mkdir("@p",0777) or die "AutoSplit unable to mkdir @p: $!";
-	}
+	mkpath("$autodir/$modpname",0,0777);
     }
 
     # We must try to deal with some SVR3 systems with a limit of 14
@@ -180,14 +248,17 @@ sub autosplit_file{
 
     open(OUT,">/dev/null") || open(OUT,">nla0:"); # avoid 'not opened' warning
     my(@subnames, %proto);
+    my @cache = ();
+    my $caching = 1;
     while (<IN>) {
+	next if /^=\w/ .. /^=cut/;
 	if (/^package ([\w:]+)\s*;/) {
 	    warn "package $1; in AutoSplit section ignored. Not currently supported.";
 	}
 	if (/^sub\s+([\w:]+)(\s*\(.*?\))?/) {
 	    print OUT "1;\n";
 	    my $subname = $1;
-	    $proto{$1} = $2 or '';
+	    $proto{$1} = $2 || '';
 	    if ($subname =~ m/::/){
 		warn "subs with package names not currently supported in AutoSplit section";
 	    }
@@ -207,10 +278,26 @@ sub autosplit_file{
 	    print OUT "# NOTE: Derived from $filename.  ",
 			"Changes made here will be lost.\n";
 	    print OUT "package $package;\n\n";
+	    print OUT @cache;
+	    @cache = ();
+	    $caching = 0;
+	}
+	if($caching) {
+	    push(@cache, $_) if @cache || /\S/;
+	}
+	else {
+	    print OUT $_;
+	}
+	if(/^}/) {
+	    if($caching) {
+		print OUT @cache;
+		@cache = ();
+	    }
+	    print OUT "\n";
+	    $caching = 1;
 	}
-	print OUT $_;
     }
-    print OUT "1;\n";
+    print OUT @cache,"1;\n";
     close(OUT);
     close(IN);
 
diff --git a/lib/Benchmark.pm b/lib/Benchmark.pm
index 9929e6e0be..13acf869bc 100644
--- a/lib/Benchmark.pm
+++ b/lib/Benchmark.pm
@@ -14,11 +14,18 @@ timeit - run a chunk of code and see how long it goes
 
     timethis ($count, "code");
 
+    # Use Perl code in strings...
     timethese($count, {
 	'Name1' => '...code1...',
 	'Name2' => '...code2...',
     });
 
+    # ... or use subroutine references.
+    timethese($count, {
+	'Name1' => sub { ...code1... },
+	'Name2' => sub { ...code2... },
+    });
+
     $t = timeit($count, '...other code...')
     print "$count loops of other code took:",timestr($t),"\n";
 
@@ -40,43 +47,70 @@ Returns the current time.   Example:
     # ... your code here ...
     $t1 = new Benchmark;
     $td = timediff($t1, $t0);
-    print "the code took:",timestr($dt),"\n";
+    print "the code took:",timestr($td),"\n";
 
 =item debug
 
 Enables or disable debugging by setting the C<$Benchmark::Debug> flag:
 
-    debug Benchmark 1; 
+    debug Benchmark 1;
     $t = timeit(10, ' 5 ** $Global ');
-    debug Benchmark 0; 
+    debug Benchmark 0;
 
 =back
 
 =head2 Standard Exports
 
-The following routines will be exported into your namespace 
+The following routines will be exported into your namespace
 if you use the Benchmark module:
 
 =over 10
 
 =item timeit(COUNT, CODE)
 
-Arguments: COUNT is the number of time to run the loop, and 
-the second is the code to run.  CODE may be a string containing the code,
-a reference to the function to run, or a reference to a hash containing 
-keys which are names and values which are more CODE specs.
+Arguments: COUNT is the number of times to run the loop, and CODE is
+the code to run.  CODE may be either a code reference or a string to
+be eval'd; either way it will be run in the caller's package.
+
+Returns: a Benchmark object.
+
+=item timethis ( COUNT, CODE, [ TITLE, [ STYLE ]] )
+
+Time COUNT iterations of CODE. CODE may be a string to eval or a
+code reference; either way the CODE will run in the caller's package.
+Results will be printed to STDOUT as TITLE followed by the times.
+TITLE defaults to "timethis COUNT" if none is provided. STYLE
+determines the format of the output, as described for timestr() below.
+
+=item timethese ( COUNT, CODEHASHREF, [ STYLE ] )
 
-Side-effects: prints out noise to standard out.
+The CODEHASHREF is a reference to a hash containing names as keys
+and either a string to eval or a code reference for each value.
+For each (KEY, VALUE) pair in the CODEHASHREF, this routine will
+call
 
-Returns: a Benchmark object.  
+	timethis(COUNT, VALUE, KEY, STYLE)
 
-=item timethis
+=item timediff ( T1, T2 )
 
-=item timethese
+Returns the difference between two Benchmark times as a Benchmark
+object suitable for passing to timestr().
 
-=item timediff
+=item timestr ( TIMEDIFF, [ STYLE, [ FORMAT ]] )
 
-=item timestr
+Returns a string that formats the times in the TIMEDIFF object in
+the requested STYLE. TIMEDIFF is expected to be a Benchmark object
+similar to that returned by timediff().
+
+STYLE can be any of 'all', 'noc', 'nop' or 'auto'. 'all' shows each
+of the 5 times available ('wallclock' time, user time, system time,
+user time of children, and system time of children). 'noc' shows all
+except the two children times. 'nop' shows only wallclock and the
+two children times. 'auto' (the default) will act as 'all' unless
+the children times are both zero, in which case it acts as 'noc'.
+
+FORMAT is the L<printf(3)>-style format specifier (without the
+leading '%') to use to print the times. It defaults to '5.2f'.
 
 =back
 
@@ -87,20 +121,31 @@ if you specifically ask that they be imported:
 
 =over 10
 
-clearcache
+=item clearcache ( COUNT )
+
+Clear the cached time for COUNT rounds of the null loop.
+
+=item clearallcache ( )
 
-clearallcache
+Clear all cached times.
 
-disablecache
+=item disablecache ( )
 
-enablecache
+Disable caching of timings for the null loop. This will force Benchmark
+to recalculate these timings for each new piece of code timed.
+
+=item enablecache ( )
+
+Enable caching of timings for the null loop. The time taken for COUNT
+rounds of the null loop will be calculated only once for each
+different COUNT used.
 
 =back
 
 =head1 NOTES
 
 The data is stored as a list of values from the time and times
-functions: 
+functions:
 
       ($real, $user, $system, $children_user, $children_system)
 
@@ -110,10 +155,6 @@ The timing is done using time(3) and times(3).
 
 Code is executed in the caller's package.
 
-Enable debugging by:  
-
-    $Benchmark::debug = 1;
-
 The time of the null loop (a loop with the same
 number of rounds but empty loop body) is subtracted
 from the time of the real loop.
@@ -122,10 +163,10 @@ The null loop times are cached, the key being the
 number of rounds. The caching can be controlled using
 calls like these:
 
-    clearcache($key); 
+    clearcache($key);
     clearallcache();
 
-    disablecache(); 
+    disablecache();
     enablecache();
 
 =head1 INHERITANCE
@@ -135,112 +176,36 @@ for Exporter.
 
 =head1 CAVEATS
 
+Comparing eval'd strings with code references will give you
+inaccurate results: a code reference will show a slower
+execution time than the equivalent eval'd string.
+
 The real time timing is done using time(2) and
 the granularity is therefore only one second.
 
 Short tests may produce negative figures because perl
-can appear to take longer to execute the empty loop 
-than a short test; try: 
+can appear to take longer to execute the empty loop
+than a short test; try:
 
     timethis(100,'1');
 
 The system time of the null loop might be slightly
 more than the system time of the loop with the actual
-code and therefore the difference might end up being < 0.
-
-More documentation is needed :-( especially for styles and formats.
+code and therefore the difference might end up being E<lt> 0.
 
 =head1 AUTHORS
 
-Jarkko Hietaniemi <Jarkko.Hietaniemi@hut.fi>,
-Tim Bunce <Tim.Bunce@ig.co.uk>
+Jarkko Hietaniemi <F<jhi@iki.fi>>, Tim Bunce <F<Tim.Bunce@ig.co.uk>>
 
 =head1 MODIFICATION HISTORY
 
 September 8th, 1994; by Tim Bunce.
 
-=cut
+March 28th, 1997; by Hugo van der Sanden: added support for code
+references and the already documented 'debug' method; revamped
+documentation.
 
-# Purpose: benchmark running times of code.
-#
-#
-# Usage - to time code snippets and print results:
-#
-#	timethis($count, '...code...');
-#		
-# prints:
-#	timethis 100:  2 secs ( 0.23 usr  0.10 sys =  0.33 cpu)
-#
-#
-#	timethese($count, {
-#		Name1 => '...code1...',
-#		Name2 => '...code2...',
-#		... });
-# prints:
-#	Benchmark: timing 100 iterations of Name1, Name2...
-#	     Name1:  2 secs ( 0.50 usr  0.00 sys =  0.50 cpu)
-#	     Name2:  1 secs ( 0.48 usr  0.00 sys =  0.48 cpu)
-#
-# The default display style will automatically add child process
-# values if non-zero.
-#
-#
-# Usage - to time sections of your own code:
-#
-#	use Benchmark;
-#	$t0 = new Benchmark;
-#	... your code here ...
-#	$t1 = new Benchmark;
-#	$td = &timediff($t1, $t0);
-#	print "the code took:",timestr($td),"\n";
-#
-#	$t = &timeit($count, '...other code...')
-#	print "$count loops of other code took:",timestr($t),"\n";
-# 
-#
-# Data format:
-#       The data is stored as a list of values from the time and times
-#       functions: ($real, $user, $system, $children_user, $children_system)
-#	in seconds for the whole loop (not divided by the number of rounds).
-#		
-# Internals:
-#	The timing is done using time(3) and times(3).
-#		
-#	Code is executed in the callers package
-#
-#	Enable debugging by:  $Benchmark::debug = 1;
-#
-#	The time of the null loop (a loop with the same
-#	number of rounds but empty loop body) is substracted
-#	from the time of the real loop.
-#
-#	The null loop times are cached, the key being the
-#	number of rounds. The caching can be controlled using
-#	&clearcache($key); &clearallcache;
-#	&disablecache; &enablecache;
-#
-# Caveats:
-#
-#	The real time timing is done using time(2) and
-#	the granularity is therefore only one second.
-#
-#	Short tests may produce negative figures because perl
-#	can appear to take longer to execute the empty loop 
-#	than a short test: try timethis(100,'1');
-#
-#	The system time of the null loop might be slightly
-#	more than the system time of the loop with the actual
-#	code and therefore the difference might end up being < 0
-#
-#	More documentation is needed :-(
-#	Especially for styles and formats.
-#
-# Authors:	Jarkko Hietaniemi <Jarkko.Hietaniemi@hut.fi>
-# 		Tim Bunce <Tim.Bunce@ig.co.uk>
-#
-#
-# Last updated:	Sept 8th 94 by Tim Bunce
-#
+=cut
 
 use Carp;
 use Exporter;
@@ -263,76 +228,79 @@ sub init {
     &clearallcache;
 }
 
+sub debug { $debug = ($_[1] != 0); }
+
 sub clearcache    { delete $cache{$_[0]}; }
 sub clearallcache { %cache = (); }
 sub enablecache   { $cache = 1; }
 sub disablecache  { $cache = 0; }
 
-
 # --- Functions to process the 'time' data type
 
-sub new { my(@t)=(time, times); print "new=@t\n" if $debug; bless \@t; }
+sub new { my @t = (time, times); print "new=@t\n" if $debug; bless \@t; }
 
 sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps         ; }
 sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]};         $cu+$cs ; }
 sub cpu_a { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps+$cu+$cs ; }
 sub real  { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r              ; }
 
-sub timediff{
+sub timediff {
     my($a, $b) = @_;
-    my(@r);
-    for($i=0; $i < @$a; ++$i){
+    my @r;
+    for ($i=0; $i < @$a; ++$i) {
 	push(@r, $a->[$i] - $b->[$i]);
     }
     bless \@r;
 }
 
-sub timestr{
+sub timestr {
     my($tr, $style, $f) = @_;
-    my(@t) = @$tr;
+    my @t = @$tr;
     warn "bad time value" unless @t==5;
     my($r, $pu, $ps, $cu, $cs) = @t;
     my($pt, $ct, $t) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a);
-    $f = $defaultfmt unless $f;
+    $f = $defaultfmt unless defined $f;
     # format a time in the required style, other formats may be added here
-    $style = $defaultstyle unless $style;
-    $style = ($ct>0) ? 'all' : 'noc' if $style=~/^auto$/;
-    my($s) = "@t $style"; # default for unknown style
+    $style ||= $defaultstyle;
+    $style = ($ct>0) ? 'all' : 'noc' if $style eq 'auto';
+    my $s = "@t $style"; # default for unknown style
     $s=sprintf("%2d secs (%$f usr %$f sys + %$f cusr %$f csys = %$f cpu)",
-			    @t,$t) if $style =~ /^all$/;
+			    @t,$t) if $style eq 'all';
     $s=sprintf("%2d secs (%$f usr %$f sys = %$f cpu)",
-			    $r,$pu,$ps,$pt) if $style =~ /^noc$/;
+			    $r,$pu,$ps,$pt) if $style eq 'noc';
     $s=sprintf("%2d secs (%$f cusr %$f csys = %$f cpu)",
-			    $r,$cu,$cs,$ct) if $style =~ /^nop$/;
+			    $r,$cu,$cs,$ct) if $style eq 'nop';
     $s;
 }
-sub timedebug{
+
+sub timedebug {
     my($msg, $t) = @_;
-    print STDERR "$msg",timestr($t),"\n" if ($debug);
+    print STDERR "$msg",timestr($t),"\n" if $debug;
 }
 
-
 # --- Functions implementing low-level support for timing loops
 
 sub runloop {
     my($n, $c) = @_;
 
     $n+=0; # force numeric now, so garbage won't creep into the eval
-    croak "negativ loopcount $n" if $n<0;
-    confess "Usage: runloop(number, string)" unless defined $c;
+    croak "negative loopcount $n" if $n<0;
+    confess "Usage: runloop(number, [string | coderef])" unless defined $c;
     my($t0, $t1, $td); # before, after, difference
 
     # find package of caller so we can execute code there
-    my ($curpack) = caller(0);
-    my ($i, $pack)= 0;
+    my($curpack) = caller(0);
+    my($i, $pack)= 0;
     while (($pack) = caller(++$i)) {
 	last if $pack ne $curpack;
     }
 
-    my $subcode = "sub { package $pack; my(\$_i)=$n; while (\$_i--){$c;} }";
+    my $subcode = (ref $c eq 'CODE')
+	? "sub { package $pack; my(\$_i)=$n; while (\$_i--){&\$c;} }"
+	: "sub { package $pack; my(\$_i)=$n; while (\$_i--){$c;} }";
     my $subref  = eval $subcode;
     croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
-    print STDERR "runloop $n '$subcode'\n" if ($debug);
+    print STDERR "runloop $n '$subcode'\n" if $debug;
 
     $t0 = &new;
     &$subref;
@@ -350,9 +318,9 @@ sub timeit {
 
     printf STDERR "timeit $n $code\n" if $debug;
 
-    if ($cache && exists $cache{$n}){
+    if ($cache && exists $cache{$n}) {
 	$wn = $cache{$n};
-    }else{
+    } else {
 	$wn = &runloop($n, '');
 	$cache{$n} = $wn;
     }
@@ -368,44 +336,38 @@ sub timeit {
     $wd;
 }
 
-
 # --- Functions implementing high-level time-then-print utilities
 
 sub timethis{
     my($n, $code, $title, $style) = @_;
-    my($t) = timeit($n, $code);
-    local($|) = 1;
-    $title = "timethis $n" unless $title;
-    $style = "" unless $style;
+    my $t = timeit($n, $code);
+    local $| = 1;
+    $title = "timethis $n" unless defined $title;
+    $style = "" unless defined $style;
     printf("%10s: ", $title);
     print timestr($t, $style),"\n";
+
     # A conservative warning to spot very silly tests.
     # Don't assume that your benchmark is ok simply because
     # you don't get this warning!
     print "            (warning: too few iterations for a reliable count)\n"
-	if (   $n < $min_count
+	if     $n < $min_count
 	    || ($t->real < 1 && $n < 1000)
-	    || $t->cpu_a < $min_cpu);
+	    || $t->cpu_a < $min_cpu;
     $t;
 }
 
-
 sub timethese{
     my($n, $alt, $style) = @_;
     die "usage: timethese(count, { 'Name1'=>'code1', ... }\n"
 		unless ref $alt eq HASH;
-    my(@all);
-    my(@names) = sort keys %$alt;
-    $style = "" unless $style;
+    my @names = sort keys %$alt;
+    $style = "" unless defined $style;
     print "Benchmark: timing $n iterations of ",join(', ',@names),"...\n";
-    foreach(@names){
-	$t = timethis($n, $alt->{$_}, $_, $style);
-	push(@all, $t);
-    }
-    # we could produce a summary from @all here
+
+    # we could save the results in an array and produce a summary here
     # sum, min, max, avg etc etc
-    @all;
+    map timethis($n, $alt->{$_}, $_, $style), @names;
 }
 
-
 1;
diff --git a/lib/Bundle/CPAN.pm b/lib/Bundle/CPAN.pm
new file mode 100644
index 0000000000..2a05deef59
--- /dev/null
+++ b/lib/Bundle/CPAN.pm
@@ -0,0 +1,33 @@
+package Bundle::CPAN;
+
+$VERSION = '0.02';
+
+1;
+
+__END__
+
+=head1 NAME
+
+Bundle::CPAN - A bundle to play with all the other modules on CPAN
+
+=head1 SYNOPSIS
+
+C<perl -MCPAN -e 'install Bundle::CPAN'>
+
+=head1 CONTENTS
+
+CPAN
+
+CPAN::WAIT
+
+=head1 DESCRIPTION
+
+This bundle includes CPAN.pm as the base module and CPAN::WAIT, the
+first plugin for CPAN that was developed even before there was an API.
+
+After installing this bundle, it is recommended to quit the current
+session and start again in a new process.
+
+=head1 AUTHOR
+
+Andreas König
diff --git a/lib/CGI.pm b/lib/CGI.pm
new file mode 100644
index 0000000000..e53c957677
--- /dev/null
+++ b/lib/CGI.pm
@@ -0,0 +1,5108 @@
+package CGI;
+require 5.001;
+
+# See the bottom of this file for the POD documentation.  Search for the
+# string '=head'.
+
+# You can run this file through either pod2man or pod2html to produce pretty
+# documentation in manual or html file format (these utilities are part of the
+# Perl 5 distribution).
+
+# Copyright 1995-1997 Lincoln D. Stein.  All rights reserved.
+# It may be used and modified freely, but I do request that this copyright
+# notice remain attached to the file.  You may modify this module as you 
+# wish, but if you redistribute a modified version, please attach a note
+# listing the modifications you have made.
+
+# The most recent version and complete docs are available at:
+#   http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
+#   ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
+
+# Set this to 1 to enable copious autoloader debugging messages
+$AUTOLOAD_DEBUG=0;
+
+# Set this to 1 to enable NPH scripts
+# or: 
+#    1) use CGI qw(:nph)
+#    2) $CGI::nph(1)
+#    3) print header(-nph=>1)
+$NPH=0;
+
+# Set this to 1 to make the temporary files created
+# during file uploads safe from prying eyes
+# or do...
+#    1) use CGI qw(:private_tempfiles)
+#    2) $CGI::private_tempfiles(1);
+$PRIVATE_TEMPFILES=0;
+
+$CGI::revision = '$Id: CGI.pm,v 2.36 1997/5/10 8:22 lstein Exp $';
+$CGI::VERSION='2.36';
+
+# OVERRIDE THE OS HERE IF CGI.pm GUESSES WRONG
+# $OS = 'UNIX';
+# $OS = 'MACINTOSH';
+# $OS = 'WINDOWS';
+# $OS = 'VMS';
+# $OS = 'OS2';
+
+# HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
+# UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
+# $TempFile::TMPDIRECTORY = '/usr/tmp';
+
+# ------------------ START OF THE LIBRARY ------------
+
+# FIGURE OUT THE OS WE'RE RUNNING UNDER
+# Some systems support the $^O variable.  If not
+# available then require() the Config library
+unless ($OS) {
+    unless ($OS = $^O) {
+	require Config;
+	$OS = $Config::Config{'osname'};
+    }
+}
+if ($OS=~/Win/i) {
+    $OS = 'WINDOWS';
+} elsif ($OS=~/vms/i) {
+    $OS = 'VMS';
+} elsif ($OS=~/Mac/i) {
+    $OS = 'MACINTOSH';
+} elsif ($OS=~/os2/i) {
+    $OS = 'OS2';
+} else {
+    $OS = 'UNIX';
+}
+
+# Some OS logic.  Binary mode enabled on DOS, NT and VMS
+$needs_binmode = $OS=~/^(WINDOWS|VMS|OS2)/;
+
+# This is the default class for the CGI object to use when all else fails.
+$DefaultClass = 'CGI' unless defined $CGI::DefaultClass;
+# This is where to look for autoloaded routines.
+$AutoloadClass = $DefaultClass unless defined $CGI::AutoloadClass;
+
+# The path separator is a slash, backslash or semicolon, depending
+# on the paltform.
+$SL = {
+    UNIX=>'/',
+    OS2=>'\\',
+    WINDOWS=>'\\',
+    MACINTOSH=>':',
+    VMS=>'\\'
+    }->{$OS};
+
+# Turn on NPH scripts by default when running under IIS server!
+$NPH++ if defined($ENV{'SERVER_SOFTWARE'}) && $ENV{'SERVER_SOFTWARE'}=~/IIS/;
+
+# Turn on special checking for Doug MacEachern's modperl
+if (defined($ENV{'GATEWAY_INTERFACE'}) && ($MOD_PERL = $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-Perl/)) {
+    $NPH++;
+    $| = 1;
+    $SEQNO = 1;
+}
+
+# This is really "\r\n", but the meaning of \n is different
+# in MacPerl, so we resort to octal here.
+$CRLF = "\015\012";
+
+if ($needs_binmode) {
+    $CGI::DefaultClass->binmode(main::STDOUT);
+    $CGI::DefaultClass->binmode(main::STDIN);
+    $CGI::DefaultClass->binmode(main::STDERR);
+}
+
+# Cute feature, but it broke when the overload mechanism changed...
+# %OVERLOAD = ('""'=>'as_string');
+
+%EXPORT_TAGS = (
+	      ':html2'=>[h1..h6,qw/p br hr ol ul li dl dt dd menu code var strong em
+			 tt i b blockquote pre img a address cite samp dfn html head
+			 base body link nextid title meta kbd start_html end_html
+			 input Select option/],
+	      ':html3'=>[qw/div table caption th td TR Tr super sub strike applet PARAM embed basefont style span/],
+	      ':netscape'=>[qw/blink frameset frame script font fontsize center/],
+	      ':form'=>[qw/textfield textarea filefield password_field hidden checkbox checkbox_group 
+		       submit reset defaults radio_group popup_menu button autoEscape
+		       scrolling_list image_button start_form end_form startform endform
+		       start_multipart_form isindex tmpFileName uploadInfo URL_ENCODED MULTIPART/],
+	      ':cgi'=>[qw/param path_info path_translated url self_url script_name cookie dump
+		       raw_cookie request_method query_string accept user_agent remote_host 
+		       remote_addr referer server_name server_software server_port server_protocol
+		       virtual_host remote_ident auth_type http use_named_parameters
+		       remote_user user_name header redirect import_names put/],
+	      ':ssl' => [qw/https/],
+	      ':cgi-lib' => [qw/ReadParse PrintHeader HtmlTop HtmlBot SplitParam/],
+	      ':html' => [qw/:html2 :html3 :netscape/],
+	      ':standard' => [qw/:html2 :form :cgi/],
+	      ':all' => [qw/:html2 :html3 :netscape :form :cgi/]
+	 );
+
+# to import symbols into caller
+sub import {
+    my $self = shift;
+    my ($callpack, $callfile, $callline) = caller;
+    foreach (@_) {
+	$NPH++, next if $_ eq ':nph';
+	$PRIVATE_TEMPFILES++, next if $_ eq ':private_tempfiles';
+	foreach (&expand_tags($_)) {
+	    tr/a-zA-Z0-9_//cd;  # don't allow weird function names
+	    $EXPORT{$_}++;
+	}
+    }
+    # To allow overriding, search through the packages
+    # Till we find one in which the correct subroutine is defined.
+    my @packages = ($self,@{"$self\:\:ISA"});
+    foreach $sym (keys %EXPORT) {
+	my $pck;
+	my $def = ${"$self\:\:AutoloadClass"} || $DefaultClass;
+	foreach $pck (@packages) {
+	    if (defined(&{"$pck\:\:$sym"})) {
+		$def = $pck;
+		last;
+	    }
+	}
+	*{"${callpack}::$sym"} = \&{"$def\:\:$sym"};
+    }
+}
+
+sub expand_tags {
+    my($tag) = @_;
+    my(@r);
+    return ($tag) unless $EXPORT_TAGS{$tag};
+    foreach (@{$EXPORT_TAGS{$tag}}) {
+	push(@r,&expand_tags($_));
+    }
+    return @r;
+}
+
+#### Method: new
+# The new routine.  This will check the current environment
+# for an existing query string, and initialize itself, if so.
+####
+sub new {
+    my($class,$initializer) = @_;
+    my $self = {};
+    bless $self,ref $class || $class || $DefaultClass;
+    $CGI::DefaultClass->_reset_globals() if $MOD_PERL;
+    $initializer = to_filehandle($initializer) if $initializer;
+    $self->init($initializer);
+    return $self;
+}
+
+# We provide a DESTROY method so that the autoloader
+# doesn't bother trying to find it.
+sub DESTROY { }
+
+#### Method: param
+# Returns the value(s)of a named parameter.
+# If invoked in a list context, returns the
+# entire list.  Otherwise returns the first
+# member of the list.
+# If name is not provided, return a list of all
+# the known parameters names available.
+# If more than one argument is provided, the
+# second and subsequent arguments are used to
+# set the value of the parameter.
+####
+sub param {
+    my($self,@p) = self_or_default(@_);
+    return $self->all_parameters unless @p;
+    my($name,$value,@other);
+
+    # For compatibility between old calling style and use_named_parameters() style, 
+    # we have to special case for a single parameter present.
+    if (@p > 1) {
+	($name,$value,@other) = $self->rearrange([NAME,[DEFAULT,VALUE,VALUES]],@p);
+	my(@values);
+
+	if (substr($p[0],0,1) eq '-' || $self->use_named_parameters) {
+	    @values = defined($value) ? (ref($value) && ref($value) eq 'ARRAY' ? @{$value} : $value) : ();
+	} else {
+	    foreach ($value,@other) {
+		push(@values,$_) if defined($_);
+	    }
+	}
+	# If values is provided, then we set it.
+	if (@values) {
+	    $self->add_parameter($name);
+	    $self->{$name}=[@values];
+	}
+    } else {
+	$name = $p[0];
+    }
+
+    return () unless defined($name) && $self->{$name};
+    return wantarray ? @{$self->{$name}} : $self->{$name}->[0];
+}
+
+#### Method: delete
+# Deletes the named parameter entirely.
+####
+sub delete {
+    my($self,$name) = self_or_default(@_);
+    delete $self->{$name};
+    delete $self->{'.fieldnames'}->{$name};
+    @{$self->{'.parameters'}}=grep($_ ne $name,$self->param());
+    return wantarray ? () : undef;
+}
+
+sub self_or_default {
+    return @_ if defined($_[0]) && !ref($_[0]) && ($_[0] eq 'CGI');
+    unless (defined($_[0]) && 
+	    ref($_[0]) &&
+	    (ref($_[0]) eq 'CGI' ||
+	     eval "\$_[0]->isaCGI()")) { # optimize for the common case
+	$CGI::DefaultClass->_reset_globals() 
+	    if defined($Q) && $MOD_PERL && $CGI::DefaultClass->_new_request();
+	$Q = $CGI::DefaultClass->new unless defined($Q);
+	unshift(@_,$Q);
+    }
+    return @_;
+}
+
+sub _new_request {
+    return undef unless (defined(Apache->seqno()) or eval { require Apache });
+    if (Apache->seqno() != $SEQNO) {
+	$SEQNO = Apache->seqno();
+	return 1;
+    } else {
+	return undef;
+    }
+}
+
+sub _reset_globals {
+    undef $Q;
+    undef @QUERY_PARAM;
+}
+
+sub self_or_CGI {
+    local $^W=0;                # prevent a warning
+    if (defined($_[0]) &&
+	(substr(ref($_[0]),0,3) eq 'CGI' 
+	 || eval "\$_[0]->isaCGI()")) {
+	return @_;
+    } else {
+	return ($DefaultClass,@_);
+    }
+}
+
+sub isaCGI {
+    return 1;
+}
+
+#### Method: import_names
+# Import all parameters into the given namespace.
+# Assumes namespace 'Q' if not specified
+####
+sub import_names {
+    my($self,$namespace) = self_or_default(@_);
+    $namespace = 'Q' unless defined($namespace);
+    die "Can't import names into 'main'\n"
+	if $namespace eq 'main';
+    my($param,@value,$var);
+    foreach $param ($self->param) {
+	# protect against silly names
+	($var = $param)=~tr/a-zA-Z0-9_/_/c;
+	$var = "${namespace}::$var";
+	@value = $self->param($param);
+	@{$var} = @value;
+	${$var} = $value[0];
+    }
+}
+
+#### Method: use_named_parameters
+# Force CGI.pm to use named parameter-style method calls
+# rather than positional parameters.  The same effect
+# will happen automatically if the first parameter
+# begins with a -.
+sub use_named_parameters {
+    my($self,$use_named) = self_or_default(@_);
+    return $self->{'.named'} unless defined ($use_named);
+
+    # stupidity to avoid annoying warnings
+    return $self->{'.named'}=$use_named;
+}
+
+########################################
+# THESE METHODS ARE MORE OR LESS PRIVATE
+# GO TO THE __DATA__ SECTION TO SEE MORE
+# PUBLIC METHODS
+########################################
+
+# Initialize the query object from the environment.
+# If a parameter list is found, this object will be set
+# to an associative array in which parameter names are keys
+# and the values are stored as lists
+# If a keyword list is found, this method creates a bogus
+# parameter list with the single parameter 'keywords'.
+
+sub init {
+    my($self,$initializer) = @_;
+    my($query_string,@lines);
+    my($meth) = '';
+
+    # if we get called more than once, we want to initialize
+    # ourselves from the original query (which may be gone
+    # if it was read from STDIN originally.)
+    if (defined(@QUERY_PARAM) && !defined($initializer)) {
+
+	foreach (@QUERY_PARAM) {
+	    $self->param('-name'=>$_,'-value'=>$QUERY_PARAM{$_});
+	}
+	return;
+    }
+
+    $meth=$ENV{'REQUEST_METHOD'} if defined($ENV{'REQUEST_METHOD'});
+
+    # If initializer is defined, then read parameters
+    # from it.
+  METHOD: {
+      if (defined($initializer)) {
+
+	  if (ref($initializer) && ref($initializer) eq 'HASH') {
+	      foreach (keys %$initializer) {
+		  $self->param('-name'=>$_,'-value'=>$initializer->{$_});
+	      }
+	      last METHOD;
+	  }
+	  
+	  $initializer = $$initializer if ref($initializer);
+	  if (defined(fileno($initializer))) {
+	      while (<$initializer>) {
+		  chomp;
+		  last if /^=/;
+		  push(@lines,$_);
+	      }
+	      # massage back into standard format
+	      if ("@lines" =~ /=/) {
+		  $query_string=join("&",@lines);
+	      } else {
+		  $query_string=join("+",@lines);
+	      }
+	      last METHOD;
+	  }
+	  $query_string = $initializer;
+	  last METHOD;
+      }
+	  # If method is GET or HEAD, fetch the query from
+	  # the environment.
+      if ($meth=~/^(GET|HEAD)$/) {
+	$query_string = $ENV{'QUERY_STRING'};
+	last METHOD;
+    }
+	
+      # If the method is POST, fetch the query from standard
+      # input.
+      if ($meth eq 'POST') {
+
+	  if (defined($ENV{'CONTENT_TYPE'}) 
+	      && 
+	      $ENV{'CONTENT_TYPE'}=~m|^multipart/form-data|) {
+	      my($boundary) = $ENV{'CONTENT_TYPE'}=~/boundary=(\S+)/;
+	      $self->read_multipart($boundary,$ENV{'CONTENT_LENGTH'});
+
+	  } else {
+
+	      $self->read_from_client(\*STDIN,\$query_string,$ENV{'CONTENT_LENGTH'},0)
+		  if $ENV{'CONTENT_LENGTH'} > 0;
+
+	  }
+	  # Some people want to have their cake and eat it too!
+	  # Uncomment this line to have the contents of the query string
+	  # APPENDED to the POST data.
+	  # $query_string .= ($query_string ? '&' : '') . $ENV{'QUERY_STRING'} if $ENV{'QUERY_STRING'};
+	  last METHOD;
+      }
+	  
+      # If neither is set, assume we're being debugged offline.
+      # Check the command line and then the standard input for data.
+      # We use the shellwords package in order to behave the way that
+      # UN*X programmers expect.
+      $query_string = &read_from_cmdline;
+  }
+    
+    # We now have the query string in hand.  We do slightly
+    # different things for keyword lists and parameter lists.
+    if ($query_string) {
+	if ($query_string =~ /=/) {
+	    $self->parse_params($query_string);
+	} else {
+	    $self->add_parameter('keywords');
+	    $self->{'keywords'} = [$self->parse_keywordlist($query_string)];
+	}
+    }
+
+    # Special case.  Erase everything if there is a field named
+    # .defaults.
+    if ($self->param('.defaults')) {
+	undef %{$self};
+    }
+
+    # Associative array containing our defined fieldnames
+    $self->{'.fieldnames'} = {};
+    foreach ($self->param('.cgifields')) {
+	$self->{'.fieldnames'}->{$_}++;
+    }
+    
+    # Clear out our default submission button flag if present
+    $self->delete('.submit');
+    $self->delete('.cgifields');
+    $self->save_request unless $initializer;
+
+}
+
+
+# FUNCTIONS TO OVERRIDE:
+
+# Turn a string into a filehandle
+sub to_filehandle {
+    my $string = shift;
+    if ($string && !ref($string)) {
+	my($package) = caller(1);
+	my($tmp) = $string=~/[':]/ ? $string : "$package\:\:$string"; 
+	return $tmp if defined(fileno($tmp));
+    }
+    return $string;
+}
+
+# Create a new multipart buffer
+sub new_MultipartBuffer {
+    my($self,$boundary,$length,$filehandle) = @_;
+    return MultipartBuffer->new($self,$boundary,$length,$filehandle);
+}
+
+# Read data from a file handle
+sub read_from_client {
+    my($self, $fh, $buff, $len, $offset) = @_;
+    local $^W=0;                # prevent a warning
+    return read($fh, $$buff, $len, $offset);
+}
+
+# put a filehandle into binary mode (DOS)
+sub binmode {
+    binmode($_[1]);
+}
+
+# send output to the browser
+sub put {
+    my($self,@p) = self_or_default(@_);
+    $self->print(@p);
+}
+
+# print to standard output (for overriding in mod_perl)
+sub print {
+    shift;
+    CORE::print(@_);
+}
+
+# unescape URL-encoded data
+sub unescape {
+    my($todecode) = @_;
+    $todecode =~ tr/+/ /;       # pluses become spaces
+    $todecode =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
+    return $todecode;
+}
+
+# URL-encode data
+sub escape {
+    my($toencode) = @_;
+    $toencode=~s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;
+    return $toencode;
+}
+
+sub save_request {
+    my($self) = @_;
+    # We're going to play with the package globals now so that if we get called
+    # again, we initialize ourselves in exactly the same way.  This allows
+    # us to have several of these objects.
+    @QUERY_PARAM = $self->param; # save list of parameters
+    foreach (@QUERY_PARAM) {
+	$QUERY_PARAM{$_}=$self->{$_};
+    }
+}
+
+sub parse_keywordlist {
+    my($self,$tosplit) = @_;
+    $tosplit = &unescape($tosplit); # unescape the keywords
+    $tosplit=~tr/+/ /;          # pluses to spaces
+    my(@keywords) = split(/\s+/,$tosplit);
+    return @keywords;
+}
+
+sub parse_params {
+    my($self,$tosplit) = @_;
+    my(@pairs) = split('&',$tosplit);
+    my($param,$value);
+    foreach (@pairs) {
+	($param,$value) = split('=');
+	$param = &unescape($param);
+	$value = &unescape($value);
+	$self->add_parameter($param);
+	push (@{$self->{$param}},$value);
+    }
+}
+
+sub add_parameter {
+    my($self,$param)=@_;
+    push (@{$self->{'.parameters'}},$param) 
+	unless defined($self->{$param});
+}
+
+sub all_parameters {
+    my $self = shift;
+    return () unless defined($self) && $self->{'.parameters'};
+    return () unless @{$self->{'.parameters'}};
+    return @{$self->{'.parameters'}};
+}
+
+#### Method as_string
+#
+# synonym for "dump"
+####
+sub as_string {
+    &dump(@_);
+}
+
+sub AUTOLOAD {
+    print STDERR "CGI::AUTOLOAD for $AUTOLOAD\n" if $CGI::AUTOLOAD_DEBUG;
+    my($func) = $AUTOLOAD;
+    my($pack,$func_name) = $func=~/(.+)::([^:]+)$/;
+    $pack = ${"$pack\:\:AutoloadClass"} || $CGI::DefaultClass
+                unless defined(${"$pack\:\:AUTOLOADED_ROUTINES"});
+
+    my($sub) = \%{"$pack\:\:SUBS"};
+    unless (%$sub) {
+	my($auto) = \${"$pack\:\:AUTOLOADED_ROUTINES"};
+	eval "package $pack; $$auto";
+	die $@ if $@;
+    }
+    my($code) = $sub->{$func_name};
+
+    $code = "sub $AUTOLOAD { }" if (!$code and $func_name eq 'DESTROY');
+    if (!$code) {
+	if ($EXPORT{':any'} || 
+	    $EXPORT{$func_name} || 
+	    (%EXPORT_OK || grep(++$EXPORT_OK{$_},&expand_tags(':html')))
+	    && $EXPORT_OK{$func_name}) {
+	    $code = $sub->{'HTML_FUNC'};
+	    $code=~s/func_name/$func_name/mg;
+	}
+    }
+    die "Undefined subroutine $AUTOLOAD\n" unless $code;
+    eval "package $pack; $code";
+    if ($@) {
+	$@ =~ s/ at .*\n//;
+	die $@;
+    }
+    goto &{"$pack\:\:$func_name"};
+}
+
+# PRIVATE SUBROUTINE
+# Smart rearrangement of parameters to allow named parameter
+# calling.  We do the rearangement if:
+# 1. The first parameter begins with a -
+# 2. The use_named_parameters() method returns true
+sub rearrange {
+    my($self,$order,@param) = @_;
+    return () unless @param;
+    
+    return @param unless (defined($param[0]) && substr($param[0],0,1) eq '-')
+	|| $self->use_named_parameters;
+
+    my $i;
+    for ($i=0;$i<@param;$i+=2) {
+	$param[$i]=~s/^\-//;     # get rid of initial - if present
+	$param[$i]=~tr/a-z/A-Z/; # parameters are upper case
+    }
+    
+    my(%param) = @param;                # convert into associative array
+    my(@return_array);
+    
+    my($key)='';
+    foreach $key (@$order) {
+	my($value);
+	# this is an awful hack to fix spurious warnings when the
+	# -w switch is set.
+	if (ref($key) && ref($key) eq 'ARRAY') {
+	    foreach (@$key) {
+		last if defined($value);
+		$value = $param{$_};
+		delete $param{$_};
+	    }
+	} else {
+	    $value = $param{$key};
+	    delete $param{$key};
+	}
+	push(@return_array,$value);
+    }
+    push (@return_array,$self->make_attributes(\%param)) if %param;
+    return (@return_array);
+}
+
+###############################################################################
+################# THESE FUNCTIONS ARE AUTOLOADED ON DEMAND ####################
+###############################################################################
+$AUTOLOADED_ROUTINES = '';      # get rid of -w warning
+$AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD';
+
+%SUBS = (
+
+'URL_ENCODED'=> <<'END_OF_FUNC',
+sub URL_ENCODED { 'application/x-www-form-urlencoded'; }
+END_OF_FUNC
+
+'MULTIPART' => <<'END_OF_FUNC',
+sub MULTIPART {  'multipart/form-data'; }
+END_OF_FUNC
+
+'HTML_FUNC' => <<'END_OF_FUNC',
+sub func_name { 
+
+    # handle various cases in which we're called
+    # most of this bizarre stuff is to avoid -w errors
+    shift if $_[0] && 
+	(!ref($_[0]) && $_[0] eq $CGI::DefaultClass) ||
+	    (ref($_[0]) &&
+	     (substr(ref($_[0]),0,3) eq 'CGI' ||
+	      eval "\$_[0]->isaCGI()"));
+
+    my($attr) = '';
+    if (ref($_[0]) && ref($_[0]) eq 'HASH') {
+	my(@attr) = CGI::make_attributes('',shift);
+	$attr = " @attr" if @attr;
+    }
+    my($tag,$untag) = ("\U<func_name\E$attr>","\U</func_name>\E");
+    return $tag unless @_;
+    if (ref($_[0]) eq 'ARRAY') {
+	my(@r);
+	foreach (@{$_[0]}) {
+	    push(@r,"$tag$_$untag");
+	}
+	return "@r";
+    } else {
+	return "$tag@_$untag";
+    }
+}
+END_OF_FUNC
+
+#### Method: keywords
+# Keywords acts a bit differently.  Calling it in a list context
+# returns the list of keywords.  
+# Calling it in a scalar context gives you the size of the list.
+####
+'keywords' => <<'END_OF_FUNC',
+sub keywords {
+    my($self,@values) = self_or_default(@_);
+    # If values is provided, then we set it.
+    $self->{'keywords'}=[@values] if @values;
+    my(@result) = @{$self->{'keywords'}};
+    @result;
+}
+END_OF_FUNC
+
+# These are some tie() interfaces for compatibility
+# with Steve Brenner's cgi-lib.pl routines
+'ReadParse' => <<'END_OF_FUNC',
+sub ReadParse {
+    local(*in);
+    if (@_) {
+	*in = $_[0];
+    } else {
+	my $pkg = caller();
+	*in=*{"${pkg}::in"};
+    }
+    tie(%in,CGI);
+}
+END_OF_FUNC
+
+'PrintHeader' => <<'END_OF_FUNC',
+sub PrintHeader {
+    my($self) = self_or_default(@_);
+    return $self->header();
+}
+END_OF_FUNC
+
+'HtmlTop' => <<'END_OF_FUNC',
+sub HtmlTop {
+    my($self,@p) = self_or_default(@_);
+    return $self->start_html(@p);
+}
+END_OF_FUNC
+
+'HtmlBot' => <<'END_OF_FUNC',
+sub HtmlBot {
+    my($self,@p) = self_or_default(@_);
+    return $self->end_html(@p);
+}
+END_OF_FUNC
+
+'SplitParam' => <<'END_OF_FUNC',
+sub SplitParam {
+    my ($param) = @_;
+    my (@params) = split ("\0", $param);
+    return (wantarray ? @params : $params[0]);
+}
+END_OF_FUNC
+
+'MethGet' => <<'END_OF_FUNC',
+sub MethGet {
+    return request_method() eq 'GET';
+}
+END_OF_FUNC
+
+'MethPost' => <<'END_OF_FUNC',
+sub MethPost {
+    return request_method() eq 'POST';
+}
+END_OF_FUNC
+
+'TIEHASH' => <<'END_OF_FUNC',
+sub TIEHASH { 
+    return new CGI;
+}
+END_OF_FUNC
+
+'STORE' => <<'END_OF_FUNC',
+sub STORE {
+    $_[0]->param($_[1],split("\0",$_[2]));
+}
+END_OF_FUNC
+
+'FETCH' => <<'END_OF_FUNC',
+sub FETCH {
+    return $_[0] if $_[1] eq 'CGI';
+    return undef unless defined $_[0]->param($_[1]);
+    return join("\0",$_[0]->param($_[1]));
+}
+END_OF_FUNC
+
+'FIRSTKEY' => <<'END_OF_FUNC',
+sub FIRSTKEY {
+    $_[0]->{'.iterator'}=0;
+    $_[0]->{'.parameters'}->[$_[0]->{'.iterator'}++];
+}
+END_OF_FUNC
+
+'NEXTKEY' => <<'END_OF_FUNC',
+sub NEXTKEY {
+    $_[0]->{'.parameters'}->[$_[0]->{'.iterator'}++];
+}
+END_OF_FUNC
+
+'EXISTS' => <<'END_OF_FUNC',
+sub EXISTS {
+    exists $_[0]->{$_[1]};
+}
+END_OF_FUNC
+
+'DELETE' => <<'END_OF_FUNC',
+sub DELETE {
+    $_[0]->delete($_[1]);
+}
+END_OF_FUNC
+
+'CLEAR' => <<'END_OF_FUNC',
+sub CLEAR {
+    %{$_[0]}=();
+}
+####
+END_OF_FUNC
+
+####
+# Append a new value to an existing query
+####
+'append' => <<'EOF',
+sub append {
+    my($self,@p) = @_;
+    my($name,$value) = $self->rearrange([NAME,[VALUE,VALUES]],@p);
+    my(@values) = defined($value) ? (ref($value) ? @{$value} : $value) : ();
+    if (@values) {
+	$self->add_parameter($name);
+	push(@{$self->{$name}},@values);
+    }
+    return $self->param($name);
+}
+EOF
+
+#### Method: delete_all
+# Delete all parameters
+####
+'delete_all' => <<'EOF',
+sub delete_all {
+    my($self) = self_or_default(@_);
+    undef %{$self};
+}
+EOF
+
+#### Method: autoescape
+# If you want to turn off the autoescaping features,
+# call this method with undef as the argument
+'autoEscape' => <<'END_OF_FUNC',
+sub autoEscape {
+    my($self,$escape) = self_or_default(@_);
+    $self->{'dontescape'}=!$escape;
+}
+END_OF_FUNC
+
+
+#### Method: version
+# Return the current version
+####
+'version' => <<'END_OF_FUNC',
+sub version {
+    return $VERSION;
+}
+END_OF_FUNC
+
+'make_attributes' => <<'END_OF_FUNC',
+sub make_attributes {
+    my($self,$attr) = @_;
+    return () unless $attr && ref($attr) && ref($attr) eq 'HASH';
+    my(@att);
+    foreach (keys %{$attr}) {
+	my($key) = $_;
+	$key=~s/^\-//;     # get rid of initial - if present
+	$key=~tr/a-z/A-Z/; # parameters are upper case
+	push(@att,$attr->{$_} ne '' ? qq/$key="$attr->{$_}"/ : qq/$key/);
+    }
+    return @att;
+}
+END_OF_FUNC
+
+#### Method: dump
+# Returns a string in which all the known parameter/value 
+# pairs are represented as nested lists, mainly for the purposes 
+# of debugging.
+####
+'dump' => <<'END_OF_FUNC',
+sub dump {
+    my($self) = self_or_default(@_);
+    my($param,$value,@result);
+    return '<UL></UL>' unless $self->param;
+    push(@result,"<UL>");
+    foreach $param ($self->param) {
+	my($name)=$self->escapeHTML($param);
+	push(@result,"<LI><STRONG>$param</STRONG>");
+	push(@result,"<UL>");
+	foreach $value ($self->param($param)) {
+	    $value = $self->escapeHTML($value);
+	    push(@result,"<LI>$value");
+	}
+	push(@result,"</UL>");
+    }
+    push(@result,"</UL>\n");
+    return join("\n",@result);
+}
+END_OF_FUNC
+
+
+#### Method: save
+# Write values out to a filehandle in such a way that they can
+# be reinitialized by the filehandle form of the new() method
+####
+'save' => <<'END_OF_FUNC',
+sub save {
+    my($self,$filehandle) = self_or_default(@_);
+    my($param);
+    my($package) = caller;
+# Check that this still works!
+#    $filehandle = $filehandle=~/[':]/ ? $filehandle : "$package\:\:$filehandle";
+    $filehandle = to_filehandle($filehandle);
+    foreach $param ($self->param) {
+	my($escaped_param) = &escape($param);
+	my($value);
+	foreach $value ($self->param($param)) {
+	    print $filehandle "$escaped_param=",escape($value),"\n";
+	}
+    }
+    print $filehandle "=\n";    # end of record
+}
+END_OF_FUNC
+
+
+#### Method: header
+# Return a Content-Type: style header
+#
+####
+'header' => <<'END_OF_FUNC',
+sub header {
+    my($self,@p) = self_or_default(@_);
+    my(@header);
+
+    my($type,$status,$cookie,$target,$expires,$nph,@other) = 
+	$self->rearrange([TYPE,STATUS,[COOKIE,COOKIES],TARGET,EXPIRES,NPH],@p);
+
+    # rearrange() was designed for the HTML portion, so we
+    # need to fix it up a little.
+    foreach (@other) {
+	next unless my($header,$value) = /([^\s=]+)=(.+)/;
+	substr($header,1,1000)=~tr/A-Z/a-z/;
+	($value)=$value=~/^"(.*)"$/;
+	$_ = "$header: $value";
+    }
+
+    $type = $type || 'text/html';
+
+    push(@header,'HTTP/1.0 ' . ($status || '200 OK')) if $nph || $NPH;
+    push(@header,"Status: $status") if $status;
+    push(@header,"Window-target: $target") if $target;
+    # push all the cookies -- there may be several
+    if ($cookie) {
+	my(@cookie) = ref($cookie) ? @{$cookie} : $cookie;
+	foreach (@cookie) {
+	    push(@header,"Set-cookie: $_");
+	}
+    }
+    # if the user indicates an expiration time, then we need
+    # both an Expires and a Date header (so that the browser is
+    # uses OUR clock)
+    push(@header,"Expires: " . &date(&expire_calc($expires),'http'))
+	if $expires;
+    push(@header,"Date: " . &date(&expire_calc(0),'http')) if $expires || $cookie;
+    push(@header,"Pragma: no-cache") if $self->cache();
+    push(@header,@other);
+    push(@header,"Content-type: $type");
+
+    my $header = join($CRLF,@header);
+    return $header . "${CRLF}${CRLF}";
+}
+END_OF_FUNC
+
+
+#### Method: cache
+# Control whether header() will produce the no-cache
+# Pragma directive.
+####
+'cache' => <<'END_OF_FUNC',
+sub cache {
+    my($self,$new_value) = self_or_default(@_);
+    $new_value = '' unless $new_value;
+    if ($new_value ne '') {
+	$self->{'cache'} = $new_value;
+    }
+    return $self->{'cache'};
+}
+END_OF_FUNC
+
+
+#### Method: redirect
+# Return a Location: style header
+#
+####
+'redirect' => <<'END_OF_FUNC',
+sub redirect {
+    my($self,@p) = self_or_default(@_);
+    my($url,$target,$cookie,$nph,@other) = $self->rearrange([[URI,URL],TARGET,COOKIE,NPH],@p);
+    $url = $url || $self->self_url;
+    my(@o);
+    foreach (@other) { push(@o,split("=")); }
+    if($MOD_PERL or exists $self->{'.req'}) {
+	my $r = $self->{'.req'} || Apache->request;
+	$r->header_out(Location => $url);
+	$r->err_header_out(Location => $url);
+	$r->status(302);
+	return;
+    }
+    push(@o,
+	 '-Status'=>'302 Found',
+	 '-Location'=>$url,
+	 '-URI'=>$url,
+	 '-nph'=>($nph||$NPH));
+    push(@o,'-Target'=>$target) if $target;
+    push(@o,'-Cookie'=>$cookie) if $cookie;
+    return $self->header(@o);
+}
+END_OF_FUNC
+
+
+#### Method: start_html
+# Canned HTML header
+#
+# Parameters:
+# $title -> (optional) The title for this HTML document (-title)
+# $author -> (optional) e-mail address of the author (-author)
+# $base -> (optional) if set to true, will enter the BASE address of this document
+#          for resolving relative references (-base) 
+# $xbase -> (optional) alternative base at some remote location (-xbase)
+# $target -> (optional) target window to load all links into (-target)
+# $script -> (option) Javascript code (-script)
+# $no_script -> (option) Javascript <noscript> tag (-noscript)
+# $meta -> (optional) Meta information tags
+# $head -> (optional) any other elements you'd like to incorporate into the <HEAD> tag
+#           (a scalar or array ref)
+# $style -> (optional) reference to an external style sheet
+# @other -> (optional) any other named parameters you'd like to incorporate into
+#           the <BODY> tag.
+####
+'start_html' => <<'END_OF_FUNC',
+sub start_html {
+    my($self,@p) = &self_or_default(@_);
+    my($title,$author,$base,$xbase,$script,$noscript,$target,$meta,$head,$style,@other) = 
+	$self->rearrange([TITLE,AUTHOR,BASE,XBASE,SCRIPT,NOSCRIPT,TARGET,META,HEAD,STYLE],@p);
+
+    # strangely enough, the title needs to be escaped as HTML
+    # while the author needs to be escaped as a URL
+    $title = $self->escapeHTML($title || 'Untitled Document');
+    $author = $self->escapeHTML($author);
+    my(@result);
+    push(@result,'<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">');
+    push(@result,"<HTML><HEAD><TITLE>$title</TITLE>");
+    push(@result,"<LINK REV=MADE HREF=\"mailto:$author\">") if $author;
+
+    if ($base || $xbase || $target) {
+	my $href = $xbase || $self->url();
+	my $t = $target ? qq/ TARGET="$target"/ : '';
+	push(@result,qq/<BASE HREF="$href"$t>/);
+    }
+
+    if ($meta && ref($meta) && (ref($meta) eq 'HASH')) {
+	foreach (keys %$meta) { push(@result,qq(<META NAME="$_" CONTENT="$meta->{$_}">)); }
+    }
+
+    push(@result,ref($head) ? @$head : $head) if $head;
+
+    # handle various types of -style parameters
+    if ($style) {
+	if (ref($style)) {
+	    my($src,$code,@other) =
+		$self->rearrange([SRC,CODE],
+				 '-foo'=>'bar',	# a trick to allow the '-' to be omitted
+				 ref($style) eq 'ARRAY' ? @$style : %$style);
+	    push(@result,qq/<LINK REL="stylesheet" HREF="$src">/) if $src;
+	    push(@result,style($code)) if $code;
+	} else {
+	    push(@result,style($style))
+	}
+    }
+
+    # handle -script parameter
+    if ($script) {
+	my($src,$code,$language);
+	if (ref($script)) { # script is a hash
+	    ($src,$code,$language) =
+		$self->rearrange([SRC,CODE,LANGUAGE],
+				 '-foo'=>'bar',	# a trick to allow the '-' to be omitted
+				 ref($style) eq 'ARRAY' ? @$script : %$script);
+	
+	} else {
+	    ($src,$code,$language) = ('',$script,'JavaScript');
+	}
+	my(@satts);
+	push(@satts,'src'=>$src) if $src;
+	push(@satts,'language'=>$language || 'JavaScript');
+	$code = "<!-- Hide script\n$code\n// End script hiding -->"
+	    if $code && $language=~/javascript/i;
+	$code = "<!-- Hide script\n$code\n\# End script hiding -->"
+	    if $code && $language=~/perl/i;
+	push(@result,script({@satts},$code));
+    }
+
+    # handle -noscript parameter
+    push(@result,<<END) if $noscript;
+<NOSCRIPT>
+$noscript
+</NOSCRIPT>
+END
+    ;
+    my($other) = @other ? " @other" : '';
+    push(@result,"</HEAD><BODY$other>");
+    return join("\n",@result);
+}
+END_OF_FUNC
+
+
+#### Method: end_html
+# End an HTML document.
+# Trivial method for completeness.  Just returns "</BODY>"
+####
+'end_html' => <<'END_OF_FUNC',
+sub end_html {
+    return "</BODY></HTML>";
+}
+END_OF_FUNC
+
+
+################################
+# METHODS USED IN BUILDING FORMS
+################################
+
+#### Method: isindex
+# Just prints out the isindex tag.
+# Parameters:
+#  $action -> optional URL of script to run
+# Returns:
+#   A string containing a <ISINDEX> tag
+'isindex' => <<'END_OF_FUNC',
+sub isindex {
+    my($self,@p) = self_or_default(@_);
+    my($action,@other) = $self->rearrange([ACTION],@p);
+    $action = qq/ACTION="$action"/ if $action;
+    my($other) = @other ? " @other" : '';
+    return "<ISINDEX $action$other>";
+}
+END_OF_FUNC
+
+
+#### Method: startform
+# Start a form
+# Parameters:
+#   $method -> optional submission method to use (GET or POST)
+#   $action -> optional URL of script to run
+#   $enctype ->encoding to use (URL_ENCODED or MULTIPART)
+'startform' => <<'END_OF_FUNC',
+sub startform {
+    my($self,@p) = self_or_default(@_);
+
+    my($method,$action,$enctype,@other) = 
+	$self->rearrange([METHOD,ACTION,ENCTYPE],@p);
+
+    $method = $method || 'POST';
+    $enctype = $enctype || &URL_ENCODED;
+    $action = $action ? qq/ACTION="$action"/ : $method eq 'GET' ?
+	'ACTION="'.$self->script_name.'"' : '';
+    my($other) = @other ? " @other" : '';
+    $self->{'.parametersToAdd'}={};
+    return qq/<FORM METHOD="$method" $action ENCTYPE="$enctype"$other>\n/;
+}
+END_OF_FUNC
+
+
+#### Method: start_form
+# synonym for startform
+'start_form' => <<'END_OF_FUNC',
+sub start_form {
+    &startform;
+}
+END_OF_FUNC
+
+
+#### Method: start_multipart_form
+# synonym for startform
+'start_multipart_form' => <<'END_OF_FUNC',
+sub start_multipart_form {
+    my($self,@p) = self_or_default(@_);
+    if ($self->use_named_parameters || 
+	(defined($param[0]) && substr($param[0],0,1) eq '-')) {
+	my(%p) = @p;
+	$p{'-enctype'}=&MULTIPART;
+	return $self->startform(%p);
+    } else {
+	my($method,$action,@other) = 
+	    $self->rearrange([METHOD,ACTION],@p);
+	return $self->startform($method,$action,&MULTIPART,@other);
+    }
+}
+END_OF_FUNC
+
+
+#### Method: endform
+# End a form
+'endform' => <<'END_OF_FUNC',
+sub endform {
+    my($self,@p) = self_or_default(@_);    
+    return ($self->get_fields,"</FORM>");
+}
+END_OF_FUNC
+
+
+#### Method: end_form
+# synonym for endform
+'end_form' => <<'END_OF_FUNC',
+sub end_form {
+    &endform;
+}
+END_OF_FUNC
+
+
+#### Method: textfield
+# Parameters:
+#   $name -> Name of the text field
+#   $default -> Optional default value of the field if not
+#                already defined.
+#   $size ->  Optional width of field in characaters.
+#   $maxlength -> Optional maximum number of characters.
+# Returns:
+#   A string containing a <INPUT TYPE="text"> field
+#
+'textfield' => <<'END_OF_FUNC',
+sub textfield {
+    my($self,@p) = self_or_default(@_);
+    my($name,$default,$size,$maxlength,$override,@other) = 
+	$self->rearrange([NAME,[DEFAULT,VALUE],SIZE,MAXLENGTH,[OVERRIDE,FORCE]],@p);
+
+    my $current = $override ? $default : 
+	(defined($self->param($name)) ? $self->param($name) : $default);
+
+    $current = defined($current) ? $self->escapeHTML($current) : '';
+    $name = defined($name) ? $self->escapeHTML($name) : '';
+    my($s) = defined($size) ? qq/ SIZE=$size/ : '';
+    my($m) = defined($maxlength) ? qq/ MAXLENGTH=$maxlength/ : '';
+    my($other) = @other ? " @other" : '';    
+    return qq/<INPUT TYPE="text" NAME="$name" VALUE="$current"$s$m$other>/;
+}
+END_OF_FUNC
+
+
+#### Method: filefield
+# Parameters:
+#   $name -> Name of the file upload field
+#   $size ->  Optional width of field in characaters.
+#   $maxlength -> Optional maximum number of characters.
+# Returns:
+#   A string containing a <INPUT TYPE="text"> field
+#
+'filefield' => <<'END_OF_FUNC',
+sub filefield {
+    my($self,@p) = self_or_default(@_);
+
+    my($name,$default,$size,$maxlength,$override,@other) = 
+	$self->rearrange([NAME,[DEFAULT,VALUE],SIZE,MAXLENGTH,[OVERRIDE,FORCE]],@p);
+
+    $current = $override ? $default :
+	(defined($self->param($name)) ? $self->param($name) : $default);
+
+    $name = defined($name) ? $self->escapeHTML($name) : '';
+    my($s) = defined($size) ? qq/ SIZE=$size/ : '';
+    my($m) = defined($maxlength) ? qq/ MAXLENGTH=$maxlength/ : '';
+    $current = defined($current) ? $self->escapeHTML($current) : '';
+    $other = ' ' . join(" ",@other);
+    return qq/<INPUT TYPE="file" NAME="$name" VALUE="$current"$s$m$other>/;
+}
+END_OF_FUNC
+
+
+#### Method: password
+# Create a "secret password" entry field
+# Parameters:
+#   $name -> Name of the field
+#   $default -> Optional default value of the field if not
+#                already defined.
+#   $size ->  Optional width of field in characters.
+#   $maxlength -> Optional maximum characters that can be entered.
+# Returns:
+#   A string containing a <INPUT TYPE="password"> field
+#
+'password_field' => <<'END_OF_FUNC',
+sub password_field {
+    my ($self,@p) = self_or_default(@_);
+
+    my($name,$default,$size,$maxlength,$override,@other) = 
+	$self->rearrange([NAME,[DEFAULT,VALUE],SIZE,MAXLENGTH,[OVERRIDE,FORCE]],@p);
+
+    my($current) =  $override ? $default :
+	(defined($self->param($name)) ? $self->param($name) : $default);
+
+    $name = defined($name) ? $self->escapeHTML($name) : '';
+    $current = defined($current) ? $self->escapeHTML($current) : '';
+    my($s) = defined($size) ? qq/ SIZE=$size/ : '';
+    my($m) = defined($maxlength) ? qq/ MAXLENGTH=$maxlength/ : '';
+    my($other) = @other ? " @other" : '';
+    return qq/<INPUT TYPE="password" NAME="$name" VALUE="$current"$s$m$other>/;
+}
+END_OF_FUNC
+
+
+#### Method: textarea
+# Parameters:
+#   $name -> Name of the text field
+#   $default -> Optional default value of the field if not
+#                already defined.
+#   $rows ->  Optional number of rows in text area
+#   $columns -> Optional number of columns in text area
+# Returns:
+#   A string containing a <TEXTAREA></TEXTAREA> tag
+#
+'textarea' => <<'END_OF_FUNC',
+sub textarea {
+    my($self,@p) = self_or_default(@_);
+    
+    my($name,$default,$rows,$cols,$override,@other) =
+	$self->rearrange([NAME,[DEFAULT,VALUE],ROWS,[COLS,COLUMNS],[OVERRIDE,FORCE]],@p);
+
+    my($current)= $override ? $default :
+	(defined($self->param($name)) ? $self->param($name) : $default);
+
+    $name = defined($name) ? $self->escapeHTML($name) : '';
+    $current = defined($current) ? $self->escapeHTML($current) : '';
+    my($r) = $rows ? " ROWS=$rows" : '';
+    my($c) = $cols ? " COLS=$cols" : '';
+    my($other) = @other ? " @other" : '';
+    return qq{<TEXTAREA NAME="$name"$r$c$other>$current</TEXTAREA>};
+}
+END_OF_FUNC
+
+
+#### Method: button
+# Create a javascript button.
+# Parameters:
+#   $name ->  (optional) Name for the button. (-name)
+#   $value -> (optional) Value of the button when selected (and visible name) (-value)
+#   $onclick -> (optional) Text of the JavaScript to run when the button is
+#                clicked.
+# Returns:
+#   A string containing a <INPUT TYPE="button"> tag
+####
+'button' => <<'END_OF_FUNC',
+sub button {
+    my($self,@p) = self_or_default(@_);
+
+    my($label,$value,$script,@other) = $self->rearrange([NAME,[VALUE,LABEL],
+							 [ONCLICK,SCRIPT]],@p);
+
+    $label=$self->escapeHTML($label);
+    $value=$self->escapeHTML($value);
+    $script=$self->escapeHTML($script);
+
+    my($name) = '';
+    $name = qq/ NAME="$label"/ if $label;
+    $value = $value || $label;
+    my($val) = '';
+    $val = qq/ VALUE="$value"/ if $value;
+    $script = qq/ ONCLICK="$script"/ if $script;
+    my($other) = @other ? " @other" : '';
+    return qq/<INPUT TYPE="button"$name$val$script$other>/;
+}
+END_OF_FUNC
+
+
+#### Method: submit
+# Create a "submit query" button.
+# Parameters:
+#   $name ->  (optional) Name for the button.
+#   $value -> (optional) Value of the button when selected (also doubles as label).
+#   $label -> (optional) Label printed on the button(also doubles as the value).
+# Returns:
+#   A string containing a <INPUT TYPE="submit"> tag
+####
+'submit' => <<'END_OF_FUNC',
+sub submit {
+    my($self,@p) = self_or_default(@_);
+
+    my($label,$value,@other) = $self->rearrange([NAME,[VALUE,LABEL]],@p);
+
+    $label=$self->escapeHTML($label);
+    $value=$self->escapeHTML($value);
+
+    my($name) = ' NAME=".submit"';
+    $name = qq/ NAME="$label"/ if $label;
+    $value = $value || $label;
+    my($val) = '';
+    $val = qq/ VALUE="$value"/ if defined($value);
+    my($other) = @other ? " @other" : '';
+    return qq/<INPUT TYPE="submit"$name$val$other>/;
+}
+END_OF_FUNC
+
+
+#### Method: reset
+# Create a "reset" button.
+# Parameters:
+#   $name -> (optional) Name for the button.
+# Returns:
+#   A string containing a <INPUT TYPE="reset"> tag
+####
+'reset' => <<'END_OF_FUNC',
+sub reset {
+    my($self,@p) = self_or_default(@_);
+    my($label,@other) = $self->rearrange([NAME],@p);
+    $label=$self->escapeHTML($label);
+    my($value) = defined($label) ? qq/ VALUE="$label"/ : '';
+    my($other) = @other ? " @other" : '';
+    return qq/<INPUT TYPE="reset"$value$other>/;
+}
+END_OF_FUNC
+
+
+#### Method: defaults
+# Create a "defaults" button.
+# Parameters:
+#   $name -> (optional) Name for the button.
+# Returns:
+#   A string containing a <INPUT TYPE="submit" NAME=".defaults"> tag
+#
+# Note: this button has a special meaning to the initialization script,
+# and tells it to ERASE the current query string so that your defaults
+# are used again!
+####
+'defaults' => <<'END_OF_FUNC',
+sub defaults {
+    my($self,@p) = self_or_default(@_);
+
+    my($label,@other) = $self->rearrange([[NAME,VALUE]],@p);
+
+    $label=$self->escapeHTML($label);
+    $label = $label || "Defaults";
+    my($value) = qq/ VALUE="$label"/;
+    my($other) = @other ? " @other" : '';
+    return qq/<INPUT TYPE="submit" NAME=".defaults"$value$other>/;
+}
+END_OF_FUNC
+
+
+#### Method: checkbox
+# Create a checkbox that is not logically linked to any others.
+# The field value is "on" when the button is checked.
+# Parameters:
+#   $name -> Name of the checkbox
+#   $checked -> (optional) turned on by default if true
+#   $value -> (optional) value of the checkbox, 'on' by default
+#   $label -> (optional) a user-readable label printed next to the box.
+#             Otherwise the checkbox name is used.
+# Returns:
+#   A string containing a <INPUT TYPE="checkbox"> field
+####
+'checkbox' => <<'END_OF_FUNC',
+sub checkbox {
+    my($self,@p) = self_or_default(@_);
+
+    my($name,$checked,$value,$label,$override,@other) = 
+	$self->rearrange([NAME,[CHECKED,SELECTED,ON],VALUE,LABEL,[OVERRIDE,FORCE]],@p);
+    
+    if (!$override && defined($self->param($name))) {
+	$value = $self->param($name) unless defined $value;
+	$checked = $self->param($name) eq $value ? ' CHECKED' : '';
+    } else {
+	$checked = $checked ? ' CHECKED' : '';
+	$value = defined $value ? $value : 'on';
+    }
+    my($the_label) = defined $label ? $label : $name;
+    $name = $self->escapeHTML($name);
+    $value = $self->escapeHTML($value);
+    $the_label = $self->escapeHTML($the_label);
+    my($other) = @other ? " @other" : '';
+    $self->register_parameter($name);
+    return <<END;
+<INPUT TYPE="checkbox" NAME="$name" VALUE="$value"$checked$other>$the_label
+END
+}
+END_OF_FUNC
+
+
+#### Method: checkbox_group
+# Create a list of logically-linked checkboxes.
+# Parameters:
+#   $name -> Common name for all the check boxes
+#   $values -> A pointer to a regular array containing the
+#             values for each checkbox in the group.
+#   $defaults -> (optional)
+#             1. If a pointer to a regular array of checkbox values,
+#             then this will be used to decide which
+#             checkboxes to turn on by default.
+#             2. If a scalar, will be assumed to hold the
+#             value of a single checkbox in the group to turn on. 
+#   $linebreak -> (optional) Set to true to place linebreaks
+#             between the buttons.
+#   $labels -> (optional)
+#             A pointer to an associative array of labels to print next to each checkbox
+#             in the form $label{'value'}="Long explanatory label".
+#             Otherwise the provided values are used as the labels.
+# Returns:
+#   An ARRAY containing a series of <INPUT TYPE="checkbox"> fields
+####
+'checkbox_group' => <<'END_OF_FUNC',
+sub checkbox_group {
+    my($self,@p) = self_or_default(@_);
+
+    my($name,$values,$defaults,$linebreak,$labels,$rows,$columns,
+       $rowheaders,$colheaders,$override,$nolabels,@other) =
+	$self->rearrange([NAME,[VALUES,VALUE],[DEFAULTS,DEFAULT],
+			  LINEBREAK,LABELS,ROWS,[COLUMNS,COLS],
+			  ROWHEADERS,COLHEADERS,
+			  [OVERRIDE,FORCE],NOLABELS],@p);
+
+    my($checked,$break,$result,$label);
+
+    my(%checked) = $self->previous_or_default($name,$defaults,$override);
+
+    $break = $linebreak ? "<BR>" : '';
+    $name=$self->escapeHTML($name);
+
+    # Create the elements
+    my(@elements);
+    my(@values) = $values ? @$values : $self->param($name);
+    my($other) = @other ? " @other" : '';
+    foreach (@values) {
+	$checked = $checked{$_} ? ' CHECKED' : '';
+	$label = '';
+	unless (defined($nolabels) && $nolabels) {
+	    $label = $_;
+	    $label = $labels->{$_} if defined($labels) && $labels->{$_};
+	    $label = $self->escapeHTML($label);
+	}
+	$_ = $self->escapeHTML($_);
+	push(@elements,qq/<INPUT TYPE="checkbox" NAME="$name" VALUE="$_"$checked$other>${label} ${break}/);
+    }
+    $self->register_parameter($name);
+    return wantarray ? @elements : join('',@elements) unless $columns;
+    return _tableize($rows,$columns,$rowheaders,$colheaders,@elements);
+}
+END_OF_FUNC
+
+
+# Escape HTML -- used internally
+'escapeHTML' => <<'END_OF_FUNC',
+sub escapeHTML {
+    my($self,$toencode) = @_;
+    return undef unless defined($toencode);
+    return $toencode if $self->{'dontescape'};
+    $toencode=~s/&/&amp;/g;
+    $toencode=~s/\"/&quot;/g;
+    $toencode=~s/>/&gt;/g;
+    $toencode=~s/</&lt;/g;
+    return $toencode;
+}
+END_OF_FUNC
+
+
+# Internal procedure - don't use
+'_tableize' => <<'END_OF_FUNC',
+sub _tableize {
+    my($rows,$columns,$rowheaders,$colheaders,@elements) = @_;
+    my($result);
+
+    $rows = int(0.99 + @elements/$columns) unless $rows;
+    # rearrange into a pretty table
+    $result = "<TABLE>";
+    my($row,$column);
+    unshift(@$colheaders,'') if @$colheaders && @$rowheaders;
+    $result .= "<TR>" if @{$colheaders};
+    foreach (@{$colheaders}) {
+	$result .= "<TH>$_</TH>";
+    }
+    for ($row=0;$row<$rows;$row++) {
+	$result .= "<TR>";
+	$result .= "<TH>$rowheaders->[$row]</TH>" if @$rowheaders;
+	for ($column=0;$column<$columns;$column++) {
+	    $result .= "<TD>" . $elements[$column*$rows + $row] . "</TD>";
+	}
+	$result .= "</TR>";
+    }
+    $result .= "</TABLE>";
+    return $result;
+}
+END_OF_FUNC
+
+
+#### Method: radio_group
+# Create a list of logically-linked radio buttons.
+# Parameters:
+#   $name -> Common name for all the buttons.
+#   $values -> A pointer to a regular array containing the
+#             values for each button in the group.
+#   $default -> (optional) Value of the button to turn on by default.  Pass '-'
+#               to turn _nothing_ on.
+#   $linebreak -> (optional) Set to true to place linebreaks
+#             between the buttons.
+#   $labels -> (optional)
+#             A pointer to an associative array of labels to print next to each checkbox
+#             in the form $label{'value'}="Long explanatory label".
+#             Otherwise the provided values are used as the labels.
+# Returns:
+#   An ARRAY containing a series of <INPUT TYPE="radio"> fields
+####
+'radio_group' => <<'END_OF_FUNC',
+sub radio_group {
+    my($self,@p) = self_or_default(@_);
+
+    my($name,$values,$default,$linebreak,$labels,
+       $rows,$columns,$rowheaders,$colheaders,$override,$nolabels,@other) =
+	$self->rearrange([NAME,[VALUES,VALUE],DEFAULT,LINEBREAK,LABELS,
+			  ROWS,[COLUMNS,COLS],
+			  ROWHEADERS,COLHEADERS,
+			  [OVERRIDE,FORCE],NOLABELS],@p);
+    my($result,$checked);
+
+    if (!$override && defined($self->param($name))) {
+	$checked = $self->param($name);
+    } else {
+	$checked = $default;
+    }
+    # If no check array is specified, check the first by default
+    $checked = $values->[0] unless $checked;
+    $name=$self->escapeHTML($name);
+
+    my(@elements);
+    my(@values) = $values ? @$values : $self->param($name);
+    my($other) = @other ? " @other" : '';
+    foreach (@values) {
+	my($checkit) = $checked eq $_ ? ' CHECKED' : '';
+	my($break) = $linebreak ? '<BR>' : '';
+	my($label)='';
+	unless (defined($nolabels) && $nolabels) {
+	    $label = $_;
+	    $label = $labels->{$_} if defined($labels) && $labels->{$_};
+	    $label = $self->escapeHTML($label);
+	}
+	$_=$self->escapeHTML($_);
+	push(@elements,qq/<INPUT TYPE="radio" NAME="$name" VALUE="$_"$checkit$other>${label} ${break}/);
+    }
+    $self->register_parameter($name);
+    return wantarray ? @elements : join('',@elements) unless $columns;
+    return _tableize($rows,$columns,$rowheaders,$colheaders,@elements);
+}
+END_OF_FUNC
+
+
+#### Method: popup_menu
+# Create a popup menu.
+# Parameters:
+#   $name -> Name for all the menu
+#   $values -> A pointer to a regular array containing the
+#             text of each menu item.
+#   $default -> (optional) Default item to display
+#   $labels -> (optional)
+#             A pointer to an associative array of labels to print next to each checkbox
+#             in the form $label{'value'}="Long explanatory label".
+#             Otherwise the provided values are used as the labels.
+# Returns:
+#   A string containing the definition of a popup menu.
+####
+'popup_menu' => <<'END_OF_FUNC',
+sub popup_menu {
+    my($self,@p) = self_or_default(@_);
+
+    my($name,$values,$default,$labels,$override,@other) =
+	$self->rearrange([NAME,[VALUES,VALUE],[DEFAULT,DEFAULTS],LABELS,[OVERRIDE,FORCE]],@p);
+    my($result,$selected);
+
+    if (!$override && defined($self->param($name))) {
+	$selected = $self->param($name);
+    } else {
+	$selected = $default;
+    }
+    $name=$self->escapeHTML($name);
+    my($other) = @other ? " @other" : '';
+
+    my(@values) = $values ? @$values : $self->param($name);
+    $result = qq/<SELECT NAME="$name"$other>\n/;
+    foreach (@values) {
+	my($selectit) = defined($selected) ? ($selected eq $_ ? 'SELECTED' : '' ) : '';
+	my($label) = $_;
+	$label = $labels->{$_} if defined($labels) && $labels->{$_};
+	my($value) = $self->escapeHTML($_);
+	$label=$self->escapeHTML($label);
+	$result .= "<OPTION $selectit VALUE=\"$value\">$label\n";
+    }
+
+    $result .= "</SELECT>\n";
+    return $result;
+}
+END_OF_FUNC
+
+
+#### Method: scrolling_list
+# Create a scrolling list.
+# Parameters:
+#   $name -> name for the list
+#   $values -> A pointer to a regular array containing the
+#             values for each option line in the list.
+#   $defaults -> (optional)
+#             1. If a pointer to a regular array of options,
+#             then this will be used to decide which
+#             lines to turn on by default.
+#             2. Otherwise holds the value of the single line to turn on.
+#   $size -> (optional) Size of the list.
+#   $multiple -> (optional) If set, allow multiple selections.
+#   $labels -> (optional)
+#             A pointer to an associative array of labels to print next to each checkbox
+#             in the form $label{'value'}="Long explanatory label".
+#             Otherwise the provided values are used as the labels.
+# Returns:
+#   A string containing the definition of a scrolling list.
+####
+'scrolling_list' => <<'END_OF_FUNC',
+sub scrolling_list {
+    my($self,@p) = self_or_default(@_);
+    my($name,$values,$defaults,$size,$multiple,$labels,$override,@other)
+	= $self->rearrange([NAME,[VALUES,VALUE],[DEFAULTS,DEFAULT],
+			    SIZE,MULTIPLE,LABELS,[OVERRIDE,FORCE]],@p);
+
+    my($result);
+    my(@values) = $values ? @$values : $self->param($name);
+    $size = $size || scalar(@values);
+
+    my(%selected) = $self->previous_or_default($name,$defaults,$override);
+    my($is_multiple) = $multiple ? ' MULTIPLE' : '';
+    my($has_size) = $size ? " SIZE=$size" : '';
+    my($other) = @other ? " @other" : '';
+
+    $name=$self->escapeHTML($name);
+    $result = qq/<SELECT NAME="$name"$has_size$is_multiple$other>\n/;
+    foreach (@values) {
+	my($selectit) = $selected{$_} ? 'SELECTED' : '';
+	my($label) = $_;
+	$label = $labels->{$_} if defined($labels) && $labels->{$_};
+	$label=$self->escapeHTML($label);
+	my($value)=$self->escapeHTML($_);
+	$result .= "<OPTION $selectit VALUE=\"$value\">$label\n";
+    }
+    $result .= "</SELECT>\n";
+    $self->register_parameter($name);
+    return $result;
+}
+END_OF_FUNC
+
+
+#### Method: hidden
+# Parameters:
+#   $name -> Name of the hidden field
+#   @default -> (optional) Initial values of field (may be an array)
+#      or
+#   $default->[initial values of field]
+# Returns:
+#   A string containing a <INPUT TYPE="hidden" NAME="name" VALUE="value">
+####
+'hidden' => <<'END_OF_FUNC',
+sub hidden {
+    my($self,@p) = self_or_default(@_);
+
+    # this is the one place where we departed from our standard
+    # calling scheme, so we have to special-case (darn)
+    my(@result,@value);
+    my($name,$default,$override,@other) = 
+	$self->rearrange([NAME,[DEFAULT,VALUE,VALUES],[OVERRIDE,FORCE]],@p);
+
+    my $do_override = 0;
+    if ( substr($p[0],0,1) eq '-' || $self->use_named_parameters ) {
+	@value = ref($default) ? @{$default} : $default;
+	$do_override = $override;
+    } else {
+	foreach ($default,$override,@other) {
+	    push(@value,$_) if defined($_);
+	}
+    }
+
+    # use previous values if override is not set
+    my @prev = $self->param($name);
+    @value = @prev if !$do_override && @prev;
+
+    $name=$self->escapeHTML($name);
+    foreach (@value) {
+	$_=$self->escapeHTML($_);
+	push(@result,qq/<INPUT TYPE="hidden" NAME="$name" VALUE="$_">/);
+    }
+    return wantarray ? @result : join('',@result);
+}
+END_OF_FUNC
+
+
+#### Method: image_button
+# Parameters:
+#   $name -> Name of the button
+#   $src ->  URL of the image source
+#   $align -> Alignment style (TOP, BOTTOM or MIDDLE)
+# Returns:
+#   A string containing a <INPUT TYPE="image" NAME="name" SRC="url" ALIGN="alignment">
+####
+'image_button' => <<'END_OF_FUNC',
+sub image_button {
+    my($self,@p) = self_or_default(@_);
+
+    my($name,$src,$alignment,@other) =
+	$self->rearrange([NAME,SRC,ALIGN],@p);
+
+    my($align) = $alignment ? " ALIGN=\U$alignment" : '';
+    my($other) = @other ? " @other" : '';
+    $name=$self->escapeHTML($name);
+    return qq/<INPUT TYPE="image" NAME="$name" SRC="$src"$align$other>/;
+}
+END_OF_FUNC
+
+
+#### Method: self_url
+# Returns a URL containing the current script and all its
+# param/value pairs arranged as a query.  You can use this
+# to create a link that, when selected, will reinvoke the
+# script with all its state information preserved.
+####
+'self_url' => <<'END_OF_FUNC',
+sub self_url {
+    my($self) = self_or_default(@_);
+    my($query_string) = $self->query_string;
+    my $protocol = $self->protocol();
+    my $name = "$protocol://" . $self->server_name;
+    $name .= ":" . $self->server_port
+	unless $self->server_port == 80;
+    $name .= $self->script_name;
+    $name .= $self->path_info if $self->path_info;
+    return $name unless $query_string;
+    return "$name?$query_string";
+}
+END_OF_FUNC
+
+
+# This is provided as a synonym to self_url() for people unfortunate
+# enough to have incorporated it into their programs already!
+'state' => <<'END_OF_FUNC',
+sub state {
+    &self_url;
+}
+END_OF_FUNC
+
+
+#### Method: url
+# Like self_url, but doesn't return the query string part of
+# the URL.
+####
+'url' => <<'END_OF_FUNC',
+sub url {
+    my($self) = self_or_default(@_);
+    my $protocol = $self->protocol();
+    my $name = "$protocol://" . $self->server_name;
+    $name .= ":" . $self->server_port
+	unless $self->server_port == 80;
+    $name .= $self->script_name;
+    return $name;
+}
+
+END_OF_FUNC
+
+#### Method: cookie
+# Set or read a cookie from the specified name.
+# Cookie can then be passed to header().
+# Usual rules apply to the stickiness of -value.
+#  Parameters:
+#   -name -> name for this cookie (optional)
+#   -value -> value of this cookie (scalar, array or hash) 
+#   -path -> paths for which this cookie is valid (optional)
+#   -domain -> internet domain in which this cookie is valid (optional)
+#   -secure -> if true, cookie only passed through secure channel (optional)
+#   -expires -> expiry date in format Wdy, DD-Mon-YYYY HH:MM:SS GMT (optional)
+####
+'cookie' => <<'END_OF_FUNC',
+# temporary, for debugging.
+sub cookie {
+    my($self,@p) = self_or_default(@_);
+    my($name,$value,$path,$domain,$secure,$expires) =
+	$self->rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES],@p);
+
+
+    # if no value is supplied, then we retrieve the
+    # value of the cookie, if any.  For efficiency, we cache the parsed
+    # cookie in our state variables.
+    unless (defined($value)) {
+	unless ($self->{'.cookies'}) {
+	    my(@pairs) = split("; ",$self->raw_cookie);
+	    foreach (@pairs) {
+		my($key,$value) = split("=");
+		my(@values) = map unescape($_),split('&',$value);
+		$self->{'.cookies'}->{unescape($key)} = [@values];
+	    }
+	}
+
+	# If no name is supplied, then retrieve the names of all our cookies.
+	return () unless $self->{'.cookies'};
+	return wantarray ? @{$self->{'.cookies'}->{$name}} : $self->{'.cookies'}->{$name}->[0]
+	    if defined($name) && $name ne '';
+	return keys %{$self->{'.cookies'}};
+    }
+    my(@values);
+
+    # Pull out our parameters.
+    if (ref($value)) {
+	if (ref($value) eq 'ARRAY') {
+	    @values = @$value;
+	} elsif (ref($value) eq 'HASH') {
+	    @values = %$value;
+	}
+    } else {
+	@values = ($value);
+    }
+    @values = map escape($_),@values;
+
+    # I.E. requires the path to be present.
+    ($path = $ENV{'SCRIPT_NAME'})=~s![^/]+$!! unless $path;
+
+    my(@constant_values);
+    push(@constant_values,"domain=$domain") if $domain;
+    push(@constant_values,"path=$path") if $path;
+    push(@constant_values,"expires=".&date(&expire_calc($expires),'cookie'))
+	if $expires;
+    push(@constant_values,'secure') if $secure;
+
+    my($key) = &escape($name);
+    my($cookie) = join("=",$key,join("&",@values));
+    return join("; ",$cookie,@constant_values);
+}
+END_OF_FUNC
+
+
+# This internal routine creates an expires time exactly some number of
+# hours from the current time.  It incorporates modifications from 
+# Fisher Mark.
+'expire_calc' => <<'END_OF_FUNC',
+sub expire_calc {
+    my($time) = @_;
+    my(%mult) = ('s'=>1,
+                 'm'=>60,
+                 'h'=>60*60,
+                 'd'=>60*60*24,
+                 'M'=>60*60*24*30,
+                 'y'=>60*60*24*365);
+    # format for time can be in any of the forms...
+    # "now" -- expire immediately
+    # "+180s" -- in 180 seconds
+    # "+2m" -- in 2 minutes
+    # "+12h" -- in 12 hours
+    # "+1d"  -- in 1 day
+    # "+3M"  -- in 3 months
+    # "+2y"  -- in 2 years
+    # "-3m"  -- 3 minutes ago(!)
+    # If you don't supply one of these forms, we assume you are
+    # specifying the date yourself
+    my($offset);
+    if (!$time || ($time eq 'now')) {
+        $offset = 0;
+    } elsif ($time=~/^([+-]?\d+)([mhdMy]?)/) {
+        $offset = ($mult{$2} || 1)*$1;
+    } else {
+        return $time;
+    }
+    return (time+$offset);
+}
+END_OF_FUNC
+
+# This internal routine creates date strings suitable for use in
+# cookies and HTTP headers.  (They differ, unfortunately.)
+# Thanks to Fisher Mark for this.
+'date' => <<'END_OF_FUNC',
+sub date {
+    my($time,$format) = @_;
+    my(@MON)=qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
+    my(@WDAY) = qw/Sun Mon Tue Wed Thu Fri Sat/;
+
+    # pass through preformatted dates for the sake of expire_calc()
+    if ("$time" =~ m/^[^0-9]/o) {
+        return $time;
+    }
+
+    # make HTTP/cookie date string from GMT'ed time
+    # (cookies use '-' as date separator, HTTP uses ' ')
+    my($sc) = ' ';
+    $sc = '-' if $format eq "cookie";
+    my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime($time);
+    $year += 1900;
+    return sprintf("%s, %02d$sc%s$sc%04d %02d:%02d:%02d GMT",
+                   $WDAY[$wday],$mday,$MON[$mon],$year,$hour,$min,$sec);
+}
+END_OF_FUNC
+
+###############################################
+# OTHER INFORMATION PROVIDED BY THE ENVIRONMENT
+###############################################
+
+#### Method: path_info
+# Return the extra virtual path information provided
+# after the URL (if any)
+####
+'path_info' => <<'END_OF_FUNC',
+sub path_info {
+    return $ENV{'PATH_INFO'};
+}
+END_OF_FUNC
+
+
+#### Method: request_method
+# Returns 'POST', 'GET', 'PUT' or 'HEAD'
+####
+'request_method' => <<'END_OF_FUNC',
+sub request_method {
+    return $ENV{'REQUEST_METHOD'};
+}
+END_OF_FUNC
+
+#### Method: path_translated
+# Return the physical path information provided
+# by the URL (if any)
+####
+'path_translated' => <<'END_OF_FUNC',
+sub path_translated {
+    return $ENV{'PATH_TRANSLATED'};
+}
+END_OF_FUNC
+
+
+#### Method: query_string
+# Synthesize a query string from our current
+# parameters
+####
+'query_string' => <<'END_OF_FUNC',
+sub query_string {
+    my($self) = self_or_default(@_);
+    my($param,$value,@pairs);
+    foreach $param ($self->param) {
+	my($eparam) = &escape($param);
+	foreach $value ($self->param($param)) {
+	    $value = &escape($value);
+	    push(@pairs,"$eparam=$value");
+	}
+    }
+    return join("&",@pairs);
+}
+END_OF_FUNC
+
+
+#### Method: accept
+# Without parameters, returns an array of the
+# MIME types the browser accepts.
+# With a single parameter equal to a MIME
+# type, will return undef if the browser won't
+# accept it, 1 if the browser accepts it but
+# doesn't give a preference, or a floating point
+# value between 0.0 and 1.0 if the browser
+# declares a quantitative score for it.
+# This handles MIME type globs correctly.
+####
+'accept' => <<'END_OF_FUNC',
+sub accept {
+    my($self,$search) = self_or_CGI(@_);
+    my(%prefs,$type,$pref,$pat);
+    
+    my(@accept) = split(',',$self->http('accept'));
+
+    foreach (@accept) {
+	($pref) = /q=(\d\.\d+|\d+)/;
+	($type) = m#(\S+/[^;]+)#;
+	next unless $type;
+	$prefs{$type}=$pref || 1;
+    }
+
+    return keys %prefs unless $search;
+    
+    # if a search type is provided, we may need to
+    # perform a pattern matching operation.
+    # The MIME types use a glob mechanism, which
+    # is easily translated into a perl pattern match
+
+    # First return the preference for directly supported
+    # types:
+    return $prefs{$search} if $prefs{$search};
+
+    # Didn't get it, so try pattern matching.
+    foreach (keys %prefs) {
+	next unless /\*/;       # not a pattern match
+	($pat = $_) =~ s/([^\w*])/\\$1/g; # escape meta characters
+	$pat =~ s/\*/.*/g; # turn it into a pattern
+	return $prefs{$_} if $search=~/$pat/;
+    }
+}
+END_OF_FUNC
+
+
+#### Method: user_agent
+# If called with no parameters, returns the user agent.
+# If called with one parameter, does a pattern match (case
+# insensitive) on the user agent.
+####
+'user_agent' => <<'END_OF_FUNC',
+sub user_agent {
+    my($self,$match)=self_or_CGI(@_);
+    return $self->http('user_agent') unless $match;
+    return $self->http('user_agent') =~ /$match/i;
+}
+END_OF_FUNC
+
+
+#### Method: cookie
+# Returns the magic cookie for the session.
+# To set the magic cookie for new transations,
+# try print $q->header('-Set-cookie'=>'my cookie')
+####
+'raw_cookie' => <<'END_OF_FUNC',
+sub raw_cookie {
+    my($self) = self_or_CGI(@_);
+    return $self->http('cookie') || $ENV{'COOKIE'} || '';
+}
+END_OF_FUNC
+
+#### Method: virtual_host
+# Return the name of the virtual_host, which
+# is not always the same as the server
+######
+'virtual_host' => <<'END_OF_FUNC',
+sub virtual_host {
+    return http('host') || server_name();
+}
+END_OF_FUNC
+
+#### Method: remote_host
+# Return the name of the remote host, or its IP
+# address if unavailable.  If this variable isn't
+# defined, it returns "localhost" for debugging
+# purposes.
+####
+'remote_host' => <<'END_OF_FUNC',
+sub remote_host {
+    return $ENV{'REMOTE_HOST'} || $ENV{'REMOTE_ADDR'} 
+    || 'localhost';
+}
+END_OF_FUNC
+
+
+#### Method: remote_addr
+# Return the IP addr of the remote host.
+####
+'remote_addr' => <<'END_OF_FUNC',
+sub remote_addr {
+    return $ENV{'REMOTE_ADDR'} || '127.0.0.1';
+}
+END_OF_FUNC
+
+
+#### Method: script_name
+# Return the partial URL to this script for
+# self-referencing scripts.  Also see
+# self_url(), which returns a URL with all state information
+# preserved.
+####
+'script_name' => <<'END_OF_FUNC',
+sub script_name {
+    return $ENV{'SCRIPT_NAME'} if $ENV{'SCRIPT_NAME'};
+    # These are for debugging
+    return "/$0" unless $0=~/^\//;
+    return $0;
+}
+END_OF_FUNC
+
+
+#### Method: referer
+# Return the HTTP_REFERER: useful for generating
+# a GO BACK button.
+####
+'referer' => <<'END_OF_FUNC',
+sub referer {
+    my($self) = self_or_CGI(@_);
+    return $self->http('referer');
+}
+END_OF_FUNC
+
+
+#### Method: server_name
+# Return the name of the server
+####
+'server_name' => <<'END_OF_FUNC',
+sub server_name {
+    return $ENV{'SERVER_NAME'} || 'localhost';
+}
+END_OF_FUNC
+
+#### Method: server_software
+# Return the name of the server software
+####
+'server_software' => <<'END_OF_FUNC',
+sub server_software {
+    return $ENV{'SERVER_SOFTWARE'} || 'cmdline';
+}
+END_OF_FUNC
+
+#### Method: server_port
+# Return the tcp/ip port the server is running on
+####
+'server_port' => <<'END_OF_FUNC',
+sub server_port {
+    return $ENV{'SERVER_PORT'} || 80; # for debugging
+}
+END_OF_FUNC
+
+#### Method: server_protocol
+# Return the protocol (usually HTTP/1.0)
+####
+'server_protocol' => <<'END_OF_FUNC',
+sub server_protocol {
+    return $ENV{'SERVER_PROTOCOL'} || 'HTTP/1.0'; # for debugging
+}
+END_OF_FUNC
+
+#### Method: http
+# Return the value of an HTTP variable, or
+# the list of variables if none provided
+####
+'http' => <<'END_OF_FUNC',
+sub http {
+    my ($self,$parameter) = self_or_CGI(@_);
+    return $ENV{$parameter} if $parameter=~/^HTTP/;
+    return $ENV{"HTTP_\U$parameter\E"} if $parameter;
+    my(@p);
+    foreach (keys %ENV) {
+	push(@p,$_) if /^HTTP/;
+    }
+    return @p;
+}
+END_OF_FUNC
+
+#### Method: https
+# Return the value of HTTPS
+####
+'https' => <<'END_OF_FUNC',
+sub https {
+    local($^W)=0;
+    my ($self,$parameter) = self_or_CGI(@_);
+    return $ENV{HTTPS} unless $parameter;
+    return $ENV{$parameter} if $parameter=~/^HTTPS/;
+    return $ENV{"HTTPS_\U$parameter\E"} if $parameter;
+    my(@p);
+    foreach (keys %ENV) {
+	push(@p,$_) if /^HTTPS/;
+    }
+    return @p;
+}
+END_OF_FUNC
+
+#### Method: protocol
+# Return the protocol (http or https currently)
+####
+'protocol' => <<'END_OF_FUNC',
+sub protocol {
+    local($^W)=0;
+    my $self = shift;
+    return 'https' if $self->https() eq 'ON'; 
+    return 'https' if $self->server_port == 443;
+    my $prot = $self->server_protocol;
+    my($protocol,$version) = split('/',$prot);
+    return "\L$protocol\E";
+}
+END_OF_FUNC
+
+#### Method: remote_ident
+# Return the identity of the remote user
+# (but only if his host is running identd)
+####
+'remote_ident' => <<'END_OF_FUNC',
+sub remote_ident {
+    return $ENV{'REMOTE_IDENT'};
+}
+END_OF_FUNC
+
+
+#### Method: auth_type
+# Return the type of use verification/authorization in use, if any.
+####
+'auth_type' => <<'END_OF_FUNC',
+sub auth_type {
+    return $ENV{'AUTH_TYPE'};
+}
+END_OF_FUNC
+
+
+#### Method: remote_user
+# Return the authorization name used for user
+# verification.
+####
+'remote_user' => <<'END_OF_FUNC',
+sub remote_user {
+    return $ENV{'REMOTE_USER'};
+}
+END_OF_FUNC
+
+
+#### Method: user_name
+# Try to return the remote user's name by hook or by
+# crook
+####
+'user_name' => <<'END_OF_FUNC',
+sub user_name {
+    my ($self) = self_or_CGI(@_);
+    return $self->http('from') || $ENV{'REMOTE_IDENT'} || $ENV{'REMOTE_USER'};
+}
+END_OF_FUNC
+
+#### Method: nph
+# Set or return the NPH global flag
+####
+'nph' => <<'END_OF_FUNC',
+sub nph {
+    my ($self,$param) = self_or_CGI(@_);
+    $CGI::NPH = $param if defined($param);
+    return $CGI::NPH;
+}
+END_OF_FUNC
+
+#### Method: private_tempfiles
+# Set or return the private_tempfiles global flag
+####
+'private_tempfiles' => <<'END_OF_FUNC',
+sub private_tempfiles {
+    my ($self,$param) = self_or_CGI(@_);
+    $CGI::$PRIVATE_TEMPFILES = $param if defined($param);
+    return $CGI::PRIVATE_TEMPFILES;
+}
+END_OF_FUNC
+
+# -------------- really private subroutines -----------------
+'previous_or_default' => <<'END_OF_FUNC',
+sub previous_or_default {
+    my($self,$name,$defaults,$override) = @_;
+    my(%selected);
+
+    if (!$override && ($self->{'.fieldnames'}->{$name} || 
+		       defined($self->param($name)) ) ) {
+	grep($selected{$_}++,$self->param($name));
+    } elsif (defined($defaults) && ref($defaults) && 
+	     (ref($defaults) eq 'ARRAY')) {
+	grep($selected{$_}++,@{$defaults});
+    } else {
+	$selected{$defaults}++ if defined($defaults);
+    }
+
+    return %selected;
+}
+END_OF_FUNC
+
+'register_parameter' => <<'END_OF_FUNC',
+sub register_parameter {
+    my($self,$param) = @_;
+    $self->{'.parametersToAdd'}->{$param}++;
+}
+END_OF_FUNC
+
+'get_fields' => <<'END_OF_FUNC',
+sub get_fields {
+    my($self) = @_;
+    return $self->hidden('-name'=>'.cgifields',
+			 '-values'=>[keys %{$self->{'.parametersToAdd'}}],
+			 '-override'=>1);
+}
+END_OF_FUNC
+
+'read_from_cmdline' => <<'END_OF_FUNC',
+sub read_from_cmdline {
+    require "shellwords.pl";
+    my($input,@words);
+    my($query_string);
+    if (@ARGV) {
+	$input = join(" ",@ARGV);
+    } else {
+	print STDERR "(offline mode: enter name=value pairs on standard input)\n";
+	chomp(@lines = <>); # remove newlines
+	$input = join(" ",@lines);
+    }
+
+    # minimal handling of escape characters
+    $input=~s/\\=/%3D/g;
+    $input=~s/\\&/%26/g;
+    
+    @words = &shellwords($input);
+    if ("@words"=~/=/) {
+	$query_string = join('&',@words);
+    } else {
+	$query_string = join('+',@words);
+    }
+    return $query_string;
+}
+END_OF_FUNC
+
+#####
+# subroutine: read_multipart
+#
+# Read multipart data and store it into our parameters.
+# An interesting feature is that if any of the parts is a file, we
+# create a temporary file and open up a filehandle on it so that the
+# caller can read from it if necessary.
+#####
+'read_multipart' => <<'END_OF_FUNC',
+sub read_multipart {
+    my($self,$boundary,$length) = @_;
+    my($buffer) = $self->new_MultipartBuffer($boundary,$length);
+    return unless $buffer;
+    my(%header,$body);
+    while (!$buffer->eof) {
+	%header = $buffer->readHeader;
+	die "Malformed multipart POST\n" unless %header;
+
+	# In beta1 it was "Content-disposition".  In beta2 it's "Content-Disposition"
+	# Sheesh.
+	my($key) = $header{'Content-disposition'} ? 'Content-disposition' : 'Content-Disposition';
+	my($param)= $header{$key}=~/ name="([^\"]*)"/;
+
+	# possible bug: our regular expression expects the filename= part to fall
+	# at the end of the line.  Netscape doesn't escape quotation marks in file names!!!
+	my($filename) = $header{$key}=~/ filename="(.*)"$/;
+
+	# add this parameter to our list
+	$self->add_parameter($param);
+
+	# If no filename specified, then just read the data and assign it
+	# to our parameter list.
+	unless ($filename) {
+	    my($value) = $buffer->readBody;
+	    push(@{$self->{$param}},$value);
+	    next;
+	}
+
+	# If we get here, then we are dealing with a potentially large
+	# uploaded form.  Save the data to a temporary file, then open
+	# the file for reading.
+	my($tmpfile) = new TempFile;
+	my $tmp = $tmpfile->as_string;
+	
+	# Now create a new filehandle in the caller's namespace.
+	# The name of this filehandle just happens to be identical
+	# to the original filename (NOT the name of the temporary
+	# file, which is hidden!)
+	my($filehandle);
+	if ($filename=~/^[a-zA-Z_]/) {
+	    my($frame,$cp)=(1);
+	    do { $cp = caller($frame++); } until !eval("'$cp'->isaCGI()");
+	    $filehandle = "$cp\:\:$filename";
+	} else {
+	    $filehandle = "\:\:$filename";
+	}
+
+        # potential security problem -- this type of line can clobber 
+	# tempfile, and can be abused by malicious users.
+	# open ($filehandle,">$tmp") || die "CGI open of $tmpfile: $!\n";
+
+	# This technique causes open to fail if file already exists.
+	unless (defined(&O_RDWR)) {
+	    require Fcntl;
+	    import Fcntl qw/O_RDWR O_CREAT O_EXCL/;
+	}
+	sysopen($filehandle,$tmp,&O_RDWR|&O_CREAT|&O_EXCL) || die "CGI open of $tmp: $!\n";
+	unlink($tmp) if $PRIVATE_TEMPFILES;
+
+	$CGI::DefaultClass->binmode($filehandle) if $CGI::needs_binmode;
+	chmod 0600,$tmp;    # only the owner can tamper with it
+	my $data;
+	while (defined($data = $buffer->read)) {
+	    print $filehandle $data;
+	}
+
+	seek($filehandle,0,0); #rewind file
+	push(@{$self->{$param}},$filename);
+
+	# Under Unix, it would be safe to let the temporary file
+	# be deleted immediately.  However, I fear that other operating
+	# systems are not so forgiving.  Therefore we save a reference
+	# to the temporary file in the CGI object so that the file
+	# isn't unlinked until the CGI object itself goes out of
+	# scope.  This is a bit hacky, but it has the interesting side
+	# effect that one can access the name of the tmpfile by
+	# asking for $query->{$query->param('foo')}, where 'foo'
+	# is the name of the file upload field.
+	$self->{'.tmpfiles'}->{$filename}= {
+	    name=>($PRIVATE_TEMPFILES ? '' : $tmpfile),
+	    info=>{%header}
+	}
+    }
+}
+END_OF_FUNC
+
+'tmpFileName' => <<'END_OF_FUNC',
+sub tmpFileName {
+    my($self,$filename) = self_or_default(@_);
+    return $self->{'.tmpfiles'}->{$filename}->{name} ?
+	$self->{'.tmpfiles'}->{$filename}->{name}->as_string
+	    : '';
+}
+END_OF_FUNC
+
+'uploadInfo' => <<'END_OF_FUNC'
+sub uploadInfo {
+    my($self,$filename) = self_or_default(@_);
+    return $self->{'.tmpfiles'}->{$filename}->{info};
+}
+END_OF_FUNC
+
+);
+END_OF_AUTOLOAD
+;
+
+# Globals and stubs for other packages that we use
+package MultipartBuffer;
+
+# how many bytes to read at a time.  We use
+# a 5K buffer by default.
+$FILLUNIT = 1024 * 5;
+$TIMEOUT = 10*60;       # 10 minute timeout
+$SPIN_LOOP_MAX = 1000;  # bug fix for some Netscape servers
+$CRLF=$CGI::CRLF;
+
+#reuse the autoload function
+*MultipartBuffer::AUTOLOAD = \&CGI::AUTOLOAD;
+
+###############################################################################
+################# THESE FUNCTIONS ARE AUTOLOADED ON DEMAND ####################
+###############################################################################
+$AUTOLOADED_ROUTINES = '';      # prevent -w error
+$AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD';
+%SUBS =  (
+
+'new' => <<'END_OF_FUNC',
+sub new {
+    my($package,$interface,$boundary,$length,$filehandle) = @_;
+    my $IN;
+    if ($filehandle) {
+	my($package) = caller;
+	# force into caller's package if necessary
+	$IN = $filehandle=~/[':]/ ? $filehandle : "$package\:\:$filehandle"; 
+    }
+    $IN = "main::STDIN" unless $IN;
+
+    $CGI::DefaultClass->binmode($IN) if $CGI::needs_binmode;
+    
+    # If the user types garbage into the file upload field,
+    # then Netscape passes NOTHING to the server (not good).
+    # We may hang on this read in that case. So we implement
+    # a read timeout.  If nothing is ready to read
+    # by then, we return.
+
+    # Netscape seems to be a little bit unreliable
+    # about providing boundary strings.
+    if ($boundary) {
+
+	# Under the MIME spec, the boundary consists of the 
+	# characters "--" PLUS the Boundary string
+	$boundary = "--$boundary";
+	# Read the topmost (boundary) line plus the CRLF
+	my($null) = '';
+	$length -= $interface->read_from_client($IN,\$null,length($boundary)+2,0);
+    } else { # otherwise we find it ourselves
+	my($old);
+	($old,$/) = ($/,$CRLF); # read a CRLF-delimited line
+	$boundary = <$IN>;      # BUG: This won't work correctly under mod_perl
+	$length -= length($boundary);
+	chomp($boundary);               # remove the CRLF
+	$/ = $old;                      # restore old line separator
+    }
+
+    my $self = {LENGTH=>$length,
+		BOUNDARY=>$boundary,
+		IN=>$IN,
+		INTERFACE=>$interface,
+		BUFFER=>'',
+	    };
+
+    $FILLUNIT = length($boundary)
+	if length($boundary) > $FILLUNIT;
+
+    return bless $self,ref $package || $package;
+}
+END_OF_FUNC
+
+'readHeader' => <<'END_OF_FUNC',
+sub readHeader {
+    my($self) = @_;
+    my($end);
+    my($ok) = 0;
+    my($bad) = 0;
+    do {
+	$self->fillBuffer($FILLUNIT);
+	$ok++ if ($end = index($self->{BUFFER},"${CRLF}${CRLF}")) >= 0;
+	$ok++ if $self->{BUFFER} eq '';
+	$bad++ if !$ok && $self->{LENGTH} <= 0;
+	$FILLUNIT *= 2 if length($self->{BUFFER}) >= $FILLUNIT; 
+    } until $ok || $bad;
+    return () if $bad;
+
+    my($header) = substr($self->{BUFFER},0,$end+2);
+    substr($self->{BUFFER},0,$end+4) = '';
+    my %return;
+    while ($header=~/^([\w-]+): (.*)$CRLF/mog) {
+	$return{$1}=$2;
+    }
+    return %return;
+}
+END_OF_FUNC
+
+# This reads and returns the body as a single scalar value.
+'readBody' => <<'END_OF_FUNC',
+sub readBody {
+    my($self) = @_;
+    my($data);
+    my($returnval)='';
+    while (defined($data = $self->read)) {
+	$returnval .= $data;
+    }
+    return $returnval;
+}
+END_OF_FUNC
+
+# This will read $bytes or until the boundary is hit, whichever happens
+# first.  After the boundary is hit, we return undef.  The next read will
+# skip over the boundary and begin reading again;
+'read' => <<'END_OF_FUNC',
+sub read {
+    my($self,$bytes) = @_;
+
+    # default number of bytes to read
+    $bytes = $bytes || $FILLUNIT;       
+
+    # Fill up our internal buffer in such a way that the boundary
+    # is never split between reads.
+    $self->fillBuffer($bytes);
+
+    # Find the boundary in the buffer (it may not be there).
+    my $start = index($self->{BUFFER},$self->{BOUNDARY});
+    # protect against malformed multipart POST operations
+    die "Malformed multipart POST\n" unless ($start >= 0) || ($self->{LENGTH} > 0);
+
+    # If the boundary begins the data, then skip past it
+    # and return undef.  The +2 here is a fiendish plot to
+    # remove the CR/LF pair at the end of the boundary.
+    if ($start == 0) {
+
+	# clear us out completely if we've hit the last boundary.
+	if (index($self->{BUFFER},"$self->{BOUNDARY}--")==0) {
+	    $self->{BUFFER}='';
+	    $self->{LENGTH}=0;
+	    return undef;
+	}
+
+	# just remove the boundary.
+	substr($self->{BUFFER},0,length($self->{BOUNDARY})+2)='';
+	return undef;
+    }
+
+    my $bytesToReturn;    
+    if ($start > 0) {           # read up to the boundary
+	$bytesToReturn = $start > $bytes ? $bytes : $start;
+    } else {    # read the requested number of bytes
+	# leave enough bytes in the buffer to allow us to read
+	# the boundary.  Thanks to Kevin Hendrick for finding
+	# this one.
+	$bytesToReturn = $bytes - (length($self->{BOUNDARY})+1);
+    }
+
+    my $returnval=substr($self->{BUFFER},0,$bytesToReturn);
+    substr($self->{BUFFER},0,$bytesToReturn)='';
+    
+    # If we hit the boundary, remove the CRLF from the end.
+    return ($start > 0) ? substr($returnval,0,-2) : $returnval;
+}
+END_OF_FUNC
+
+
+# This fills up our internal buffer in such a way that the
+# boundary is never split between reads
+'fillBuffer' => <<'END_OF_FUNC',
+sub fillBuffer {
+    my($self,$bytes) = @_;
+    return unless $self->{LENGTH};
+
+    my($boundaryLength) = length($self->{BOUNDARY});
+    my($bufferLength) = length($self->{BUFFER});
+    my($bytesToRead) = $bytes - $bufferLength + $boundaryLength + 2;
+    $bytesToRead = $self->{LENGTH} if $self->{LENGTH} < $bytesToRead;
+
+    # Try to read some data.  We may hang here if the browser is screwed up.  
+    my $bytesRead = $self->{INTERFACE}->read_from_client($self->{IN},
+							 \$self->{BUFFER},
+							 $bytesToRead,
+							 $bufferLength);
+
+    # An apparent bug in the Apache server causes the read()
+    # to return zero bytes repeatedly without blocking if the
+    # remote user aborts during a file transfer.  I don't know how
+    # they manage this, but the workaround is to abort if we get
+    # more than SPIN_LOOP_MAX consecutive zero reads.
+    if ($bytesRead == 0) {
+	die  "CGI.pm: Server closed socket during multipart read (client aborted?).\n"
+	    if ($self->{ZERO_LOOP_COUNTER}++ >= $SPIN_LOOP_MAX);
+    } else {
+	$self->{ZERO_LOOP_COUNTER}=0;
+    }
+
+    $self->{LENGTH} -= $bytesRead;
+}
+END_OF_FUNC
+
+
+# Return true when we've finished reading
+'eof' => <<'END_OF_FUNC'
+sub eof {
+    my($self) = @_;
+    return 1 if (length($self->{BUFFER}) == 0)
+		 && ($self->{LENGTH} <= 0);
+    undef;
+}
+END_OF_FUNC
+
+);
+END_OF_AUTOLOAD
+
+####################################################################################
+################################## TEMPORARY FILES #################################
+####################################################################################
+package TempFile;
+
+$SL = $CGI::SL;
+unless ($TMPDIRECTORY) {
+    @TEMP=("${SL}usr${SL}tmp","${SL}var${SL}tmp","${SL}tmp","${SL}temp","${SL}Temporary Items");
+    foreach (@TEMP) {
+	do {$TMPDIRECTORY = $_; last} if -d $_ && -w _;
+    }
+}
+
+$TMPDIRECTORY  = "." unless $TMPDIRECTORY;
+$SEQUENCE="CGItemp${$}0000";
+
+# cute feature, but overload implementation broke it
+# %OVERLOAD = ('""'=>'as_string');
+*TempFile::AUTOLOAD = \&CGI::AUTOLOAD;
+
+###############################################################################
+################# THESE FUNCTIONS ARE AUTOLOADED ON DEMAND ####################
+###############################################################################
+$AUTOLOADED_ROUTINES = '';      # prevent -w error
+$AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD';
+%SUBS = (
+
+'new' => <<'END_OF_FUNC',
+sub new {
+    my($package) = @_;
+    $SEQUENCE++;
+    my $directory = "${TMPDIRECTORY}${SL}${SEQUENCE}";
+    return bless \$directory;
+}
+END_OF_FUNC
+
+'DESTROY' => <<'END_OF_FUNC',
+sub DESTROY {
+    my($self) = @_;
+    unlink $$self;              # get rid of the file
+}
+END_OF_FUNC
+
+'as_string' => <<'END_OF_FUNC'
+sub as_string {
+    my($self) = @_;
+    return $$self;
+}
+END_OF_FUNC
+
+);
+END_OF_AUTOLOAD
+
+package CGI;
+
+# We get a whole bunch of warnings about "possibly uninitialized variables"
+# when running with the -w switch.  Touch them all once to get rid of the
+# warnings.  This is ugly and I hate it.
+if ($^W) {
+    $CGI::CGI = '';
+    $CGI::CGI=<<EOF;
+    $CGI::VERSION;
+    $MultipartBuffer::SPIN_LOOP_MAX;
+    $MultipartBuffer::CRLF;
+    $MultipartBuffer::TIMEOUT;
+    $MultipartBuffer::FILLUNIT;
+    $TempFile::SEQUENCE;
+EOF
+    ;
+}
+
+$revision;
+
+__END__
+
+=head1 NAME
+
+CGI - Simple Common Gateway Interface Class
+
+=head1 SYNOPSIS
+
+  use CGI;
+  # the rest is too complicated for a synopsis; keep reading
+
+=head1 ABSTRACT
+
+This perl library uses perl5 objects to make it easy to create
+Web fill-out forms and parse their contents.  This package
+defines CGI objects, entities that contain the values of the
+current query string and other state variables.
+Using a CGI object's methods, you can examine keywords and parameters
+passed to your script, and create forms whose initial values
+are taken from the current query (thereby preserving state
+information).
+
+The current version of CGI.pm is available at
+
+  http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
+  ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
+
+=head1 INSTALLATION
+
+CGI is a part of the base Perl installation.  However, you may need
+to install a newer version someday.  Therefore:
+
+To install this package, just change to the directory in which this
+file is found and type the following:
+
+	perl Makefile.PL
+	make
+	make install
+
+This will copy CGI.pm to your perl library directory for use by all
+perl scripts.  You probably must be root to do this.   Now you can
+load the CGI routines in your Perl scripts with the line:
+
+	use CGI;
+
+If you don't have sufficient privileges to install CGI.pm in the Perl
+library directory, you can put CGI.pm into some convenient spot, such
+as your home directory, or in cgi-bin itself and prefix all Perl
+scripts that call it with something along the lines of the following
+preamble:
+
+	use lib '/home/davis/lib';
+	use CGI;
+
+If you are using a version of perl earlier than 5.002 (such as NT perl), use
+this instead:
+
+	BEGIN {
+		unshift(@INC,'/home/davis/lib');
+	}
+	use CGI;
+
+The CGI distribution also comes with a cute module called L<CGI::Carp>.
+It redefines the die(), warn(), confess() and croak() error routines
+so that they write nicely formatted error messages into the server's
+error log (or to the output stream of your choice).  This avoids long
+hours of groping through the error and access logs, trying to figure
+out which CGI script is generating  error messages.  If you choose,
+you can even have fatal error messages echoed to the browser to avoid
+the annoying and uninformative "Server Error" message.
+
+=head1 DESCRIPTION
+
+=head2 CREATING A NEW QUERY OBJECT:
+
+     $query = new CGI;
+
+This will parse the input (from both POST and GET methods) and store
+it into a perl5 object called $query.  
+
+=head2 CREATING A NEW QUERY OBJECT FROM AN INPUT FILE
+
+     $query = new CGI(INPUTFILE);
+
+If you provide a file handle to the new() method, it
+will read parameters from the file (or STDIN, or whatever).  The
+file can be in any of the forms describing below under debugging
+(i.e. a series of newline delimited TAG=VALUE pairs will work).
+Conveniently, this type of file is created by the save() method
+(see below).  Multiple records can be saved and restored.
+
+Perl purists will be pleased to know that this syntax accepts
+references to file handles, or even references to filehandle globs,
+which is the "official" way to pass a filehandle:
+
+    $query = new CGI(\*STDIN);
+
+You can also initialize the query object from an associative array
+reference:
+
+    $query = new CGI( {'dinosaur'=>'barney',
+		       'song'=>'I love you',
+		       'friends'=>[qw/Jessica George Nancy/]}
+		    );
+
+or from a properly formatted, URL-escaped query string:
+
+    $query = new CGI('dinosaur=barney&color=purple');
+
+To create an empty query, initialize it from an empty string or hash:
+
+	$empty_query = new CGI("");
+	     -or-
+	$empty_query = new CGI({});
+
+=head2 FETCHING A LIST OF KEYWORDS FROM THE QUERY:
+
+     @keywords = $query->keywords
+
+If the script was invoked as the result of an <ISINDEX> search, the
+parsed keywords can be obtained as an array using the keywords() method.
+
+=head2 FETCHING THE NAMES OF ALL THE PARAMETERS PASSED TO YOUR SCRIPT:
+
+     @names = $query->param
+
+If the script was invoked with a parameter list
+(e.g. "name1=value1&name2=value2&name3=value3"), the param()
+method will return the parameter names as a list.  If the
+script was invoked as an <ISINDEX> script, there will be a
+single parameter named 'keywords'.
+
+NOTE: As of version 1.5, the array of parameter names returned will
+be in the same order as they were submitted by the browser.
+Usually this order is the same as the order in which the 
+parameters are defined in the form (however, this isn't part
+of the spec, and so isn't guaranteed).
+
+=head2 FETCHING THE VALUE OR VALUES OF A SINGLE NAMED PARAMETER:
+
+    @values = $query->param('foo');
+
+	      -or-
+
+    $value = $query->param('foo');
+
+Pass the param() method a single argument to fetch the value of the
+named parameter. If the parameter is multivalued (e.g. from multiple
+selections in a scrolling list), you can ask to receive an array.  Otherwise
+the method will return a single value.
+
+=head2 SETTING THE VALUE(S) OF A NAMED PARAMETER:
+
+    $query->param('foo','an','array','of','values');
+
+This sets the value for the named parameter 'foo' to an array of
+values.  This is one way to change the value of a field AFTER
+the script has been invoked once before.  (Another way is with
+the -override parameter accepted by all methods that generate
+form elements.)
+
+param() also recognizes a named parameter style of calling described
+in more detail later:
+
+    $query->param(-name=>'foo',-values=>['an','array','of','values']);
+
+			      -or-
+
+    $query->param(-name=>'foo',-value=>'the value');
+
+=head2 APPENDING ADDITIONAL VALUES TO A NAMED PARAMETER:
+
+   $query->append(-name=>;'foo',-values=>['yet','more','values']);
+
+This adds a value or list of values to the named parameter.  The
+values are appended to the end of the parameter if it already exists.
+Otherwise the parameter is created.  Note that this method only
+recognizes the named argument calling syntax.
+
+=head2 IMPORTING ALL PARAMETERS INTO A NAMESPACE:
+
+   $query->import_names('R');
+
+This creates a series of variables in the 'R' namespace.  For example,
+$R::foo, @R:foo.  For keyword lists, a variable @R::keywords will appear.
+If no namespace is given, this method will assume 'Q'.
+WARNING:  don't import anything into 'main'; this is a major security
+risk!!!!
+
+In older versions, this method was called B<import()>.  As of version 2.20, 
+this name has been removed completely to avoid conflict with the built-in
+Perl module B<import> operator.
+
+=head2 DELETING A PARAMETER COMPLETELY:
+
+    $query->delete('foo');
+
+This completely clears a parameter.  It sometimes useful for
+resetting parameters that you don't want passed down between
+script invocations.
+
+=head2 DELETING ALL PARAMETERS:
+
+$query->delete_all();
+
+This clears the CGI object completely.  It might be useful to ensure
+that all the defaults are taken when you create a fill-out form.
+
+=head2 SAVING THE STATE OF THE FORM TO A FILE:
+
+    $query->save(FILEHANDLE)
+
+This will write the current state of the form to the provided
+filehandle.  You can read it back in by providing a filehandle
+to the new() method.  Note that the filehandle can be a file, a pipe,
+or whatever!
+
+The format of the saved file is:
+
+	NAME1=VALUE1
+	NAME1=VALUE1'
+	NAME2=VALUE2
+	NAME3=VALUE3
+	=
+
+Both name and value are URL escaped.  Multi-valued CGI parameters are
+represented as repeated names.  A session record is delimited by a
+single = symbol.  You can write out multiple records and read them
+back in with several calls to B<new>.  You can do this across several
+sessions by opening the file in append mode, allowing you to create
+primitive guest books, or to keep a history of users' queries.  Here's
+a short example of creating multiple session records:
+
+   use CGI;
+
+   open (OUT,">>test.out") || die;
+   $records = 5;
+   foreach (0..$records) {
+       my $q = new CGI;
+       $q->param(-name=>'counter',-value=>$_);
+       $q->save(OUT);
+   }
+   close OUT;
+
+   # reopen for reading
+   open (IN,"test.out") || die;
+   while (!eof(IN)) {
+       my $q = new CGI(IN);
+       print $q->param('counter'),"\n";
+   }
+
+The file format used for save/restore is identical to that used by the
+Whitehead Genome Center's data exchange format "Boulderio", and can be
+manipulated and even databased using Boulderio utilities.  See
+	
+  http://www.genome.wi.mit.edu/genome_software/other/boulder.html
+
+for further details.
+
+=head2 CREATING A SELF-REFERENCING URL THAT PRESERVES STATE INFORMATION:
+
+    $myself = $query->self_url;
+    print "<A HREF=$myself>I'm talking to myself.</A>";
+
+self_url() will return a URL, that, when selected, will reinvoke
+this script with all its state information intact.  This is most
+useful when you want to jump around within the document using
+internal anchors but you don't want to disrupt the current contents
+of the form(s).  Something like this will do the trick.
+
+     $myself = $query->self_url;
+     print "<A HREF=$myself#table1>See table 1</A>";
+     print "<A HREF=$myself#table2>See table 2</A>";
+     print "<A HREF=$myself#yourself>See for yourself</A>";
+
+If you don't want to get the whole query string, call
+the method url() to return just the URL for the script:
+
+    $myself = $query->url;
+    print "<A HREF=$myself>No query string in this baby!</A>\n";
+
+You can also retrieve the unprocessed query string with query_string():
+
+    $the_string = $query->query_string;
+
+=head2 COMPATIBILITY WITH CGI-LIB.PL
+
+To make it easier to port existing programs that use cgi-lib.pl
+the compatibility routine "ReadParse" is provided.  Porting is
+simple:
+
+OLD VERSION
+    require "cgi-lib.pl";
+    &ReadParse;
+    print "The value of the antique is $in{antique}.\n";
+
+NEW VERSION
+    use CGI;
+    CGI::ReadParse
+    print "The value of the antique is $in{antique}.\n";
+
+CGI.pm's ReadParse() routine creates a tied variable named %in,
+which can be accessed to obtain the query variables.  Like
+ReadParse, you can also provide your own variable.  Infrequently
+used features of ReadParse, such as the creation of @in and $in 
+variables, are not supported.
+
+Once you use ReadParse, you can retrieve the query object itself
+this way:
+
+    $q = $in{CGI};
+    print $q->textfield(-name=>'wow',
+			-value=>'does this really work?');
+
+This allows you to start using the more interesting features
+of CGI.pm without rewriting your old scripts from scratch.
+
+=head2 CALLING CGI FUNCTIONS THAT TAKE MULTIPLE ARGUMENTS
+
+In versions of CGI.pm prior to 2.0, it could get difficult to remember
+the proper order of arguments in CGI function calls that accepted five
+or six different arguments.  As of 2.0, there's a better way to pass
+arguments to the various CGI functions.  In this style, you pass a
+series of name=>argument pairs, like this:
+
+   $field = $query->radio_group(-name=>'OS',
+				-values=>[Unix,Windows,Macintosh],
+				-default=>'Unix');
+
+The advantages of this style are that you don't have to remember the
+exact order of the arguments, and if you leave out a parameter, in
+most cases it will default to some reasonable value.  If you provide
+a parameter that the method doesn't recognize, it will usually do
+something useful with it, such as incorporating it into the HTML form
+tag.  For example if Netscape decides next week to add a new
+JUSTIFICATION parameter to the text field tags, you can start using
+the feature without waiting for a new version of CGI.pm:
+
+   $field = $query->textfield(-name=>'State',
+			      -default=>'gaseous',
+			      -justification=>'RIGHT');
+
+This will result in an HTML tag that looks like this:
+
+	<INPUT TYPE="textfield" NAME="State" VALUE="gaseous"
+	       JUSTIFICATION="RIGHT">
+
+Parameter names are case insensitive: you can use -name, or -Name or
+-NAME.  You don't have to use the hyphen if you don't want to.  After
+creating a CGI object, call the B<use_named_parameters()> method with
+a nonzero value.  This will tell CGI.pm that you intend to use named
+parameters exclusively:
+
+   $query = new CGI;
+   $query->use_named_parameters(1);
+   $field = $query->radio_group('name'=>'OS',
+				'values'=>['Unix','Windows','Macintosh'],
+				'default'=>'Unix');
+
+Actually, CGI.pm only looks for a hyphen in the first parameter.  So
+you can leave it off subsequent parameters if you like.  Something to
+be wary of is the potential that a string constant like "values" will
+collide with a keyword (and in fact it does!) While Perl usually
+figures out when you're referring to a function and when you're
+referring to a string, you probably should put quotation marks around
+all string constants just to play it safe.
+
+=head2 CREATING THE HTTP HEADER:
+
+	print $query->header;
+
+	     -or-
+
+	print $query->header('image/gif');
+
+	     -or-
+
+	print $query->header('text/html','204 No response');
+
+	     -or-
+
+	print $query->header(-type=>'image/gif',
+			     -nph=>1,
+			     -status=>'402 Payment required',
+			     -expires=>'+3d',
+			     -cookie=>$cookie,
+			     -Cost=>'$2.00');
+
+header() returns the Content-type: header.  You can provide your own
+MIME type if you choose, otherwise it defaults to text/html.  An
+optional second parameter specifies the status code and a human-readable
+message.  For example, you can specify 204, "No response" to create a
+script that tells the browser to do nothing at all.  If you want to
+add additional fields to the header, just tack them on to the end:
+
+    print $query->header('text/html','200 OK','Content-Length: 3002');
+
+The last example shows the named argument style for passing arguments
+to the CGI methods using named parameters.  Recognized parameters are
+B<-type>, B<-status>, B<-expires>, and B<-cookie>.  Any other 
+parameters will be stripped of their initial hyphens and turned into
+header fields, allowing you to specify any HTTP header you desire.
+
+Most browsers will not cache the output from CGI scripts.  Every time
+the browser reloads the page, the script is invoked anew.  You can
+change this behavior with the B<-expires> parameter.  When you specify
+an absolute or relative expiration interval with this parameter, some
+browsers and proxy servers will cache the script's output until the
+indicated expiration date.  The following forms are all valid for the
+-expires field:
+
+	+30s                              30 seconds from now
+	+10m                              ten minutes from now
+	+1h                               one hour from now
+	-1d                               yesterday (i.e. "ASAP!")
+	now                               immediately
+	+3M                               in three months
+	+10y                              in ten years time
+	Thursday, 25-Apr-96 00:40:33 GMT  at the indicated time & date
+
+(CGI::expires() is the static function call used internally that turns
+relative time intervals into HTTP dates.  You can call it directly if
+you wish.)
+
+The B<-cookie> parameter generates a header that tells the browser to provide
+a "magic cookie" during all subsequent transactions with your script.
+Netscape cookies have a special format that includes interesting attributes
+such as expiration time.  Use the cookie() method to create and retrieve
+session cookies.
+
+The B<-nph> parameter, if set to a true value, will issue the correct
+headers to work with a NPH (no-parse-header) script.  This is important
+to use with certain servers, such as Microsoft Internet Explorer, which
+expect all their scripts to be NPH.
+
+=head2 GENERATING A REDIRECTION INSTRUCTION
+
+   print $query->redirect('http://somewhere.else/in/movie/land');
+
+redirects the browser elsewhere.  If you use redirection like this,
+you should B<not> print out a header as well.  As of version 2.0, we
+produce both the unofficial Location: header and the official URI:
+header.  This should satisfy most servers and browsers.
+
+One hint I can offer is that relative links may not work correctly
+when you generate a redirection to another document on your site.
+This is due to a well-intentioned optimization that some servers use.
+The solution to this is to use the full URL (including the http: part)
+of the document you are redirecting to.
+
+You can use named parameters:
+
+    print $query->redirect(-uri=>'http://somewhere.else/in/movie/land',
+			   -nph=>1);
+
+The B<-nph> parameter, if set to a true value, will issue the correct
+headers to work with a NPH (no-parse-header) script.  This is important
+to use with certain servers, such as Microsoft Internet Explorer, which
+expect all their scripts to be NPH.
+
+
+=head2 CREATING THE HTML HEADER:
+
+   print $query->start_html(-title=>'Secrets of the Pyramids',
+			    -author=>'fred@capricorn.org',
+			    -base=>'true',
+			    -target=>'_blank',
+			    -meta=>{'keywords'=>'pharaoh secret mummy',
+				    'copyright'=>'copyright 1996 King Tut'},
+			    -style=>{'src'=>'/styles/style1.css'},
+			    -BGCOLOR=>'blue');
+
+   -or-
+
+   print $query->start_html('Secrets of the Pyramids',
+			    'fred@capricorn.org','true',
+			    'BGCOLOR="blue"');
+
+This will return a canned HTML header and the opening <BODY> tag.  
+All parameters are optional.   In the named parameter form, recognized
+parameters are -title, -author, -base, -xbase and -target (see below for the
+explanation).  Any additional parameters you provide, such as the
+Netscape unofficial BGCOLOR attribute, are added to the <BODY> tag.
+
+The argument B<-xbase> allows you to provide an HREF for the <BASE> tag
+different from the current location, as in
+
+    -xbase=>"http://home.mcom.com/"
+
+All relative links will be interpreted relative to this tag.
+
+The argument B<-target> allows you to provide a default target frame
+for all the links and fill-out forms on the page.  See the Netscape
+documentation on frames for details of how to manipulate this.
+
+    -target=>"answer_window"
+
+All relative links will be interpreted relative to this tag.
+You add arbitrary meta information to the header with the B<-meta>
+argument.  This argument expects a reference to an associative array
+containing name/value pairs of meta information.  These will be turned
+into a series of header <META> tags that look something like this:
+
+    <META NAME="keywords" CONTENT="pharaoh secret mummy">
+    <META NAME="description" CONTENT="copyright 1996 King Tut">
+
+There is no support for the HTTP-EQUIV type of <META> tag.  This is
+because you can modify the HTTP header directly with the B<header()>
+method.  For example, if you want to send the Refresh: header, do it
+in the header() method:
+
+    print $q->header(-Refresh=>'10; URL=http://www.capricorn.com');
+
+The B<-style> tag is used to incorporate cascading stylesheets into
+your code.  See the section on CASCADING STYLESHEETS for more information.
+
+You can place other arbitrary HTML elements to the <HEAD> section with the
+B<-head> tag.  For example, to place the rarely-used <LINK> element in the
+head section, use this:
+
+    print $q->header(-head=>link({-rel=>'next',
+				  -href=>'http://www.capricorn.com/s2.html'}));
+
+To incorporate multiple HTML elements into the <HEAD> section, just pass an
+array reference:
+
+    print $q->header(-head=>[ link({-rel=>'next',
+				    -href=>'http://www.capricorn.com/s2.html'}),
+			      link({-rel=>'previous',
+				    -href=>'http://www.capricorn.com/s1.html'})
+			     ]
+		     );
+
+
+JAVASCRIPTING: The B<-script>, B<-noScript>, B<-onLoad> and B<-onUnload> parameters
+are used to add Netscape JavaScript calls to your pages.  B<-script>
+should point to a block of text containing JavaScript function
+definitions.  This block will be placed within a <SCRIPT> block inside
+the HTML (not HTTP) header.  The block is placed in the header in
+order to give your page a fighting chance of having all its JavaScript
+functions in place even if the user presses the stop button before the
+page has loaded completely.  CGI.pm attempts to format the script in
+such a way that JavaScript-naive browsers will not choke on the code:
+unfortunately there are some browsers, such as Chimera for Unix, that
+get confused by it nevertheless.
+
+The B<-onLoad> and B<-onUnload> parameters point to fragments of JavaScript
+code to execute when the page is respectively opened and closed by the
+browser.  Usually these parameters are calls to functions defined in the
+B<-script> field:
+
+      $query = new CGI;
+      print $query->header;
+      $JSCRIPT=<<END;
+      // Ask a silly question
+      function riddle_me_this() {
+	 var r = prompt("What walks on four legs in the morning, " +
+		       "two legs in the afternoon, " +
+		       "and three legs in the evening?");
+	 response(r);
+      }
+      // Get a silly answer
+      function response(answer) {
+	 if (answer == "man")
+	    alert("Right you are!");
+	 else
+	    alert("Wrong!  Guess again.");
+      }
+      END
+      print $query->start_html(-title=>'The Riddle of the Sphinx',
+			       -script=>$JSCRIPT);
+
+Use the B<-noScript> parameter to pass some HTML text that will be displayed on 
+browsers that do not have JavaScript (or browsers where JavaScript is turned
+off).
+
+Netscape 3.0 recognizes several attributes of the <SCRIPT> tag,
+including LANGUAGE and SRC.  The latter is particularly interesting,
+as it allows you to keep the JavaScript code in a file or CGI script
+rather than cluttering up each page with the source.  To use these
+attributes pass a HASH reference in the B<-script> parameter containing
+one or more of -language, -src, or -code:
+
+    print $q->start_html(-title=>'The Riddle of the Sphinx',
+			 -script=>{-language=>'JAVASCRIPT',
+                                   -src=>'/javascript/sphinx.js'}
+			 );
+
+    print $q->(-title=>'The Riddle of the Sphinx',
+	       -script=>{-language=>'PERLSCRIPT'},
+			 -code=>'print "hello world!\n;"'
+	       );
+
+
+See
+
+   http://home.netscape.com/eng/mozilla/2.0/handbook/javascript/
+
+for more information about JavaScript.
+
+The old-style positional parameters are as follows:
+
+=over 4
+
+=item B<Parameters:>
+
+=item 1.
+
+The title
+
+=item 2.
+
+The author's e-mail address (will create a <LINK REV="MADE"> tag if present
+
+=item 3.
+
+A 'true' flag if you want to include a <BASE> tag in the header.  This
+helps resolve relative addresses to absolute ones when the document is moved, 
+but makes the document hierarchy non-portable.  Use with care!
+
+=item 4, 5, 6...
+
+Any other parameters you want to include in the <BODY> tag.  This is a good
+place to put Netscape extensions, such as colors and wallpaper patterns.
+
+=back
+
+=head2 ENDING THE HTML DOCUMENT:
+
+	print $query->end_html
+
+This ends an HTML document by printing the </BODY></HTML> tags.
+
+=head1 CREATING FORMS
+
+I<General note>  The various form-creating methods all return strings
+to the caller, containing the tag or tags that will create the requested
+form element.  You are responsible for actually printing out these strings.
+It's set up this way so that you can place formatting tags
+around the form elements.
+
+I<Another note> The default values that you specify for the forms are only
+used the B<first> time the script is invoked (when there is no query
+string).  On subsequent invocations of the script (when there is a query
+string), the former values are used even if they are blank.  
+
+If you want to change the value of a field from its previous value, you have two
+choices:
+
+(1) call the param() method to set it.
+
+(2) use the -override (alias -force) parameter (a new feature in version 2.15).
+This forces the default value to be used, regardless of the previous value:
+
+   print $query->textfield(-name=>'field_name',
+			   -default=>'starting value',
+			   -override=>1,
+			   -size=>50,
+			   -maxlength=>80);
+
+I<Yet another note> By default, the text and labels of form elements are
+escaped according to HTML rules.  This means that you can safely use
+"<CLICK ME>" as the label for a button.  However, it also interferes with
+your ability to incorporate special HTML character sequences, such as &Aacute;,
+into your fields.  If you wish to turn off automatic escaping, call the
+autoEscape() method with a false value immediately after creating the CGI object:
+
+   $query = new CGI;
+   $query->autoEscape(undef);
+			     
+
+=head2 CREATING AN ISINDEX TAG
+
+   print $query->isindex(-action=>$action);
+
+	 -or-
+
+   print $query->isindex($action);
+
+Prints out an <ISINDEX> tag.  Not very exciting.  The parameter
+-action specifies the URL of the script to process the query.  The
+default is to process the query with the current script.
+
+=head2 STARTING AND ENDING A FORM
+
+    print $query->startform(-method=>$method,
+			    -action=>$action,
+			    -encoding=>$encoding);
+      <... various form stuff ...>
+    print $query->endform;
+
+	-or-
+
+    print $query->startform($method,$action,$encoding);
+      <... various form stuff ...>
+    print $query->endform;
+
+startform() will return a <FORM> tag with the optional method,
+action and form encoding that you specify.  The defaults are:
+	
+    method: POST
+    action: this script
+    encoding: application/x-www-form-urlencoded
+
+endform() returns the closing </FORM> tag.  
+
+Startform()'s encoding method tells the browser how to package the various
+fields of the form before sending the form to the server.  Two
+values are possible:
+
+=over 4
+
+=item B<application/x-www-form-urlencoded>
+
+This is the older type of encoding used by all browsers prior to
+Netscape 2.0.  It is compatible with many CGI scripts and is
+suitable for short fields containing text data.  For your
+convenience, CGI.pm stores the name of this encoding
+type in B<$CGI::URL_ENCODED>.
+
+=item B<multipart/form-data>
+
+This is the newer type of encoding introduced by Netscape 2.0.
+It is suitable for forms that contain very large fields or that
+are intended for transferring binary data.  Most importantly,
+it enables the "file upload" feature of Netscape 2.0 forms.  For
+your convenience, CGI.pm stores the name of this encoding type
+in B<$CGI::MULTIPART>
+
+Forms that use this type of encoding are not easily interpreted
+by CGI scripts unless they use CGI.pm or another library designed
+to handle them.
+
+=back
+
+For compatibility, the startform() method uses the older form of
+encoding by default.  If you want to use the newer form of encoding
+by default, you can call B<start_multipart_form()> instead of
+B<startform()>.
+
+JAVASCRIPTING: The B<-name> and B<-onSubmit> parameters are provided
+for use with JavaScript.  The -name parameter gives the
+form a name so that it can be identified and manipulated by
+JavaScript functions.  -onSubmit should point to a JavaScript
+function that will be executed just before the form is submitted to your
+server.  You can use this opportunity to check the contents of the form 
+for consistency and completeness.  If you find something wrong, you
+can put up an alert box or maybe fix things up yourself.  You can 
+abort the submission by returning false from this function.  
+
+Usually the bulk of JavaScript functions are defined in a <SCRIPT>
+block in the HTML header and -onSubmit points to one of these function
+call.  See start_html() for details.
+
+=head2 CREATING A TEXT FIELD
+
+    print $query->textfield(-name=>'field_name',
+			    -default=>'starting value',
+			    -size=>50,
+			    -maxlength=>80);
+	-or-
+
+    print $query->textfield('field_name','starting value',50,80);
+
+textfield() will return a text input field.  
+
+=over 4
+
+=item B<Parameters>
+
+=item 1.
+
+The first parameter is the required name for the field (-name).  
+
+=item 2.
+
+The optional second parameter is the default starting value for the field
+contents (-default).  
+
+=item 3.
+
+The optional third parameter is the size of the field in
+      characters (-size).
+
+=item 4.
+
+The optional fourth parameter is the maximum number of characters the
+      field will accept (-maxlength).
+
+=back
+
+As with all these methods, the field will be initialized with its 
+previous contents from earlier invocations of the script.
+When the form is processed, the value of the text field can be
+retrieved with:
+
+       $value = $query->param('foo');
+
+If you want to reset it from its initial value after the script has been
+called once, you can do so like this:
+
+       $query->param('foo',"I'm taking over this value!");
+
+NEW AS OF VERSION 2.15: If you don't want the field to take on its previous
+value, you can force its current value by using the -override (alias -force)
+parameter:
+
+    print $query->textfield(-name=>'field_name',
+			    -default=>'starting value',
+			    -override=>1,
+			    -size=>50,
+			    -maxlength=>80);
+
+JAVASCRIPTING: You can also provide B<-onChange>, B<-onFocus>, B<-onBlur>
+and B<-onSelect> parameters to register JavaScript event handlers.
+The onChange handler will be called whenever the user changes the
+contents of the text field.  You can do text validation if you like.
+onFocus and onBlur are called respectively when the insertion point
+moves into and out of the text field.  onSelect is called when the
+user changes the portion of the text that is selected.
+
+=head2 CREATING A BIG TEXT FIELD
+
+   print $query->textarea(-name=>'foo',
+			  -default=>'starting value',
+			  -rows=>10,
+			  -columns=>50);
+
+	-or
+
+   print $query->textarea('foo','starting value',10,50);
+
+textarea() is just like textfield, but it allows you to specify
+rows and columns for a multiline text entry box.  You can provide
+a starting value for the field, which can be long and contain
+multiple lines.
+
+JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur>
+and B<-onSelect> parameters are recognized.  See textfield().
+
+=head2 CREATING A PASSWORD FIELD
+
+   print $query->password_field(-name=>'secret',
+				-value=>'starting value',
+				-size=>50,
+				-maxlength=>80);
+	-or-
+
+   print $query->password_field('secret','starting value',50,80);
+
+password_field() is identical to textfield(), except that its contents 
+will be starred out on the web page.
+
+JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur>
+and B<-onSelect> parameters are recognized.  See textfield().
+
+=head2 CREATING A FILE UPLOAD FIELD
+
+    print $query->filefield(-name=>'uploaded_file',
+			    -default=>'starting value',
+			    -size=>50,
+			    -maxlength=>80);
+	-or-
+
+    print $query->filefield('uploaded_file','starting value',50,80);
+
+filefield() will return a file upload field for Netscape 2.0 browsers.
+In order to take full advantage of this I<you must use the new 
+multipart encoding scheme> for the form.  You can do this either
+by calling B<startform()> with an encoding type of B<$CGI::MULTIPART>,
+or by calling the new method B<start_multipart_form()> instead of
+vanilla B<startform()>.
+
+=over 4
+
+=item B<Parameters>
+
+=item 1.
+
+The first parameter is the required name for the field (-name).  
+
+=item 2.
+
+The optional second parameter is the starting value for the field contents
+to be used as the default file name (-default).
+
+The beta2 version of Netscape 2.0 currently doesn't pay any attention
+to this field, and so the starting value will always be blank.  Worse,
+the field loses its "sticky" behavior and forgets its previous
+contents.  The starting value field is called for in the HTML
+specification, however, and possibly later versions of Netscape will
+honor it.
+
+=item 3.
+
+The optional third parameter is the size of the field in
+characters (-size).
+
+=item 4.
+
+The optional fourth parameter is the maximum number of characters the
+field will accept (-maxlength).
+
+=back
+
+When the form is processed, you can retrieve the entered filename
+by calling param().
+
+       $filename = $query->param('uploaded_file');
+
+In Netscape Gold, the filename that gets returned is the full local filename
+on the B<remote user's> machine.  If the remote user is on a Unix
+machine, the filename will follow Unix conventions:
+
+	/path/to/the/file
+
+On an MS-DOS/Windows and OS/2 machines, the filename will follow DOS conventions:
+
+	C:\PATH\TO\THE\FILE.MSW
+
+On a Macintosh machine, the filename will follow Mac conventions:
+
+	HD 40:Desktop Folder:Sort Through:Reminders
+
+The filename returned is also a file handle.  You can read the contents
+of the file using standard Perl file reading calls:
+
+	# Read a text file and print it out
+	while (<$filename>) {
+	   print;
+	}
+
+	# Copy a binary file to somewhere safe
+	open (OUTFILE,">>/usr/local/web/users/feedback");
+	while ($bytesread=read($filename,$buffer,1024)) {
+	   print OUTFILE $buffer;
+	}
+
+When a file is uploaded the browser usually sends along some
+information along with it in the format of headers.  The information
+usually includes the MIME content type.  Future browsers may send
+other information as well (such as modification date and size). To
+retrieve this information, call uploadInfo().  It returns a reference to
+an associative array containing all the document headers.
+
+       $filename = $query->param('uploaded_file');
+       $type = $query->uploadInfo($filename)->{'Content-Type'};
+       unless ($type eq 'text/html') {
+	  die "HTML FILES ONLY!";
+       }
+
+If you are using a machine that recognizes "text" and "binary" data
+modes, be sure to understand when and how to use them (see the Camel book).  
+Otherwise you may find that binary files are corrupted during file uploads.
+
+JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur>
+and B<-onSelect> parameters are recognized.  See textfield()
+for details. 
+
+=head2 CREATING A POPUP MENU
+
+   print $query->popup_menu('menu_name',
+			    ['eenie','meenie','minie'],
+			    'meenie');
+
+      -or-
+
+   %labels = ('eenie'=>'your first choice',
+	      'meenie'=>'your second choice',
+	      'minie'=>'your third choice');
+   print $query->popup_menu('menu_name',
+			    ['eenie','meenie','minie'],
+			    'meenie',\%labels);
+
+	-or (named parameter style)-
+
+   print $query->popup_menu(-name=>'menu_name',
+			    -values=>['eenie','meenie','minie'],
+			    -default=>'meenie',
+			    -labels=>\%labels);
+
+popup_menu() creates a menu.
+
+=over 4
+
+=item 1.
+
+The required first argument is the menu's name (-name).
+
+=item 2.
+
+The required second argument (-values) is an array B<reference>
+containing the list of menu items in the menu.  You can pass the
+method an anonymous array, as shown in the example, or a reference to
+a named array, such as "\@foo".
+
+=item 3.
+
+The optional third parameter (-default) is the name of the default
+menu choice.  If not specified, the first item will be the default.
+The values of the previous choice will be maintained across queries.
+
+=item 4.
+
+The optional fourth parameter (-labels) is provided for people who
+want to use different values for the user-visible label inside the
+popup menu nd the value returned to your script.  It's a pointer to an
+associative array relating menu values to user-visible labels.  If you
+leave this parameter blank, the menu values will be displayed by
+default.  (You can also leave a label undefined if you want to).
+
+=back
+
+When the form is processed, the selected value of the popup menu can
+be retrieved using:
+
+      $popup_menu_value = $query->param('menu_name');
+
+JAVASCRIPTING: popup_menu() recognizes the following event handlers:
+B<-onChange>, B<-onFocus>, and B<-onBlur>.  See the textfield()
+section for details on when these handlers are called.
+
+=head2 CREATING A SCROLLING LIST
+
+   print $query->scrolling_list('list_name',
+				['eenie','meenie','minie','moe'],
+				['eenie','moe'],5,'true');
+      -or-
+
+   print $query->scrolling_list('list_name',
+				['eenie','meenie','minie','moe'],
+				['eenie','moe'],5,'true',
+				\%labels);
+
+	-or-
+
+   print $query->scrolling_list(-name=>'list_name',
+				-values=>['eenie','meenie','minie','moe'],
+				-default=>['eenie','moe'],
+				-size=>5,
+				-multiple=>'true',
+				-labels=>\%labels);
+
+scrolling_list() creates a scrolling list.  
+
+=over 4
+
+=item B<Parameters:>
+
+=item 1.
+
+The first and second arguments are the list name (-name) and values
+(-values).  As in the popup menu, the second argument should be an
+array reference.
+
+=item 2.
+
+The optional third argument (-default) can be either a reference to a
+list containing the values to be selected by default, or can be a
+single value to select.  If this argument is missing or undefined,
+then nothing is selected when the list first appears.  In the named
+parameter version, you can use the synonym "-defaults" for this
+parameter.
+
+=item 3.
+
+The optional fourth argument is the size of the list (-size).
+
+=item 4.
+
+The optional fifth argument can be set to true to allow multiple
+simultaneous selections (-multiple).  Otherwise only one selection
+will be allowed at a time.
+
+=item 5.
+
+The optional sixth argument is a pointer to an associative array
+containing long user-visible labels for the list items (-labels).
+If not provided, the values will be displayed.
+
+When this form is processed, all selected list items will be returned as
+a list under the parameter name 'list_name'.  The values of the
+selected items can be retrieved with:
+
+      @selected = $query->param('list_name');
+
+=back
+
+JAVASCRIPTING: scrolling_list() recognizes the following event handlers:
+B<-onChange>, B<-onFocus>, and B<-onBlur>.  See textfield() for
+the description of when these handlers are called.
+
+=head2 CREATING A GROUP OF RELATED CHECKBOXES
+
+   print $query->checkbox_group(-name=>'group_name',
+				-values=>['eenie','meenie','minie','moe'],
+				-default=>['eenie','moe'],
+				-linebreak=>'true',
+				-labels=>\%labels);
+
+   print $query->checkbox_group('group_name',
+				['eenie','meenie','minie','moe'],
+				['eenie','moe'],'true',\%labels);
+
+   HTML3-COMPATIBLE BROWSERS ONLY:
+
+   print $query->checkbox_group(-name=>'group_name',
+				-values=>['eenie','meenie','minie','moe'],
+				-rows=2,-columns=>2);
+    
+
+checkbox_group() creates a list of checkboxes that are related
+by the same name.
+
+=over 4
+
+=item B<Parameters:>
+
+=item 1.
+
+The first and second arguments are the checkbox name and values,
+respectively (-name and -values).  As in the popup menu, the second
+argument should be an array reference.  These values are used for the
+user-readable labels printed next to the checkboxes as well as for the
+values passed to your script in the query string.
+
+=item 2.
+
+The optional third argument (-default) can be either a reference to a
+list containing the values to be checked by default, or can be a
+single value to checked.  If this argument is missing or undefined,
+then nothing is selected when the list first appears.
+
+=item 3.
+
+The optional fourth argument (-linebreak) can be set to true to place
+line breaks between the checkboxes so that they appear as a vertical
+list.  Otherwise, they will be strung together on a horizontal line.
+
+=item 4.
+
+The optional fifth argument is a pointer to an associative array
+relating the checkbox values to the user-visible labels that will
+be printed next to them (-labels).  If not provided, the values will
+be used as the default.
+
+=item 5.
+
+B<HTML3-compatible browsers> (such as Netscape) can take advantage 
+of the optional 
+parameters B<-rows>, and B<-columns>.  These parameters cause
+checkbox_group() to return an HTML3 compatible table containing
+the checkbox group formatted with the specified number of rows
+and columns.  You can provide just the -columns parameter if you
+wish; checkbox_group will calculate the correct number of rows
+for you.
+
+To include row and column headings in the returned table, you
+can use the B<-rowheader> and B<-colheader> parameters.  Both
+of these accept a pointer to an array of headings to use.
+The headings are just decorative.  They don't reorganize the
+interpretation of the checkboxes -- they're still a single named
+unit.
+
+=back
+
+When the form is processed, all checked boxes will be returned as
+a list under the parameter name 'group_name'.  The values of the
+"on" checkboxes can be retrieved with:
+
+      @turned_on = $query->param('group_name');
+
+The value returned by checkbox_group() is actually an array of button
+elements.  You can capture them and use them within tables, lists,
+or in other creative ways:
+
+    @h = $query->checkbox_group(-name=>'group_name',-values=>\@values);
+    &use_in_creative_way(@h);
+
+JAVASCRIPTING: checkbox_group() recognizes the B<-onClick>
+parameter.  This specifies a JavaScript code fragment or
+function call to be executed every time the user clicks on
+any of the buttons in the group.  You can retrieve the identity
+of the particular button clicked on using the "this" variable.
+
+=head2 CREATING A STANDALONE CHECKBOX
+
+    print $query->checkbox(-name=>'checkbox_name',
+			   -checked=>'checked',
+			   -value=>'ON',
+			   -label=>'CLICK ME');
+
+	-or-
+
+    print $query->checkbox('checkbox_name','checked','ON','CLICK ME');
+
+checkbox() is used to create an isolated checkbox that isn't logically
+related to any others.
+
+=over 4
+
+=item B<Parameters:>
+
+=item 1.
+
+The first parameter is the required name for the checkbox (-name).  It
+will also be used for the user-readable label printed next to the
+checkbox.
+
+=item 2.
+
+The optional second parameter (-checked) specifies that the checkbox
+is turned on by default.  Synonyms are -selected and -on.
+
+=item 3.
+
+The optional third parameter (-value) specifies the value of the
+checkbox when it is checked.  If not provided, the word "on" is
+assumed.
+
+=item 4.
+
+The optional fourth parameter (-label) is the user-readable label to
+be attached to the checkbox.  If not provided, the checkbox name is
+used.
+
+=back
+
+The value of the checkbox can be retrieved using:
+
+    $turned_on = $query->param('checkbox_name');
+
+JAVASCRIPTING: checkbox() recognizes the B<-onClick>
+parameter.  See checkbox_group() for further details.
+
+=head2 CREATING A RADIO BUTTON GROUP
+
+   print $query->radio_group(-name=>'group_name',
+			     -values=>['eenie','meenie','minie'],
+			     -default=>'meenie',
+			     -linebreak=>'true',
+			     -labels=>\%labels);
+
+	-or-
+
+   print $query->radio_group('group_name',['eenie','meenie','minie'],
+					  'meenie','true',\%labels);
+
+
+   HTML3-COMPATIBLE BROWSERS ONLY:
+
+   print $query->radio_group(-name=>'group_name',
+			     -values=>['eenie','meenie','minie','moe'],
+			     -rows=2,-columns=>2);
+
+radio_group() creates a set of logically-related radio buttons
+(turning one member of the group on turns the others off)
+
+=over 4
+
+=item B<Parameters:>
+
+=item 1.
+
+The first argument is the name of the group and is required (-name).
+
+=item 2.
+
+The second argument (-values) is the list of values for the radio
+buttons.  The values and the labels that appear on the page are
+identical.  Pass an array I<reference> in the second argument, either
+using an anonymous array, as shown, or by referencing a named array as
+in "\@foo".
+
+=item 3.
+
+The optional third parameter (-default) is the name of the default
+button to turn on. If not specified, the first item will be the
+default.  You can provide a nonexistent button name, such as "-" to
+start up with no buttons selected.
+
+=item 4.
+
+The optional fourth parameter (-linebreak) can be set to 'true' to put
+line breaks between the buttons, creating a vertical list.
+
+=item 5.
+
+The optional fifth parameter (-labels) is a pointer to an associative
+array relating the radio button values to user-visible labels to be
+used in the display.  If not provided, the values themselves are
+displayed.
+
+=item 6.
+
+B<HTML3-compatible browsers> (such as Netscape) can take advantage 
+of the optional 
+parameters B<-rows>, and B<-columns>.  These parameters cause
+radio_group() to return an HTML3 compatible table containing
+the radio group formatted with the specified number of rows
+and columns.  You can provide just the -columns parameter if you
+wish; radio_group will calculate the correct number of rows
+for you.
+
+To include row and column headings in the returned table, you
+can use the B<-rowheader> and B<-colheader> parameters.  Both
+of these accept a pointer to an array of headings to use.
+The headings are just decorative.  They don't reorganize the
+interpetation of the radio buttons -- they're still a single named
+unit.
+
+=back
+
+When the form is processed, the selected radio button can
+be retrieved using:
+
+      $which_radio_button = $query->param('group_name');
+
+The value returned by radio_group() is actually an array of button
+elements.  You can capture them and use them within tables, lists,
+or in other creative ways:
+
+    @h = $query->radio_group(-name=>'group_name',-values=>\@values);
+    &use_in_creative_way(@h);
+
+=head2 CREATING A SUBMIT BUTTON 
+
+   print $query->submit(-name=>'button_name',
+			-value=>'value');
+
+	-or-
+
+   print $query->submit('button_name','value');
+
+submit() will create the query submission button.  Every form
+should have one of these.
+
+=over 4
+
+=item B<Parameters:>
+
+=item 1.
+
+The first argument (-name) is optional.  You can give the button a
+name if you have several submission buttons in your form and you want
+to distinguish between them.  The name will also be used as the
+user-visible label.  Be aware that a few older browsers don't deal with this correctly and
+B<never> send back a value from a button.
+
+=item 2.
+
+The second argument (-value) is also optional.  This gives the button
+a value that will be passed to your script in the query string.
+
+=back
+
+You can figure out which button was pressed by using different
+values for each one:
+
+     $which_one = $query->param('button_name');
+
+JAVASCRIPTING: radio_group() recognizes the B<-onClick>
+parameter.  See checkbox_group() for further details.
+
+=head2 CREATING A RESET BUTTON
+
+   print $query->reset
+
+reset() creates the "reset" button.  Note that it restores the
+form to its value from the last time the script was called, 
+NOT necessarily to the defaults.
+
+=head2 CREATING A DEFAULT BUTTON
+
+   print $query->defaults('button_label')
+
+defaults() creates a button that, when invoked, will cause the
+form to be completely reset to its defaults, wiping out all the
+changes the user ever made.
+
+=head2 CREATING A HIDDEN FIELD
+
+	print $query->hidden(-name=>'hidden_name',
+			     -default=>['value1','value2'...]);
+
+		-or-
+
+	print $query->hidden('hidden_name','value1','value2'...);
+
+hidden() produces a text field that can't be seen by the user.  It
+is useful for passing state variable information from one invocation
+of the script to the next.
+
+=over 4
+
+=item B<Parameters:>
+
+=item 1.
+
+The first argument is required and specifies the name of this
+field (-name).
+
+=item 2.  
+
+The second argument is also required and specifies its value
+(-default).  In the named parameter style of calling, you can provide
+a single value here or a reference to a whole list
+
+=back
+
+Fetch the value of a hidden field this way:
+
+     $hidden_value = $query->param('hidden_name');
+
+Note, that just like all the other form elements, the value of a
+hidden field is "sticky".  If you want to replace a hidden field with
+some other values after the script has been called once you'll have to
+do it manually:
+
+     $query->param('hidden_name','new','values','here');
+
+=head2 CREATING A CLICKABLE IMAGE BUTTON
+
+     print $query->image_button(-name=>'button_name',
+				-src=>'/source/URL',
+				-align=>'MIDDLE');      
+
+	-or-
+
+     print $query->image_button('button_name','/source/URL','MIDDLE');
+
+image_button() produces a clickable image.  When it's clicked on the
+position of the click is returned to your script as "button_name.x"
+and "button_name.y", where "button_name" is the name you've assigned
+to it.
+
+JAVASCRIPTING: image_button() recognizes the B<-onClick>
+parameter.  See checkbox_group() for further details.
+
+=over 4
+
+=item B<Parameters:>
+
+=item 1.
+
+The first argument (-name) is required and specifies the name of this
+field.
+
+=item 2.
+
+The second argument (-src) is also required and specifies the URL
+
+=item 3.
+The third option (-align, optional) is an alignment type, and may be
+TOP, BOTTOM or MIDDLE
+
+=back
+
+Fetch the value of the button this way:
+     $x = $query->param('button_name.x');
+     $y = $query->param('button_name.y');
+
+=head2 CREATING A JAVASCRIPT ACTION BUTTON
+
+     print $query->button(-name=>'button_name',
+			  -value=>'user visible label',
+			  -onClick=>"do_something()");
+
+	-or-
+
+     print $query->button('button_name',"do_something()");
+
+button() produces a button that is compatible with Netscape 2.0's
+JavaScript.  When it's pressed the fragment of JavaScript code
+pointed to by the B<-onClick> parameter will be executed.  On
+non-Netscape browsers this form element will probably not even
+display.
+
+=head1 NETSCAPE COOKIES
+
+Netscape browsers versions 1.1 and higher support a so-called
+"cookie" designed to help maintain state within a browser session.
+CGI.pm has several methods that support cookies.
+
+A cookie is a name=value pair much like the named parameters in a CGI
+query string.  CGI scripts create one or more cookies and send
+them to the browser in the HTTP header.  The browser maintains a list
+of cookies that belong to a particular Web server, and returns them
+to the CGI script during subsequent interactions.
+
+In addition to the required name=value pair, each cookie has several
+optional attributes:
+
+=over 4
+
+=item 1. an expiration time
+
+This is a time/date string (in a special GMT format) that indicates
+when a cookie expires.  The cookie will be saved and returned to your
+script until this expiration date is reached if the user exits
+Netscape and restarts it.  If an expiration date isn't specified, the cookie
+will remain active until the user quits Netscape.
+
+=item 2. a domain
+
+This is a partial or complete domain name for which the cookie is 
+valid.  The browser will return the cookie to any host that matches
+the partial domain name.  For example, if you specify a domain name
+of ".capricorn.com", then Netscape will return the cookie to
+Web servers running on any of the machines "www.capricorn.com", 
+"www2.capricorn.com", "feckless.capricorn.com", etc.  Domain names
+must contain at least two periods to prevent attempts to match
+on top level domains like ".edu".  If no domain is specified, then
+the browser will only return the cookie to servers on the host the
+cookie originated from.
+
+=item 3. a path
+
+If you provide a cookie path attribute, the browser will check it
+against your script's URL before returning the cookie.  For example,
+if you specify the path "/cgi-bin", then the cookie will be returned
+to each of the scripts "/cgi-bin/tally.pl", "/cgi-bin/order.pl",
+and "/cgi-bin/customer_service/complain.pl", but not to the script
+"/cgi-private/site_admin.pl".  By default, path is set to "/", which
+causes the cookie to be sent to any CGI script on your site.
+
+=item 4. a "secure" flag
+
+If the "secure" attribute is set, the cookie will only be sent to your
+script if the CGI request is occurring on a secure channel, such as SSL.
+
+=back
+
+The interface to Netscape cookies is the B<cookie()> method:
+
+    $cookie = $query->cookie(-name=>'sessionID',
+			     -value=>'xyzzy',
+			     -expires=>'+1h',
+			     -path=>'/cgi-bin/database',
+			     -domain=>'.capricorn.org',
+			     -secure=>1);
+    print $query->header(-cookie=>$cookie);
+
+B<cookie()> creates a new cookie.  Its parameters include:
+
+=over 4
+
+=item B<-name>
+
+The name of the cookie (required).  This can be any string at all.
+Although Netscape limits its cookie names to non-whitespace
+alphanumeric characters, CGI.pm removes this restriction by escaping
+and unescaping cookies behind the scenes.
+
+=item B<-value>
+
+The value of the cookie.  This can be any scalar value,
+array reference, or even associative array reference.  For example,
+you can store an entire associative array into a cookie this way:
+
+	$cookie=$query->cookie(-name=>'family information',
+			       -value=>\%childrens_ages);
+
+=item B<-path>
+
+The optional partial path for which this cookie will be valid, as described
+above.
+
+=item B<-domain>
+
+The optional partial domain for which this cookie will be valid, as described
+above.
+
+=item B<-expires>
+
+The optional expiration date for this cookie.  The format is as described 
+in the section on the B<header()> method:
+
+	"+1h"  one hour from now
+
+=item B<-secure>
+
+If set to true, this cookie will only be used within a secure
+SSL session.
+
+=back
+
+The cookie created by cookie() must be incorporated into the HTTP
+header within the string returned by the header() method:
+
+	print $query->header(-cookie=>$my_cookie);
+
+To create multiple cookies, give header() an array reference:
+
+	$cookie1 = $query->cookie(-name=>'riddle_name',
+				  -value=>"The Sphynx's Question");
+	$cookie2 = $query->cookie(-name=>'answers',
+				  -value=>\%answers);
+	print $query->header(-cookie=>[$cookie1,$cookie2]);
+
+To retrieve a cookie, request it by name by calling cookie()
+method without the B<-value> parameter:
+
+	use CGI;
+	$query = new CGI;
+	%answers = $query->cookie(-name=>'answers');
+	# $query->cookie('answers') will work too!
+
+The cookie and CGI namespaces are separate.  If you have a parameter
+named 'answers' and a cookie named 'answers', the values retrieved by
+param() and cookie() are independent of each other.  However, it's
+simple to turn a CGI parameter into a cookie, and vice-versa:
+
+   # turn a CGI parameter into a cookie
+   $c=$q->cookie(-name=>'answers',-value=>[$q->param('answers')]);
+   # vice-versa
+   $q->param(-name=>'answers',-value=>[$q->cookie('answers')]);
+
+See the B<cookie.cgi> example script for some ideas on how to use
+cookies effectively.
+
+B<NOTE:> There appear to be some (undocumented) restrictions on
+Netscape cookies.  In Netscape 2.01, at least, I haven't been able to
+set more than three cookies at a time.  There may also be limits on
+the length of cookies.  If you need to store a lot of information,
+it's probably better to create a unique session ID, store it in a
+cookie, and use the session ID to locate an external file/database
+saved on the server's side of the connection.
+
+=head1 WORKING WITH NETSCAPE FRAMES
+
+It's possible for CGI.pm scripts to write into several browser
+panels and windows using Netscape's frame mechanism.  
+There are three techniques for defining new frames programmatically:
+
+=over 4
+
+=item 1. Create a <Frameset> document
+
+After writing out the HTTP header, instead of creating a standard
+HTML document using the start_html() call, create a <FRAMESET> 
+document that defines the frames on the page.  Specify your script(s)
+(with appropriate parameters) as the SRC for each of the frames.
+
+There is no specific support for creating <FRAMESET> sections 
+in CGI.pm, but the HTML is very simple to write.  See the frame
+documentation in Netscape's home pages for details 
+
+  http://home.netscape.com/assist/net_sites/frames.html
+
+=item 2. Specify the destination for the document in the HTTP header
+
+You may provide a B<-target> parameter to the header() method:
+   
+    print $q->header(-target=>'ResultsWindow');
+
+This will tell Netscape to load the output of your script into the
+frame named "ResultsWindow".  If a frame of that name doesn't
+already exist, Netscape will pop up a new window and load your
+script's document into that.  There are a number of magic names
+that you can use for targets.  See the frame documents on Netscape's
+home pages for details.
+
+=item 3. Specify the destination for the document in the <FORM> tag
+
+You can specify the frame to load in the FORM tag itself.  With
+CGI.pm it looks like this:
+
+    print $q->startform(-target=>'ResultsWindow');
+
+When your script is reinvoked by the form, its output will be loaded
+into the frame named "ResultsWindow".  If one doesn't already exist
+a new window will be created.
+
+=back
+
+The script "frameset.cgi" in the examples directory shows one way to
+create pages in which the fill-out form and the response live in
+side-by-side frames.
+
+=head1 LIMITED SUPPORT FOR CASCADING STYLE SHEETS
+
+CGI.pm has limited support for HTML3's cascading style sheets (css).
+To incorporate a stylesheet into your document, pass the
+start_html() method a B<-style> parameter.  The value of this
+parameter may be a scalar, in which case it is incorporated directly
+into a <STYLE> section, or it may be a hash reference.  In the latter
+case you should provide the hash with one or more of B<-src> or
+B<-code>.  B<-src> points to a URL where an externally-defined
+stylesheet can be found.  B<-code> points to a scalar value to be
+incorporated into a <STYLE> section.  Style definitions in B<-code>
+override similarly-named ones in B<-src>, hence the name "cascading."
+
+To refer to a style within the body of your document, add the
+B<-class> parameter to any HTML element:
+
+    print h1({-class=>'Fancy'},'Welcome to the Party');
+
+Or define styles on the fly with the B<-style> parameter:
+
+    print h1({-style=>'Color: red;'},'Welcome to Hell');
+
+You may also use the new B<span()> element to apply a style to a
+section of text:
+
+    print span({-style=>'Color: red;'},
+	       h1('Welcome to Hell'),
+	       "Where did that handbasket get to?"
+	       );
+
+Note that you must import the ":html3" definitions to have the
+B<span()> method available.  Here's a quick and dirty example of using
+CSS's.  See the CSS specification at
+http://www.w3.org/pub/WWW/TR/Wd-css-1.html for more information.
+
+    use CGI qw/:standard :html3/;
+
+    #here's a stylesheet incorporated directly into the page
+    $newStyle=<<END;
+    <!-- 
+    P.Tip {
+	margin-right: 50pt;
+	margin-left: 50pt;
+        color: red;
+    }
+    P.Alert {
+	font-size: 30pt;
+        font-family: sans-serif;
+      color: red;
+    }
+    -->
+    END
+    print header();
+    print start_html( -title=>'CGI with Style',
+		      -style=>{-src=>'http://www.capricorn.com/style/st1.css',
+		               -code=>$newStyle}
+	             );
+    print h1('CGI with Style'),
+          p({-class=>'Tip'},
+	    "Better read the cascading style sheet spec before playing with this!"),
+          span({-style=>'color: magenta'},
+	       "Look Mom, no hands!",
+	       p(),
+	       "Whooo wee!"
+	       );
+    print end_html;
+
+=head1 DEBUGGING
+
+If you are running the script
+from the command line or in the perl debugger, you can pass the script
+a list of keywords or parameter=value pairs on the command line or 
+from standard input (you don't have to worry about tricking your
+script into reading from environment variables).
+You can pass keywords like this:
+
+    your_script.pl keyword1 keyword2 keyword3
+
+or this:
+
+   your_script.pl keyword1+keyword2+keyword3
+
+or this:
+
+    your_script.pl name1=value1 name2=value2
+
+or this:
+
+    your_script.pl name1=value1&name2=value2
+
+or even as newline-delimited parameters on standard input.
+
+When debugging, you can use quotes and backslashes to escape 
+characters in the familiar shell manner, letting you place
+spaces and other funny characters in your parameter=value
+pairs:
+
+   your_script.pl "name1='I am a long value'" "name2=two\ words"
+
+=head2 DUMPING OUT ALL THE NAME/VALUE PAIRS
+
+The dump() method produces a string consisting of all the query's
+name/value pairs formatted nicely as a nested list.  This is useful
+for debugging purposes:
+
+    print $query->dump
+    
+
+Produces something that looks like:
+
+    <UL>
+    <LI>name1
+	<UL>
+	<LI>value1
+	<LI>value2
+	</UL>
+    <LI>name2
+	<UL>
+	<LI>value1
+	</UL>
+    </UL>
+
+You can pass a value of 'true' to dump() in order to get it to
+print the results out as plain text, suitable for incorporating
+into a <PRE> section.
+
+As a shortcut, as of version 1.56 you can interpolate the entire CGI
+object into a string and it will be replaced with the a nice HTML dump
+shown above:
+
+    $query=new CGI;
+    print "<H2>Current Values</H2> $query\n";
+
+=head1 FETCHING ENVIRONMENT VARIABLES
+
+Some of the more useful environment variables can be fetched
+through this interface.  The methods are as follows:
+
+=over 4
+
+=item B<accept()>
+
+Return a list of MIME types that the remote browser
+accepts. If you give this method a single argument
+corresponding to a MIME type, as in
+$query->accept('text/html'), it will return a
+floating point value corresponding to the browser's
+preference for this type from 0.0 (don't want) to 1.0.
+Glob types (e.g. text/*) in the browser's accept list
+are handled correctly.
+
+=item B<raw_cookie()>
+
+Returns the HTTP_COOKIE variable, an HTTP extension
+implemented by Netscape browsers version 1.1
+and higher.  Cookies have a special format, and this 
+method call just returns the raw form (?cookie dough).
+See cookie() for ways of setting and retrieving
+cooked cookies.
+
+=item B<user_agent()>
+
+Returns the HTTP_USER_AGENT variable.  If you give
+this method a single argument, it will attempt to
+pattern match on it, allowing you to do something
+like $query->user_agent(netscape);
+
+=item B<path_info()>
+
+Returns additional path information from the script URL.
+E.G. fetching /cgi-bin/your_script/additional/stuff will
+result in $query->path_info() returning
+"additional/stuff".
+
+NOTE: The Microsoft Internet Information Server
+is broken with respect to additional path information.  If
+you use the Perl DLL library, the IIS server will attempt to
+execute the additional path information as a Perl script.
+If you use the ordinary file associations mapping, the
+path information will be present in the environment, 
+but incorrect.  The best thing to do is to avoid using additional
+path information in CGI scripts destined for use with IIS.
+
+=item B<path_translated()>
+
+As per path_info() but returns the additional
+path information translated into a physical path, e.g.
+"/usr/local/etc/httpd/htdocs/additional/stuff".
+
+The Microsoft IIS is broken with respect to the translated
+path as well.
+
+=item B<remote_host()>
+
+Returns either the remote host name or IP address.
+if the former is unavailable.
+
+=item B<script_name()>
+Return the script name as a partial URL, for self-refering
+scripts.
+
+=item B<referer()>
+
+Return the URL of the page the browser was viewing
+prior to fetching your script.  Not available for all
+browsers.
+
+=item B<auth_type ()>
+
+Return the authorization/verification method in use for this
+script, if any.
+
+=item B<server_name ()>
+
+Returns the name of the server, usually the machine's host
+name.
+
+=item B<virtual_host ()>
+
+When using virtual hosts, returns the name of the host that
+the browser attempted to contact
+
+=item B<server_software ()>
+
+Returns the server software and version number.
+
+=item B<remote_user ()>
+
+Return the authorization/verification name used for user
+verification, if this script is protected.
+
+=item B<user_name ()>
+
+Attempt to obtain the remote user's name, using a variety
+of different techniques.  This only works with older browsers
+such as Mosaic.  Netscape does not reliably report the user
+name!
+
+=item B<request_method()>
+
+Returns the method used to access your script, usually
+one of 'POST', 'GET' or 'HEAD'.
+
+=back
+
+=head1 CREATING HTML ELEMENTS
+
+In addition to its shortcuts for creating form elements, CGI.pm
+defines general HTML shortcut methods as well.  HTML shortcuts are
+named after a single HTML element and return a fragment of HTML text
+that you can then print or manipulate as you like.
+
+This example shows how to use the HTML methods:
+
+	$q = new CGI;
+	print $q->blockquote(
+			     "Many years ago on the island of",
+			     $q->a({href=>"http://crete.org/"},"Crete"),
+			     "there lived a minotaur named",
+			     $q->strong("Fred."),
+			    ),
+	       $q->hr;
+
+This results in the following HTML code (extra newlines have been
+added for readability):
+
+	<blockquote>
+	Many years ago on the island of
+	<a HREF="http://crete.org/">Crete</a> there lived
+	a minotaur named <strong>Fred.</strong> 
+	</blockquote>
+	<hr>
+
+If you find the syntax for calling the HTML shortcuts awkward, you can
+import them into your namespace and dispense with the object syntax
+completely (see the next section for more details):
+
+	use CGI shortcuts;      # IMPORT HTML SHORTCUTS
+	print blockquote(
+		     "Many years ago on the island of",
+		     a({href=>"http://crete.org/"},"Crete"),
+		     "there lived a minotaur named",
+		     strong("Fred."),
+		     ),
+	       hr;
+
+=head2 PROVIDING ARGUMENTS TO HTML SHORTCUTS
+
+The HTML methods will accept zero, one or multiple arguments.  If you
+provide no arguments, you get a single tag:
+
+	print hr;  
+	#  gives "<hr>"
+
+If you provide one or more string arguments, they are concatenated
+together with spaces and placed between opening and closing tags:
+
+	print h1("Chapter","1"); 
+	# gives "<h1>Chapter 1</h1>"
+
+If the first argument is an associative array reference, then the keys
+and values of the associative array become the HTML tag's attributes:
+
+	print a({href=>'fred.html',target=>'_new'},
+		"Open a new frame");
+	# gives <a href="fred.html",target="_new">Open a new frame</a>
+
+You are free to use CGI.pm-style dashes in front of the attribute
+names if you prefer:
+
+	print img {-src=>'fred.gif',-align=>'LEFT'};
+	# gives <img ALIGN="LEFT" SRC="fred.gif">
+
+=head2 Generating new HTML tags
+
+Since no mere mortal can keep up with Netscape and Microsoft as they
+battle it out for control of HTML, the code that generates HTML tags
+is general and extensible.  You can create new HTML tags freely just
+by referring to them on the import line:
+
+	use CGI shortcuts,winkin,blinkin,nod;
+
+Now, in addition to the standard CGI shortcuts, you've created HTML
+tags named "winkin", "blinkin" and "nod".  You can use them like this:
+
+	print blinkin {color=>'blue',rate=>'fast'},"Yahoo!";
+	# <blinkin COLOR="blue" RATE="fast">Yahoo!</blinkin>
+
+=head1 IMPORTING CGI METHOD CALLS INTO YOUR NAME SPACE
+
+As a convenience, you can import most of the CGI method calls directly
+into your name space.  The syntax for doing this is:
+
+	use CGI <list of methods>;
+
+The listed methods will be imported into the current package; you can
+call them directly without creating a CGI object first.  This example
+shows how to import the B<param()> and B<header()>
+methods, and then use them directly:
+
+	use CGI param,header;
+	print header('text/plain');
+	$zipcode = param('zipcode');
+
+You can import groups of methods by referring to a number of special
+names:
+
+=over 4
+
+=item B<cgi>
+
+Import all CGI-handling methods, such as B<param()>, B<path_info()>
+and the like.
+
+=item B<form>
+
+Import all fill-out form generating methods, such as B<textfield()>.
+
+=item B<html2>
+
+Import all methods that generate HTML 2.0 standard elements.
+
+=item B<html3>
+
+Import all methods that generate HTML 3.0 proposed elements (such as
+<table>, <super> and <sub>).
+
+=item B<netscape>
+
+Import all methods that generate Netscape-specific HTML extensions.
+
+=item B<shortcuts>
+
+Import all HTML-generating shortcuts (i.e. 'html2' + 'html3' +
+'netscape')...
+
+=item B<standard>
+
+Import "standard" features, 'html2', 'form' and 'cgi'.
+
+=item B<all>
+
+Import all the available methods.  For the full list, see the CGI.pm
+code, where the variable %TAGS is defined.
+
+=back
+
+Note that in the interests of execution speed CGI.pm does B<not> use
+the standard L<Exporter> syntax for specifying load symbols.  This may
+change in the future.
+
+If you import any of the state-maintaining CGI or form-generating
+methods, a default CGI object will be created and initialized
+automatically the first time you use any of the methods that require
+one to be present.  This includes B<param()>, B<textfield()>,
+B<submit()> and the like.  (If you need direct access to the CGI
+object, you can find it in the global variable B<$CGI::Q>).  By
+importing CGI.pm methods, you can create visually elegant scripts:
+
+   use CGI standard,html2;
+   print 
+       header,
+       start_html('Simple Script'),
+       h1('Simple Script'),
+       start_form,
+       "What's your name? ",textfield('name'),p,
+       "What's the combination?",
+       checkbox_group(-name=>'words',
+		      -values=>['eenie','meenie','minie','moe'],
+		      -defaults=>['eenie','moe']),p,
+       "What's your favorite color?",
+       popup_menu(-name=>'color',
+		  -values=>['red','green','blue','chartreuse']),p,
+       submit,
+       end_form,
+       hr,"\n";
+
+    if (param) {
+       print 
+	   "Your name is ",em(param('name')),p,
+	   "The keywords are: ",em(join(", ",param('words'))),p,
+	   "Your favorite color is ",em(param('color')),".\n";
+    }
+    print end_html;
+
+=head1 USING NPH SCRIPTS
+
+NPH, or "no-parsed-header", scripts bypass the server completely by
+sending the complete HTTP header directly to the browser.  This has
+slight performance benefits, but is of most use for taking advantage
+of HTTP extensions that are not directly supported by your server,
+such as server push and PICS headers.
+
+Servers use a variety of conventions for designating CGI scripts as
+NPH.  Many Unix servers look at the beginning of the script's name for
+the prefix "nph-".  The Macintosh WebSTAR server and Microsoft's
+Internet Information Server, in contrast, try to decide whether a
+program is an NPH script by examining the first line of script output.
+
+
+CGI.pm supports NPH scripts with a special NPH mode.  When in this
+mode, CGI.pm will output the necessary extra header information when
+the header() and redirect() methods are
+called.
+
+The Microsoft Internet Information Server requires NPH mode.  As of version
+2.30, CGI.pm will automatically detect when the script is running under IIS
+and put itself into this mode.  You do not need to do this manually, although
+it won't hurt anything if you do.
+
+There are a number of ways to put CGI.pm into NPH mode:
+
+=over 4
+
+=item In the B<use> statement
+Simply add ":nph" to the list of symbols to be imported into your script:
+
+      use CGI qw(:standard :nph)
+
+=item By calling the B<nph()> method:
+
+Call B<nph()> with a non-zero parameter at any point after using CGI.pm in your program.
+
+      CGI->nph(1)
+
+=item By using B<-nph> parameters in the B<header()> and B<redirect()>  statements:
+
+      print $q->header(-nph=&gt;1);
+
+=back
+
+=head1 AUTHOR INFORMATION
+
+Copyright 1995,1996, Lincoln D. Stein.  All rights reserved.  It may
+be used and modified freely, but I do request that this copyright
+notice remain attached to the file.  You may modify this module as you
+wish, but if you redistribute a modified version, please attach a note
+listing the modifications you have made.
+
+Address bug reports and comments to:
+lstein@genome.wi.mit.edu
+
+=head1 CREDITS
+
+Thanks very much to:
+
+=over 4
+
+=item Matt Heffron (heffron@falstaff.css.beckman.com)
+
+=item James Taylor (james.taylor@srs.gov)
+
+=item Scott Anguish <sanguish@digifix.com>
+
+=item Mike Jewell (mlj3u@virginia.edu)
+
+=item Timothy Shimmin (tes@kbs.citri.edu.au)
+
+=item Joergen Haegg (jh@axis.se)
+
+=item Laurent Delfosse (delfosse@csgrad1.cs.wvu.edu)
+
+=item Richard Resnick (applepi1@aol.com)
+
+=item Craig Bishop (csb@barwonwater.vic.gov.au)
+
+=item Tony Curtis (tc@vcpc.univie.ac.at)
+
+=item Tim Bunce (Tim.Bunce@ig.co.uk)
+
+=item Tom Christiansen (tchrist@convex.com)
+
+=item Andreas Koenig (k@franz.ww.TU-Berlin.DE)
+
+=item Tim MacKenzie (Tim.MacKenzie@fulcrum.com.au)
+
+=item Kevin B. Hendricks (kbhend@dogwood.tyler.wm.edu)
+
+=item Stephen Dahmen (joyfire@inxpress.net)
+
+=item Ed Jordan (ed@fidalgo.net)
+
+=item David Alan Pisoni (david@cnation.com)
+
+=item ...and many many more...
+
+for suggestions and bug fixes.
+
+=back
+
+=head1 A COMPLETE EXAMPLE OF A SIMPLE FORM-BASED SCRIPT
+
+
+	#!/usr/local/bin/perl
+     
+	use CGI;
+ 
+	$query = new CGI;
+
+	print $query->header;
+	print $query->start_html("Example CGI.pm Form");
+	print "<H1> Example CGI.pm Form</H1>\n";
+	&print_prompt($query);
+	&do_work($query);
+	&print_tail;
+	print $query->end_html;
+ 
+	sub print_prompt {
+	   my($query) = @_;
+ 
+	   print $query->startform;
+	   print "<EM>What's your name?</EM><BR>";
+	   print $query->textfield('name');
+	   print $query->checkbox('Not my real name');
+ 
+	   print "<P><EM>Where can you find English Sparrows?</EM><BR>";
+	   print $query->checkbox_group(
+				 -name=>'Sparrow locations',
+				 -values=>[England,France,Spain,Asia,Hoboken],
+				 -linebreak=>'yes',
+				 -defaults=>[England,Asia]);
+ 
+	   print "<P><EM>How far can they fly?</EM><BR>",
+		$query->radio_group(
+			-name=>'how far',
+			-values=>['10 ft','1 mile','10 miles','real far'],
+			-default=>'1 mile');
+ 
+	   print "<P><EM>What's your favorite color?</EM>  ";
+	   print $query->popup_menu(-name=>'Color',
+				    -values=>['black','brown','red','yellow'],
+				    -default=>'red');
+ 
+	   print $query->hidden('Reference','Monty Python and the Holy Grail');
+ 
+	   print "<P><EM>What have you got there?</EM><BR>";
+	   print $query->scrolling_list(
+			 -name=>'possessions',
+			 -values=>['A Coconut','A Grail','An Icon',
+				   'A Sword','A Ticket'],
+			 -size=>5,
+			 -multiple=>'true');
+ 
+	   print "<P><EM>Any parting comments?</EM><BR>";
+	   print $query->textarea(-name=>'Comments',
+				  -rows=>10,
+				  -columns=>50);
+ 
+	   print "<P>",$query->reset;
+	   print $query->submit('Action','Shout');
+	   print $query->submit('Action','Scream');
+	   print $query->endform;
+	   print "<HR>\n";
+	}
+ 
+	sub do_work {
+	   my($query) = @_;
+	   my(@values,$key);
+
+	   print "<H2>Here are the current settings in this form</H2>";
+
+	   foreach $key ($query->param) {
+	      print "<STRONG>$key</STRONG> -> ";
+	      @values = $query->param($key);
+	      print join(", ",@values),"<BR>\n";
+	  }
+	}
+ 
+	sub print_tail {
+	   print <<END;
+	<HR>
+	<ADDRESS>Lincoln D. Stein</ADDRESS><BR>
+	<A HREF="/">Home Page</A>
+	END
+	}
+
+=head1 BUGS
+
+This module has grown large and monolithic.  Furthermore it's doing many
+things, such as handling URLs, parsing CGI input, writing HTML, etc., that
+are also done in the LWP modules. It should be discarded in favor of
+the CGI::* modules, but somehow I continue to work on it.
+
+Note that the code is truly contorted in order to avoid spurious
+warnings when programs are run with the B<-w> switch.
+
+=head1 SEE ALSO
+
+L<CGI::Carp>, L<URI::URL>, L<CGI::Request>, L<CGI::MiniSvr>,
+L<CGI::Base>, L<CGI::Form>, L<CGI::Apache>, L<CGI::Switch>,
+L<CGI::Push>, L<CGI::Fast>
+
+=cut
+
diff --git a/lib/CGI/Apache.pm b/lib/CGI/Apache.pm
new file mode 100644
index 0000000000..61b55f5205
--- /dev/null
+++ b/lib/CGI/Apache.pm
@@ -0,0 +1,103 @@
+package CGI::Apache;
+use Apache ();
+use vars qw(@ISA $VERSION);
+require CGI;
+@ISA = qw(CGI);
+
+$VERSION = (qw$Revision: 1.01 $)[1];
+$CGI::DefaultClass = 'CGI::Apache';
+$CGI::Apache::AutoloadClass = 'CGI';
+
+sub import {
+    my $self = shift;
+    my ($callpack, $callfile, $callline) = caller;
+    ${"${callpack}::AutoloadClass"} = 'CGI';
+}
+
+sub new {
+    my($class) = shift;
+    my($r) = Apache->request;
+    %ENV = $r->cgi_env unless defined $ENV{GATEWAY_INTERFACE}; #PerlSetupEnv On 
+    my $self = $class->SUPER::new(@_);
+    $self->{'.req'} = $r;
+    $self;
+}
+
+sub header {
+    my ($self,@rest) = CGI::self_or_default(@_);
+    my $r = $self->{'.req'};
+    $r->basic_http_header;
+    return CGI::header($self,@rest);
+}		     
+
+sub print {
+    my($self,@rest) = CGI::self_or_default(@_);
+    $self->{'.req'}->print(@rest);
+}
+
+sub read_from_client {
+    my($self, $fh, $buff, $len, $offset) = @_;
+    my $r = $self->{'.req'} || Apache->request;
+    return $r->read($$buff, $len, $offset);
+}
+
+sub new_MultipartBuffer {
+    my $self = shift;
+    my $new = CGI::Apache::MultipartBuffer->new($self, @_); 
+    $new->{'.req'} = $self->{'.req'} || Apache->request;
+    return $new;
+}
+
+package CGI::Apache::MultipartBuffer;
+use vars qw(@ISA);
+@ISA = qw(MultipartBuffer);
+
+$CGI::Apache::MultipartBuffer::AutoloadClass = 'MultipartBuffer';
+*CGI::Apache::MultipartBuffer::read_from_client = 
+    \&CGI::Apache::read_from_client;
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+CGI::Apache - Make things work with CGI.pm against Perl-Apache API
+
+=head1 SYNOPSIS
+
+ require CGI::Apache;
+
+ my $q = new Apache::CGI;
+
+ $q->print($q->header);
+
+ #do things just like you do with CGI.pm
+
+=head1 DESCRIPTION
+
+When using the Perl-Apache API, your applications are faster, but the
+enviroment is different than CGI.
+This module attempts to set-up that environment as best it can.
+
+=head1 NOTE 1
+
+This module used to be named Apache::CGI.  Sorry for the confusion.
+
+=head1 NOTE 2
+
+If you're going to inherit from this class, make sure to "use" it
+after your package declaration rather than "require" it.  This is
+because CGI.pm does a little magic during the import() step in order
+to make autoloading work correctly.
+
+=head1 SEE ALSO
+
+perl(1), Apache(3), CGI(3)
+
+=head1 AUTHOR
+
+Doug MacEachern E<lt>dougm@osf.orgE<gt>, hacked over by Andreas König E<lt>a.koenig@mind.deE<gt>, modified by Lincoln Stein <lt>lstein@genome.wi.mit.edu<gt>
+
+=cut
diff --git a/lib/CGI/Carp.pm b/lib/CGI/Carp.pm
new file mode 100644
index 0000000000..4cd79467fd
--- /dev/null
+++ b/lib/CGI/Carp.pm
@@ -0,0 +1,242 @@
+package CGI::Carp;
+
+=head1 NAME
+
+B<CGI::Carp> - CGI routines for writing to the HTTPD (or other) error log
+
+=head1 SYNOPSIS
+
+    use CGI::Carp;
+
+    croak "We're outta here!";
+    confess "It was my fault: $!";
+    carp "It was your fault!";   
+    warn "I'm confused";
+    die  "I'm dying.\n";
+
+=head1 DESCRIPTION
+
+CGI scripts have a nasty habit of leaving warning messages in the error
+logs that are neither time stamped nor fully identified.  Tracking down
+the script that caused the error is a pain.  This fixes that.  Replace
+the usual
+
+    use Carp;
+
+with
+
+    use CGI::Carp
+
+And the standard warn(), die (), croak(), confess() and carp() calls
+will automagically be replaced with functions that write out nicely
+time-stamped messages to the HTTP server error log.
+
+For example:
+
+   [Fri Nov 17 21:40:43 1995] test.pl: I'm confused at test.pl line 3.
+   [Fri Nov 17 21:40:43 1995] test.pl: Got an error message: Permission denied.
+   [Fri Nov 17 21:40:43 1995] test.pl: I'm dying.
+
+=head1 REDIRECTING ERROR MESSAGES
+
+By default, error messages are sent to STDERR.  Most HTTPD servers
+direct STDERR to the server's error log.  Some applications may wish
+to keep private error logs, distinct from the server's error log, or
+they may wish to direct error messages to STDOUT so that the browser
+will receive them.
+
+The C<carpout()> function is provided for this purpose.  Since
+carpout() is not exported by default, you must import it explicitly by
+saying
+
+   use CGI::Carp qw(carpout);
+
+The carpout() function requires one argument, which should be a
+reference to an open filehandle for writing errors.  It should be
+called in a C<BEGIN> block at the top of the CGI application so that
+compiler errors will be caught.  Example:
+
+   BEGIN {
+     use CGI::Carp qw(carpout);
+     open(LOG, ">>/usr/local/cgi-logs/mycgi-log") or
+       die("Unable to open mycgi-log: $!\n");
+     carpout(LOG);
+   }
+
+carpout() does not handle file locking on the log for you at this point.
+
+The real STDERR is not closed -- it is moved to SAVEERR.  Some
+servers, when dealing with CGI scripts, close their connection to the
+browser when the script closes STDOUT and STDERR.  SAVEERR is used to
+prevent this from happening prematurely.
+
+You can pass filehandles to carpout() in a variety of ways.  The "correct"
+way according to Tom Christiansen is to pass a reference to a filehandle 
+GLOB:
+
+    carpout(\*LOG);
+
+This looks weird to mere mortals however, so the following syntaxes are
+accepted as well:
+
+    carpout(LOG);
+    carpout(main::LOG);
+    carpout(main'LOG);
+    carpout(\LOG);
+    carpout(\'main::LOG');
+
+    ... and so on
+
+Use of carpout() is not great for performance, so it is recommended
+for debugging purposes or for moderate-use applications.  A future
+version of this module may delay redirecting STDERR until one of the
+CGI::Carp methods is called to prevent the performance hit.
+
+=head1 MAKING PERL ERRORS APPEAR IN THE BROWSER WINDOW
+
+If you want to send fatal (die, confess) errors to the browser, ask to 
+import the special "fatalsToBrowser" subroutine:
+
+    use CGI::Carp qw(fatalsToBrowser);
+    die "Bad error here";
+
+Fatal errors will now be echoed to the browser as well as to the log.  CGI::Carp
+arranges to send a minimal HTTP header to the browser so that even errors that
+occur in the early compile phase will be seen.
+Nonfatal errors will still be directed to the log file only (unless redirected
+with carpout).
+
+=head1 CHANGE LOG
+
+1.05 carpout() added and minor corrections by Marc Hedlund
+     <hedlund@best.com> on 11/26/95.
+
+1.06 fatalsToBrowser() no longer aborts for fatal errors within
+     eval() statements.
+
+=head1 AUTHORS
+
+Lincoln D. Stein <lstein@genome.wi.mit.edu>.  Feel free to redistribute
+this under the Perl Artistic License.
+
+
+=head1 SEE ALSO
+
+Carp, CGI::Base, CGI::BasePlus, CGI::Request, CGI::MiniSvr, CGI::Form,
+CGI::Response
+
+=cut
+
+require 5.000;
+use Exporter;
+use Carp;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(confess croak carp);
+@EXPORT_OK = qw(carpout fatalsToBrowser);
+
+$main::SIG{__WARN__}=\&CGI::Carp::warn;
+$main::SIG{__DIE__}=\&CGI::Carp::die;
+$CGI::Carp::VERSION = '1.06';
+
+# fancy import routine detects and handles 'errorWrap' specially.
+sub import {
+    my $pkg = shift;
+    my(%routines);
+    grep($routines{$_}++,@_);
+    $WRAP++ if $routines{'fatalsToBrowser'};
+    my($oldlevel) = $Exporter::ExportLevel;
+    $Exporter::ExportLevel = 1;
+    Exporter::import($pkg,keys %routines);
+    $Exporter::ExportLevel = $oldlevel;
+}
+
+# These are the originals
+sub realwarn { warn(@_); }
+sub realdie { die(@_); }
+
+sub id {
+    my $level = shift;
+    my($pack,$file,$line,$sub) = caller($level);
+    my($id) = $file=~m|([^/]+)$|;
+    return ($file,$line,$id);
+}
+
+sub stamp {
+    my $time = scalar(localtime);
+    my $frame = 0;
+    my ($id,$pack,$file);
+    do {
+	$id = $file;
+	($pack,$file) = caller($frame++);
+    } until !$file;
+    ($id) = $id=~m|([^/]+)$|;
+    return "[$time] $id: ";
+}
+
+sub warn {
+    my $message = shift;
+    my($file,$line,$id) = id(1);
+    $message .= " at $file line $line.\n" unless $message=~/\n$/;
+    my $stamp = stamp;
+    $message=~s/^/$stamp/gm;
+    realwarn $message;
+}
+
+sub die {
+    my $message = shift;
+    my $time = scalar(localtime);
+    my($file,$line,$id) = id(1);
+    return undef if $file=~/^\(eval/;
+    $message .= " at $file line $line.\n" unless $message=~/\n$/;
+    &fatalsToBrowser($message) if $WRAP;
+    my $stamp = stamp;
+    $message=~s/^/$stamp/gm;
+    realdie $message;
+}
+
+# Avoid generating "subroutine redefined" warnings with the following
+# hack:
+{
+    local $^W=0;
+    eval <<EOF;
+sub confess { CGI::Carp::die Carp::longmess \@_; }
+sub croak { CGI::Carp::die Carp::shortmess \@_; }
+sub carp { CGI::Carp::warn Carp::shortmess \@_; }
+EOF
+    ;
+}
+
+# We have to be ready to accept a filehandle as a reference
+# or a string.
+sub carpout {
+    my($in) = @_;
+    $in = $$in if ref($in); # compatability with Marc's method;
+    my($no) = fileno($in);
+    unless (defined($no)) {
+	my($package) = caller;
+	my($handle) = $in=~/[':]/ ? $in : "$package\:\:$in"; 
+	$no = fileno($handle);
+    }
+    die "Invalid filehandle $in\n" unless $no;
+    
+    open(SAVEERR, ">&STDERR");
+    open(STDERR, ">&$no") or 
+	( print SAVEERR "Unable to redirect STDERR: $!\n" and exit(1) );
+}
+
+# headers
+sub fatalsToBrowser {
+    my($msg) = @_;
+    $msg=~s/>/&gt;/g;
+    $msg=~s/</&lt;/g;
+    print STDOUT "Content-type: text/html\n\n";
+    print STDOUT <<END;
+<H1>Software error:</H1>
+<CODE>$msg</CODE>
+<P>
+Please send mail to this site's webmaster for help.
+END
+}
+
+1;
diff --git a/lib/CGI/Fast.pm b/lib/CGI/Fast.pm
new file mode 100644
index 0000000000..03b54072c9
--- /dev/null
+++ b/lib/CGI/Fast.pm
@@ -0,0 +1,173 @@
+package CGI::Fast;
+
+# See the bottom of this file for the POD documentation.  Search for the
+# string '=head'.
+
+# You can run this file through either pod2man or pod2html to produce pretty
+# documentation in manual or html file format (these utilities are part of the
+# Perl 5 distribution).
+
+# Copyright 1995,1996, Lincoln D. Stein.  All rights reserved.
+# It may be used and modified freely, but I do request that this copyright
+# notice remain attached to the file.  You may modify this module as you 
+# wish, but if you redistribute a modified version, please attach a note
+# listing the modifications you have made.
+
+# The most recent version and complete docs are available at:
+#   http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
+#   ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
+$CGI::Fast::VERSION='1.00a';
+
+use CGI;
+use FCGI;
+@ISA = ('CGI');
+
+# workaround for known bug in libfcgi
+while (($ignore) = each %ENV) { }
+
+# override the initialization behavior so that
+# state is NOT maintained between invocations 
+sub save_request {
+    # no-op
+}
+
+# New is slightly different in that it calls FCGI's
+# accept() method.
+sub new {
+    return undef unless FCGI::accept() >= 0;
+    my($self,@param) = @_;
+    return $CGI::Q = $self->SUPER::new(@param);
+}
+
+1;
+
+=head1 NAME
+
+CGI::Fast - CGI Interface for Fast CGI
+
+=head1 SYNOPSIS
+
+    use CGI::Fast qw(:standard);
+    $COUNTER = 0;
+    while (new CGI::Fast) {
+	print header;
+	print start_html("Fast CGI Rocks");
+	print
+	    h1("Fast CGI Rocks"),
+	    "Invocation number ",b($COUNTER++),
+            " PID ",b($$),".",
+	    hr;
+        print end_html;
+    }
+
+=head1 DESCRIPTION
+
+CGI::Fast is a subclass of the CGI object created by
+CGI.pm.  It is specialized to work well with the Open Market
+FastCGI standard, which greatly speeds up CGI scripts by
+turning them into persistently running server processes.  Scripts
+that perform time-consuming initialization processes, such as
+loading large modules or opening persistent database connections,
+will see large performance improvements.
+
+=head1 OTHER PIECES OF THE PUZZLE
+
+In order to use CGI::Fast you'll need a FastCGI-enabled Web
+server.  Open Market's server is FastCGI-savvy.  There are also
+freely redistributable FastCGI modules for NCSA httpd 1.5 and Apache.
+FastCGI-enabling modules for Microsoft Internet Information Server and
+Netscape Communications Server have been announced.
+
+In addition, you'll need a version of the Perl interpreter that has
+been linked with the FastCGI I/O library.  Precompiled binaries are
+available for several platforms, including DEC Alpha, HP-UX and 
+SPARC/Solaris, or you can rebuild Perl from source with patches
+provided in the FastCGI developer's kit.  The FastCGI Perl interpreter
+can be used in place of your normal Perl without ill consequences.
+
+You can find FastCGI modules for Apache and NCSA httpd, precompiled
+Perl interpreters, and the FastCGI developer's kit all at URL:
+
+  http://www.fastcgi.com/
+
+=head1 WRITING FASTCGI PERL SCRIPTS
+
+FastCGI scripts are persistent: one or more copies of the script 
+are started up when the server initializes, and stay around until
+the server exits or they die a natural death.  After performing
+whatever one-time initialization it needs, the script enters a 
+loop waiting for incoming connections, processing the request, and
+waiting some more.
+
+A typical FastCGI script will look like this:
+
+    #!/usr/local/bin/perl    # must be a FastCGI version of perl!
+    use CGI::Fast;
+    &do_some_initialization();
+    while ($q = new CGI::Fast) {
+	&process_request($q);
+    }
+
+Each time there's a new request, CGI::Fast returns a
+CGI object to your loop.  The rest of the time your script
+waits in the call to new().  When the server requests that
+your script be terminated, new() will return undef.  You can
+of course exit earlier if you choose.  A new version of the
+script will be respawned to take its place (this may be
+necessary in order to avoid Perl memory leaks in long-running
+scripts).
+
+CGI.pm's default CGI object mode also works.  Just modify the loop
+this way:
+
+    while (new CGI::Fast) {
+	&process_request;
+    }
+
+Calls to header(), start_form(), etc. will all operate on the
+current request.
+
+=head1 INSTALLING FASTCGI SCRIPTS
+
+See the FastCGI developer's kit documentation for full details.  On
+the Apache server, the following line must be added to srm.conf:
+
+    AddType application/x-httpd-fcgi .fcgi
+
+FastCGI scripts must end in the extension .fcgi.  For each script you
+install, you must add something like the following to srm.conf:
+
+   AppClass /usr/etc/httpd/fcgi-bin/file_upload.fcgi -processes 2
+
+This instructs Apache to launch two copies of file_upload.fcgi at 
+startup time.
+
+=head1 USING FASTCGI SCRIPTS AS CGI SCRIPTS
+
+Any script that works correctly as a FastCGI script will also work
+correctly when installed as a vanilla CGI script.  However it will
+not see any performance benefit.
+
+=head1 CAVEATS
+
+I haven't tested this very much.
+
+=head1 AUTHOR INFORMATION
+
+be used and modified freely, but I do request that this copyright
+notice remain attached to the file.  You may modify this module as you
+wish, but if you redistribute a modified version, please attach a note
+listing the modifications you have made.
+
+Address bug reports and comments to:
+lstein@genome.wi.mit.edu
+
+=head1 BUGS
+
+This section intentionally left blank.
+
+=head1 SEE ALSO
+
+L<CGI::Carp>, L<CGI>
+ 
+=cut
diff --git a/lib/CGI/Push.pm b/lib/CGI/Push.pm
new file mode 100644
index 0000000000..11421a7f23
--- /dev/null
+++ b/lib/CGI/Push.pm
@@ -0,0 +1,239 @@
+package CGI::Push;
+
+# See the bottom of this file for the POD documentation.  Search for the
+# string '=head'.
+
+# You can run this file through either pod2man or pod2html to produce pretty
+# documentation in manual or html file format (these utilities are part of the
+# Perl 5 distribution).
+
+# Copyright 1995,1996, Lincoln D. Stein.  All rights reserved.
+# It may be used and modified freely, but I do request that this copyright
+# notice remain attached to the file.  You may modify this module as you 
+# wish, but if you redistribute a modified version, please attach a note
+# listing the modifications you have made.
+
+# The most recent version and complete docs are available at:
+#   http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
+#   ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
+
+$CGI::Push::VERSION='1.00';
+use CGI;
+@ISA = ('CGI');
+
+# add do_push() to exported tags
+push(@{$CGI::EXPORT_TAGS{':standard'}},'do_push');
+
+sub do_push {
+    my ($self,@p) = CGI::self_or_CGI(@_);
+
+    # unbuffer output
+    $| = 1;
+    srand;
+    my ($random) = rand()*1E16;
+    my ($boundary) = "----------------------------------$random";
+
+    my (@header);
+    my ($type,$callback,$delay,$last_page,$cookie,$target,$expires,@other) =
+	$self->rearrange([TYPE,NEXT_PAGE,DELAY,LAST_PAGE,[COOKIE,COOKIES],TARGET,EXPIRES],@p);
+    $type = 'text/html' unless $type;
+    $callback = \&simple_counter unless $callback && ref($callback) eq 'CODE';
+    $delay = 1 unless defined($delay);
+
+    my(@o);
+    foreach (@other) { push(@o,split("=")); }
+    push(@o,'-Target'=>$target) if defined($target);
+    push(@o,'-Cookie'=>$cookie) if defined($cookie);
+    push(@o,'-Type'=>"multipart/x-mixed-replace; boundary=$boundary");
+    push(@o,'-Server'=>"CGI.pm Push Module");
+    push(@o,'-Status'=>'200 OK');
+    push(@o,'-nph'=>1);
+    print $self->header(@o);
+    print "${boundary}$CGI::CRLF";
+    
+    # now we enter a little loop
+    my @contents;
+    while (1) {
+	last unless (@contents = &$callback($self,++$COUNTER)) && defined($contents[0]);
+	print "Content-type: ${type}$CGI::CRLF$CGI::CRLF";
+	print @contents,"$CGI::CRLF";
+	print "${boundary}$CGI::CRLF";
+	do_sleep($delay) if $delay;
+    }
+    print "Content-type: ${type}$CGI::CRLF$CGI::CRLF",
+          &$last_page($self,++$COUNTER),
+          "$CGI::CRLF${boundary}$CGI::CRLF"
+	      if $last_page && ref($last_page) eq 'CODE';
+}
+
+sub simple_counter {
+    my ($self,$count) = @_;
+    return (
+	    CGI->start_html("CGI::Push Default Counter"),
+	    CGI->h1("CGI::Push Default Counter"),
+	    "This page has been updated ",CGI->strong($count)," times.",
+	    CGI->hr(),
+	    CGI->a({'-href'=>'http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html'},'CGI.pm home page'),
+	    CGI->end_html
+	    );
+}
+
+sub do_sleep {
+    my $delay = shift;
+    if ( ($delay >= 1) && ($delay!~/\./) ){
+	sleep($delay);
+    } else {
+	select(undef,undef,undef,$delay);
+    }
+}
+
+1;
+
+=head1 NAME
+
+CGI::Push - Simple Interface to Server Push
+
+=head1 SYNOPSIS
+
+    use CGI::Push qw(:standard);
+
+    do_push(-next_page=>\&next_page,
+            -last_page=>\&last_page,
+            -delay=>0.5);
+
+    sub next_page {
+        my($q,$counter) = @_;
+        return undef if $counter >= 10;
+        return start_html('Test'),
+  	       h1('Visible'),"\n",
+               "This page has been called ", strong($counter)," times",
+               end_html();
+      }
+
+     sub last_page {
+	 my($q,$counter) = @_;
+         return start_html('Done'),
+                h1('Finished'),
+                strong($counter),' iterations.',
+                end_html;
+     }
+
+=head1 DESCRIPTION
+
+CGI::Push is a subclass of the CGI object created by CGI.pm.  It is
+specialized for server push operations, which allow you to create
+animated pages whose content changes at regular intervals.
+
+You provide CGI::Push with a pointer to a subroutine that will draw
+one page.  Every time your subroutine is called, it generates a new
+page.  The contents of the page will be transmitted to the browser
+in such a way that it will replace what was there beforehand.  The
+technique will work with HTML pages as well as with graphics files, 
+allowing you to create animated GIFs.
+
+=head1 USING CGI::Push
+
+CGI::Push adds one new method to the standard CGI suite, do_push().
+When you call this method, you pass it a reference to a subroutine
+that is responsible for drawing each new page, an interval delay, and
+an optional subroutine for drawing the last page.  Other optional
+parameters include most of those recognized by the CGI header()
+method.
+
+You may call do_push() in the object oriented manner or not, as you
+prefer:
+
+    use CGI::Push;
+    $q = new CGI::Push;
+    $q->do_push(-next_page=>\&draw_a_page);
+
+        -or-
+ 
+    use CGI::Push qw(:standard);
+    do_push(-next_page=>\&draw_a_page);
+
+Parameters are as follows:
+
+=over 4
+    
+=item -next_page
+
+    do_push(-next_page=>\&my_draw_routine);
+
+This required parameter points to a reference to a subroutine responsible for
+drawing each new page.  The subroutine should expect two parameters
+consisting of the CGI object and a counter indicating the number
+of times the subroutine has been called.  It should return the
+contents of the page as an B<array> of one or more items to print.  
+It can return a false value (or an empty array) in order to abort the
+redrawing loop and print out the final page (if any)
+
+    sub my_draw_routine {
+        my($q,$counter) = @_;
+        return undef if $counter > 100;
+        return start_html('testing'),
+               h1('testing'),
+	       "This page called $counter times";
+    }
+
+=item -last_page
+
+This optional parameter points to a reference to the subroutine
+responsible for drawing the last page of the series.  It is called
+after the -next_page routine returns a false value.  The subroutine
+itself should have exactly the same calling conventions as the
+-next_page routine.
+
+=item -type
+
+This optional parameter indicates the content type of each page.  It
+defaults to "text/html".  Currently, server push of heterogeneous
+document types is not supported.
+
+=item -delay
+
+This indicates the delay, in seconds, between frames.  Smaller delays
+refresh the page faster.  Fractional values are allowed.
+
+B<If not specified, -delay will default to 1 second>
+
+=item -cookie, -target, -expires
+
+These have the same meaning as the like-named parameters in
+CGI::header().
+
+=back
+
+=head1 INSTALLING CGI::Push SCRIPTS
+
+Server push scripts B<must> be installed as no-parsed-header (NPH)
+scripts in order to work correctly.  On Unix systems, this is most
+often accomplished by prefixing the script's name with "nph-".  
+Recognition of NPH scripts happens automatically with WebSTAR and 
+Microsoft IIS.  Users of other servers should see their documentation
+for help.
+
+=head1 CAVEATS
+
+This is a new module.  It hasn't been extensively tested.
+
+=head1 AUTHOR INFORMATION
+
+be used and modified freely, but I do request that this copyright
+notice remain attached to the file.  You may modify this module as you
+wish, but if you redistribute a modified version, please attach a note
+listing the modifications you have made.
+
+Address bug reports and comments to:
+lstein@genome.wi.mit.edu
+
+=head1 BUGS
+
+This section intentionally left blank.
+
+=head1 SEE ALSO
+
+L<CGI::Carp>, L<CGI>
+ 
+=cut
+
diff --git a/lib/CGI/Switch.pm b/lib/CGI/Switch.pm
new file mode 100644
index 0000000000..420fff7643
--- /dev/null
+++ b/lib/CGI/Switch.pm
@@ -0,0 +1,78 @@
+package CGI::Switch;
+use Carp;
+use strict;
+use vars qw($VERSION @Pref);
+$VERSION = '0.05';
+@Pref = qw(CGI::Apache CGI); #default
+
+sub import {
+    my($self,@arg) = @_;
+    @Pref = @arg if @arg;
+}
+
+sub new {
+    shift;
+    my($file,$pack);
+    for $pack (@Pref) {
+	($file = $pack) =~ s|::|/|g;
+	eval { require "$file.pm"; };
+	if ($@) {
+#XXX	    warn $@;
+	    next;
+	} else {
+#XXX	    warn "Going to try $pack\->new\n";
+	    my $obj;
+	    eval {$obj = $pack->new(@_)};
+	    if ($@) {
+#XXX		warn $@;
+	    } else {
+		return $obj;
+	    }
+	}
+    }
+    Carp::croak "Couldn't load+construct any of @Pref\n";
+}
+
+# there's a trick in Lincoln's package that determines the calling
+# package.  The reason is to have a filehandle with the same name as
+# the filename.  To tell this trick that we are not the calling
+# package we have to follow this dirty convention. It's a questionable
+# trick imho, but for now I want to have something working
+sub isaCGI { 1 }
+
+1;
+__END__
+
+=head1 NAME
+
+CGI::Switch - Try more than one constructors and return the first object available
+
+=head1 SYNOPSIS
+
+ 
+ use CGISwitch;
+
+  -or-
+
+ use CGI::Switch This, That, CGI::XA, Foo, Bar, CGI;
+
+ my $q = new CGI::Switch;
+
+=head1 DESCRIPTION
+
+Per default the new() method tries to call new() in the three packages
+Apache::CGI, CGI::XA, and CGI. It returns the first CGI object it
+succeeds with.
+
+The import method allows you to set up the default order of the
+modules to be tested.
+
+=head1 SEE ALSO
+
+perl(1), Apache(3), CGI(3), CGI::XA(3)
+
+=head1 AUTHOR
+
+Andreas König E<lt>a.koenig@mind.deE<gt>
+
+=cut
diff --git a/lib/CPAN.pm b/lib/CPAN.pm
new file mode 100644
index 0000000000..32934a7054
--- /dev/null
+++ b/lib/CPAN.pm
@@ -0,0 +1,3434 @@
+package CPAN;
+use vars qw{$META $Signal $Cwd $End $Suppress_readline};
+
+$VERSION = '1.2401';
+
+# $Id: CPAN.pm,v 1.139 1997/03/31 22:43:23 k Exp $
+
+# my $version = substr q$Revision: 1.139 $, 10; # only used during development
+
+use Carp ();
+use Config ();
+use Cwd ();
+use DirHandle;
+use Exporter ();
+use ExtUtils::MakeMaker ();
+use File::Basename ();
+use File::Copy ();
+use File::Find;
+use File::Path ();
+use FileHandle ();
+use Safe ();
+use Text::ParseWords ();
+use Text::Wrap;
+
+my $getcwd;
+$getcwd  = $CPAN::Config->{'getcwd'} || 'cwd';
+$Cwd = Cwd->$getcwd();
+
+END { $End++; &cleanup; }
+
+%CPAN::DEBUG = qw(
+		  CPAN              1
+		  Index             2
+		  InfoObj           4
+		  Author            8
+		  Distribution     16
+		  Bundle           32
+		  Module           64
+		  CacheMgr        128
+		  Complete        256
+		  FTP             512
+		  Shell          1024
+		  Eval           2048
+		  Config         4096
+		 );
+
+$CPAN::DEBUG ||= 0;
+$CPAN::Signal ||= 0;
+
+package CPAN;
+use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $term);
+use strict qw(vars);
+
+@CPAN::ISA = qw(CPAN::Debug Exporter MM); # the MM class from
+                                          # MakeMaker, gives us
+                                          # catfile and catdir
+
+$META ||= new CPAN;                 # In case we reeval ourselves we
+                                    # need a ||
+
+@EXPORT = qw( 
+	     autobundle bundle expand force get
+	     install make readme recompile shell test clean
+	    );
+
+
+
+#-> sub CPAN::autobundle ;
+sub autobundle;
+#-> sub CPAN::bundle ;
+sub bundle;
+#-> sub CPAN::expand ;
+sub expand;
+#-> sub CPAN::force ;
+sub force;
+#-> sub CPAN::install ;
+sub install;
+#-> sub CPAN::make ;
+sub make;
+#-> sub CPAN::shell ;
+sub shell;
+#-> sub CPAN::clean ;
+sub clean;
+#-> sub CPAN::test ;
+sub test;
+
+#-> sub CPAN::AUTOLOAD ;
+sub AUTOLOAD {
+    my($l) = $AUTOLOAD;
+    $l =~ s/.*:://;
+    my(%EXPORT);
+    @EXPORT{@EXPORT} = '';
+    if (exists $EXPORT{$l}){
+	CPAN::Shell->$l(@_);
+    } else {
+	warn "CPAN doesn't know how to autoload $AUTOLOAD :-(
+Nothing Done.
+";
+	CPAN::Shell->h;
+    }
+}
+
+#-> sub CPAN::all ;
+sub all {
+    my($mgr,$class) = @_;
+    CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
+    CPAN::Index->reload;
+    values %{ $META->{$class} };
+}
+
+# Called by shell, not in batch mode. Not clean XXX
+#-> sub CPAN::checklock ;
+sub checklock {
+    my($self) = @_;
+    my $lockfile = CPAN->catfile($CPAN::Config->{cpan_home},".lock");
+    if (-f $lockfile && -M _ > 0) {
+	my $fh = FileHandle->new($lockfile);
+	my $other = <$fh>;
+	$fh->close;
+	if (defined $other && $other) {
+	    chomp $other;
+	    return if $$==$other; # should never happen
+	    print qq{There seems to be running another CPAN process }.
+		qq{($other). Trying to contact...\n};
+	    if (kill 0, $other) {
+		Carp::croak qq{Other job is running.\n}.
+		    qq{You may want to kill it and delete the lockfile, }.
+			qq{maybe. On UNIX try:\n}.
+			qq{    kill $other\n}.
+			    qq{    rm $lockfile\n};
+	    } elsif (-w $lockfile) {
+		my($ans) =
+		    ExtUtils::MakeMaker::prompt
+			(qq{Other job not responding. Shall I overwrite }.
+			 qq{the lockfile? (Y/N)},"y");
+		print("Ok, bye\n"), exit unless $ans =~ /^y/i;
+	    } else {
+		Carp::croak(
+			    qq{Lockfile $lockfile not writeable by you. }.
+			    qq{Cannot proceed.\n}.
+			    qq{    On UNIX try:\n}.
+			    qq{    rm $lockfile\n}.
+			    qq{  and then rerun us.\n}
+			   );
+	    }
+	}
+    }
+    File::Path::mkpath($CPAN::Config->{cpan_home});
+    my $fh;
+    unless ($fh = FileHandle->new(">$lockfile")) {
+	if ($! =~ /Permission/) {
+	    my $incc = $INC{'CPAN/Config.pm'};
+	    my $myincc = MM->catfile($ENV{HOME},'.cpan','CPAN','MyConfig.pm');
+	    print qq{
+
+Your configuration suggests that CPAN.pm should use a working
+directory of
+    $CPAN::Config->{cpan_home}
+Unfortunately we could not create the lock file
+    $lockfile
+due to permission problems.
+
+Please make sure that the configuration variable
+    \$CPAN::Config->{cpan_home}
+points to a directory where you can write a .lock file. You can set
+this variable in either
+    $incc
+or
+    $myincc
+
+};
+	}
+	Carp::croak "Could not open >$lockfile: $!";
+    }
+    print $fh $$, "\n";
+    $self->{LOCK} = $lockfile;
+    $fh->close;
+    $SIG{'TERM'} = sub { &cleanup; die "Got SIGTERM, leaving"; };
+    $SIG{'INT'} = sub {
+	my $s = $Signal == 2 ? "a second" : "another";
+	&cleanup, die "Got $s SIGINT" if $Signal;
+	$Signal = 1;
+    };
+    $SIG{'__DIE__'} = \&cleanup;
+    $self->debug("Signal handler set.") if $CPAN::DEBUG;
+}
+
+#-> sub CPAN::DESTROY ;
+sub DESTROY {
+    &cleanup; # need an eval?
+}
+
+#-> sub CPAN::exists ;
+sub exists {
+    my($mgr,$class,$id) = @_;
+    CPAN::Index->reload;
+    ### Carp::croak "exists called without class argument" unless $class;
+    $id ||= "";
+    exists $META->{$class}{$id};
+}
+
+#-> sub CPAN::hasFTP ;
+sub hasFTP {
+    my($self,$arg) = @_;
+    if (defined $arg) {
+	return $self->{'hasFTP'} = $arg;
+    } elsif (not defined $self->{'hasFTP'}) {
+	eval {require Net::FTP;};
+	$self->{'hasFTP'} = $@ ? 0 : 1;
+    }
+    return $self->{'hasFTP'};
+}
+
+#-> sub CPAN::hasLWP ;
+sub hasLWP {
+    my($self,$arg) = @_;
+    if (defined $arg) {
+	return $self->{'hasLWP'} = $arg;
+    } elsif (not defined $self->{'hasLWP'}) {
+	eval {require LWP;};
+	$LWP::VERSION ||= 0;
+        $self->{'hasLWP'} = $LWP::VERSION >= 4.98;
+    }
+    return $self->{'hasLWP'};
+}
+
+#-> sub CPAN::hasMD5 ;
+sub hasMD5 {
+    my($self,$arg) = @_;
+    if (defined $arg) {
+	$self->{'hasMD5'} = $arg;
+    } elsif (not defined $self->{'hasMD5'}) {
+	eval {require MD5;};
+	if ($@) {
+	    print "MD5 security checks disabled because MD5 not installed.
+  Please consider installing the MD5 module\n";
+	    $self->{'hasMD5'} = 0;
+	} else {
+	    $self->{'hasMD5'}++;
+	}
+    }
+    return $self->{'hasMD5'};
+}
+
+#-> sub CPAN::hasWAIT ;
+sub hasWAIT {
+    my($self,$arg) = @_;
+    if (defined $arg) {
+	$self->{'hasWAIT'} = $arg;
+    } elsif (not defined $self->{'hasWAIT'}) {
+	eval {require CPAN::WAIT;};
+	if ($@) {
+	    $self->{'hasWAIT'} = 0;
+	} else {
+	    $self->{'hasWAIT'} = 1;
+	}
+    }
+    return $self->{'hasWAIT'};
+}
+
+#-> sub CPAN::instance ;
+sub instance {
+    my($mgr,$class,$id) = @_;
+    ### CPAN::Index->reload; ### not faster: unless time - $CPAN::Index::last_time > 60;
+    CPAN::Index->reload;
+    ### Carp::croak "instance called without class argument" unless $class;
+    $id ||= "";
+    $META->{$class}{$id} ||= $class->new(ID => $id );
+}
+
+#-> sub CPAN::new ;
+sub new {
+    bless {}, shift;
+}
+
+#-> sub CPAN::cleanup ;
+sub cleanup {
+    local $SIG{__DIE__} = '';
+    my $i = 0; my $ineval = 0; my $sub;
+    while ((undef,undef,undef,$sub) = caller(++$i)) {
+      $ineval = 1, last if $sub eq '(eval)';
+    }
+    return if $ineval && !$End;
+    return unless defined $META->{'LOCK'};
+    return unless -f $META->{'LOCK'};
+    unlink $META->{'LOCK'};
+    print STDERR "Lockfile removed.\n";
+#    my $mess = Carp::longmess(@_);
+#    die @_;
+}
+
+#-> sub CPAN::shell ;
+sub shell {
+    $Suppress_readline ||= ! -t STDIN;
+
+    my $prompt = "cpan> ";
+    local($^W) = 1;
+    unless ($Suppress_readline) {
+	require Term::ReadLine;
+#	import Term::ReadLine;
+	$term = new Term::ReadLine 'CPAN Monitor';
+	$readline::rl_completion_function =
+	    $readline::rl_completion_function = 'CPAN::Complete::complete';
+    }
+
+    no strict;
+    $META->checklock();
+    my $getcwd;
+    $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
+    my $cwd = Cwd->$getcwd();
+    my $rl_avail = $Suppress_readline ? "suppressed" :
+	($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
+	    "available (get Term::ReadKey and Term::ReadLine::Perl ".
+	    "or get Term::ReadLine::Gnu)";
+
+    print qq{
+cpan shell -- CPAN exploration and modules installation (v$CPAN::VERSION)
+Readline support $rl_avail
+
+} unless $CPAN::Config->{'inhibit_startup_message'} ;
+    while () {
+	if ($Suppress_readline) {
+	    print $prompt;
+	    last unless defined ($_ = <> );
+	    chomp;
+	} else {
+#	     if (defined($CPAN::ANDK) && $CPAN::DEBUG) { # !$CPAN::ANDK++;$CPAN::DEBUG=1024
+#		 my($report,$item);
+#		 $report = "";
+#		 for $item (qw/ReadLine IN OUT MinLine findConsole Features/) {
+#		     $report .= sprintf "%-15s", $item;
+#		     $report .= $term->$item() || "";
+#		     $report .= "\n";
+#		 }
+#		 print $report;
+#		CPAN->debug($report);
+#	    }
+	    last unless defined ($_ = $term->readline($prompt));
+	}
+	s/^\s//;
+	next if /^$/;
+	$_ = 'h' if $_ eq '?';
+	if (/^\!/) {
+	    s/^\!//;
+	    my($eval) = $_;
+	    package CPAN::Eval;
+	    use vars qw($import_done);
+	    CPAN->import(':DEFAULT') unless $import_done++;
+	    CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
+	    eval($eval);
+	    warn $@ if $@;
+	} elsif (/^q(?:uit)?$/i) {
+	    last;
+	} elsif (/./) {
+	    my(@line);
+	    if ($] < 5.00322) { # parsewords had a bug until recently
+		@line = split;
+	    } else {
+		eval { @line = Text::ParseWords::shellwords($_) };
+		warn($@), next if $@;
+	    }
+	    $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
+	    my $command = shift @line;
+	    eval { CPAN::Shell->$command(@line) };
+	    warn $@ if $@;
+	}
+    } continue {
+	&cleanup, die if $Signal;
+	chdir $cwd;
+	print "\n";
+    }
+}
+
+package CPAN::CacheMgr;
+use vars qw($Du);
+@CPAN::CacheMgr::ISA = qw(CPAN::InfoObj);
+use File::Find;
+
+#-> sub CPAN::CacheMgr::as_string ;
+sub as_string {
+    eval { require Data::Dumper };
+    if ($@) {
+	return shift->SUPER::as_string;
+    } else {
+	return Data::Dumper::Dumper(shift);
+    }
+}
+
+#-> sub CPAN::CacheMgr::cachesize ;
+sub cachesize {
+    shift->{DU};
+}
+
+# sub check {
+#     my($self,@dirs) = @_;
+#     return unless -d $self->{ID};
+#     my $dir;
+#     @dirs = $self->dirs unless @dirs;
+#     for $dir (@dirs) {
+# 	  $self->disk_usage($dir);
+#     }
+# }
+
+#-> sub CPAN::CacheMgr::clean_cache ;
+#=# sub clean_cache {
+#=# 	my $self = shift;
+#=# 	my $dir;
+#=# 	while ($self->{DU} > $self->{'MAX'} and $dir = shift @{$self->{FIFO}}) {
+#=# 	    $self->force_clean_cache($dir);
+#=# 	}
+#=# 	$self->debug("leaving clean_cache with $self->{DU}") if $CPAN::DEBUG;
+#=# }
+
+#-> sub CPAN::CacheMgr::dir ;
+sub dir {
+    shift->{ID};
+}
+
+#-> sub CPAN::CacheMgr::entries ;
+sub entries {
+    my($self,$dir) = @_;
+    $self->debug("reading dir[$dir]") if $CPAN::DEBUG;
+    $dir ||= $self->{ID};
+    my $getcwd;
+    $getcwd  = $CPAN::Config->{'getcwd'} || 'cwd';
+    my($cwd) = Cwd->$getcwd();
+    chdir $dir or Carp::croak("Can't chdir to $dir: $!");
+    my $dh = DirHandle->new(".") or Carp::croak("Couldn't opendir $dir: $!");
+    my(@entries);
+    for ($dh->read) {
+	next if $_ eq "." || $_ eq "..";
+	if (-f $_) {
+	    push @entries, $CPAN::META->catfile($dir,$_);
+	} elsif (-d _) {
+	    push @entries, $CPAN::META->catdir($dir,$_);
+	} else {
+	    print STDERR "Warning: weird direntry in $dir: $_\n";
+	}
+    }
+    chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
+    sort { -M $b <=> -M $a} @entries;
+}
+
+#-> sub CPAN::CacheMgr::disk_usage ;
+sub disk_usage {
+    my($self,$dir) = @_;
+#    if (! defined $dir or $dir eq "") {
+#	$self->debug("Cannot determine disk usage for some reason") if $CPAN::DEBUG;
+#	return;
+#    }
+    return if $self->{SIZE}{$dir};
+    local($Du) = 0;
+    find(
+	 sub {
+	     return if -l $_;
+	     $Du += -s _;
+	 },
+	 $dir
+	);
+    $self->{SIZE}{$dir} = $Du/1024/1024;
+    push @{$self->{FIFO}}, $dir;
+    $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
+    $self->{DU} += $Du/1024/1024;
+    if ($self->{DU} > $self->{'MAX'} ) {
+	my($toremove) = shift @{$self->{FIFO}};
+	printf "...Hold on a sec... cleaning from cache (%.1f>%.1f MB): $toremove\n",
+		$self->{DU}, $self->{'MAX'};
+	$self->force_clean_cache($toremove);
+    }
+    $self->{DU};
+}
+
+#-> sub CPAN::CacheMgr::force_clean_cache ;
+sub force_clean_cache {
+    my($self,$dir) = @_;
+    $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
+	if $CPAN::DEBUG;
+    File::Path::rmtree($dir);
+    $self->{DU} -= $self->{SIZE}{$dir};
+    delete $self->{SIZE}{$dir};
+}
+
+#-> sub CPAN::CacheMgr::new ;
+sub new {
+    my $class = shift;
+    my $time = time;
+    my($debug,$t2);
+    $debug = "";
+    my $self = {
+		ID => $CPAN::Config->{'build_dir'},
+		MAX => $CPAN::Config->{'build_cache'},
+		DU => 0
+	       };
+    File::Path::mkpath($self->{ID});
+    my $dh = DirHandle->new($self->{ID});
+    bless $self, $class;
+    $self->debug("dir [$self->{ID}]") if $CPAN::DEBUG;
+    my $e;
+    for $e ($self->entries) {
+	next if $e eq ".." || $e eq ".";
+	$self->disk_usage($e);
+    }
+    $t2 = time;
+    $debug .= "timing of CacheMgr->new: ".($t2 - $time);
+    $time = $t2;
+    CPAN->debug($debug) if $CPAN::DEBUG;
+    $self;
+}
+
+package CPAN::Debug;
+
+#-> sub CPAN::Debug::debug ;
+sub debug {
+    my($self,$arg) = @_;
+    my($caller,$func,$line,@rest) = caller(1); # caller(0) eg
+                                               # Complete, caller(1)
+                                               # eg readline
+    ($caller) = caller(0);
+    $caller =~ s/.*:://;
+#    print "caller[$caller]func[$func]line[$line]rest[@rest]\n";
+#    print "CPAN::DEBUG{caller}[$CPAN::DEBUG{$caller}]CPAN::DEBUG[$CPAN::DEBUG]\n";
+    if ($CPAN::DEBUG{$caller} & $CPAN::DEBUG){
+	if (ref $arg) {
+	    eval { require Data::Dumper };
+	    if ($@) {
+		print $arg->as_string;
+	    } else {
+		print Data::Dumper::Dumper($arg);
+	    }
+	} else {
+	    print "Debug($caller:$func,$line,@rest): $arg\n"
+	}
+    }
+}
+
+package CPAN::Config;
+import ExtUtils::MakeMaker 'neatvalue';
+use vars qw(%can);
+
+%can = (
+  'commit' => "Commit changes to disk",
+  'defaults' => "Reload defaults from disk",
+  'init'   => "Interactive setting of all options",
+);
+
+#-> sub CPAN::Config::edit ;
+sub edit {
+    my($class,@args) = @_;
+    return unless @args;
+    CPAN->debug("class[$class]args[".join(" | ",@args)."]");
+    my($o,$str,$func,$args,$key_exists);
+    $o = shift @args;
+    if($can{$o}) {
+	$class->$o(@args);
+	return 1;
+    } else {
+	if (ref($CPAN::Config->{$o}) eq ARRAY) {
+	    $func = shift @args;
+	    $func ||= "";
+	    # Let's avoid eval, it's easier to comprehend without.
+	    if ($func eq "push") {
+		push @{$CPAN::Config->{$o}}, @args;
+	    } elsif ($func eq "pop") {
+		pop @{$CPAN::Config->{$o}};
+	    } elsif ($func eq "shift") {
+		shift @{$CPAN::Config->{$o}};
+	    } elsif ($func eq "unshift") {
+		unshift @{$CPAN::Config->{$o}}, @args;
+	    } elsif ($func eq "splice") {
+		splice @{$CPAN::Config->{$o}}, @args;
+	    } elsif (@args) {
+		$CPAN::Config->{$o} = [@args];
+	    } else {
+		print(
+		      "  $o  ",
+		      ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$o}),
+		      "\n"
+		     );
+	    }
+	} else {
+	    $CPAN::Config->{$o} = $args[0] if defined $args[0];
+	    print "    $o    ";
+	    print defined $CPAN::Config->{$o} ? $CPAN::Config->{$o} : "UNDEFINED";
+	}
+    }
+}
+
+#-> sub CPAN::Config::commit ;
+sub commit {
+    my($self,$configpm) = @_;
+    unless (defined $configpm){
+	$configpm ||= $INC{"CPAN/MyConfig.pm"};
+	$configpm ||= $INC{"CPAN/Config.pm"};
+	$configpm || Carp::confess(qq{
+CPAN::Config::commit called without an argument.
+Please specify a filename where to save the configuration or try
+"o conf init" to have an interactive course through configing.
+});
+    }
+    my($mode);
+    if (-f $configpm) {
+	$mode = (stat $configpm)[2];
+	if ($mode && ! -w _) {
+	    Carp::confess("$configpm is not writable");
+	}
+    }
+
+    my $msg = <<EOF unless $configpm =~ /MyConfig/;
+
+# This is CPAN.pm's systemwide configuration file.  This file provides
+# defaults for users, and the values can be changed in a per-user configuration
+# file. The user-config file is being looked for as ~/.cpan/CPAN/MyConfig.pm.
+
+EOF
+    $msg ||= "\n";
+    my($fh) = FileHandle->new;
+    open $fh, ">$configpm" or warn "Couldn't open >$configpm: $!";
+    print $fh qq[$msg\$CPAN::Config = \{\n];
+    foreach (sort keys %$CPAN::Config) {
+	$fh->print(
+		   "  '$_' => ",
+		   ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$_}),
+		   ",\n"
+		  );
+    }
+
+    print $fh "};\n1;\n__END__\n";
+    close $fh;
+
+    #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
+    #chmod $mode, $configpm;
+###why was that so?    $self->defaults;
+    print "commit: wrote $configpm\n";
+    1;
+}
+
+*default = \&defaults;
+#-> sub CPAN::Config::defaults ;
+sub defaults {
+    my($self) = @_;
+    $self->unload;
+    $self->load;
+    1;
+}
+
+sub init {
+    my($self) = @_;
+    undef $CPAN::Config->{'inhibit_startup_message'}; # lazy trick to
+                                                      # have the least
+                                                      # important
+                                                      # variable
+                                                      # undefined
+    $self->load;
+    1;
+}
+
+my $dot_cpan;
+#-> sub CPAN::Config::load ;
+sub load {
+    my($self) = shift;
+    my(@miss);
+    eval {require CPAN::Config;};       # We eval, because of some MakeMaker problems
+    unshift @INC, $CPAN::META->catdir($ENV{HOME},".cpan") unless $dot_cpan++;
+    eval {require CPAN::MyConfig;};     # where you can override system wide settings
+    return unless @miss = $self->not_loaded;
+    require CPAN::FirstTime;
+    my($configpm,$fh,$redo);
+    $redo ||= "";
+    if (defined $INC{"CPAN/Config.pm"} && -w $INC{"CPAN/Config.pm"}) {
+	$configpm = $INC{"CPAN/Config.pm"};
+	$redo++;
+    } elsif (defined $INC{"CPAN/MyConfig.pm"} && -w $INC{"CPAN/MyConfig.pm"}) {
+	$configpm = $INC{"CPAN/MyConfig.pm"};
+	$redo++;
+    } else {
+	my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"});
+	my($configpmdir) = MM->catdir($path_to_cpan,"CPAN");
+	my($configpmtest) = MM->catfile($configpmdir,"Config.pm");
+	if (-d $configpmdir or File::Path::mkpath($configpmdir)) {
+	    if (-w $configpmtest) {
+		$configpm = $configpmtest;
+	    } elsif (-w $configpmdir) {
+		#_#_# following code dumped core on me with 5.003_11, a.k.
+		unlink "$configpmtest.bak" if -f "$configpmtest.bak";
+		rename $configpmtest, "$configpmtest.bak" if -f $configpmtest;
+		my $fh = FileHandle->new;
+		if ($fh->open(">$configpmtest")) {
+		    $fh->print("1;\n");
+		    $configpm = $configpmtest;
+		} else {
+		    # Should never happen
+		    Carp::confess("Cannot open >$configpmtest");
+		}
+	    }
+	}
+	unless ($configpm) {
+	    $configpmdir = MM->catdir($ENV{HOME},".cpan","CPAN");
+	    File::Path::mkpath($configpmdir);
+	    $configpmtest = MM->catfile($configpmdir,"MyConfig.pm");
+	    if (-w $configpmtest) {
+		$configpm = $configpmtest;
+	    } elsif (-w $configpmdir) {
+		#_#_# following code dumped core on me with 5.003_11, a.k.
+		my $fh = FileHandle->new;
+		if ($fh->open(">$configpmtest")) {
+		    $fh->print("1;\n");
+		    $configpm = $configpmtest;
+		} else {
+		    # Should never happen
+		    Carp::confess("Cannot open >$configpmtest");
+		}
+	    } else {
+		Carp::confess(qq{WARNING: CPAN.pm is unable to }.
+			      qq{create a configuration file.});
+	    }
+	}
+    }
+    local($") = ", ";
+    print qq{
+We have to reconfigure CPAN.pm due to following uninitialized parameters:
+
+@miss
+} if $redo ;
+    print qq{
+$configpm initialized.
+};
+    sleep 2;
+    CPAN::FirstTime::init($configpm);
+}
+
+#-> sub CPAN::Config::not_loaded ;
+sub not_loaded {
+    my(@miss);
+    for (qw(
+	    cpan_home keep_source_where build_dir build_cache index_expire
+	    gzip tar unzip make pager makepl_arg make_arg make_install_arg
+	    urllist inhibit_startup_message ftp_proxy http_proxy no_proxy
+	   )) {
+	push @miss, $_ unless defined $CPAN::Config->{$_};
+    }
+    return @miss;
+}
+
+#-> sub CPAN::Config::unload ;
+sub unload {
+    delete $INC{'CPAN/MyConfig.pm'};
+    delete $INC{'CPAN/Config.pm'};
+}
+
+*h = \&help;
+#-> sub CPAN::Config::help ;
+sub help {
+    print <<EOF;
+Known options:
+  defaults  reload default config values from disk
+  commit    commit session changes to disk
+  init      go through a dialog to set all parameters
+
+You may edit key values in the follow fashion:
+
+  o conf build_cache 15
+
+  o conf build_dir "/foo/bar"
+
+  o conf urllist shift
+
+  o conf urllist unshift ftp://ftp.foo.bar/
+
+EOF
+    undef; #don't reprint CPAN::Config
+}
+
+#-> sub CPAN::Config::complete ;
+sub complete {
+    my($word,$line,$pos) = @_;
+    $word ||= "";
+    my(@o_conf) = (keys %CPAN::Config::can, keys %$CPAN::Config);
+    return grep /^\Q$word\E/, @o_conf;
+}
+
+package CPAN::Shell;
+use vars qw($AUTOLOAD $redef @ISA);
+@CPAN::Shell::ISA = qw(CPAN::Debug);
+if ($CPAN::META->hasWAIT) {
+    unshift @ISA, "CPAN::WAIT";
+}
+# private function ro re-eval this module (handy during development)
+#-> sub CPAN::Shell::AUTOLOAD ;
+sub AUTOLOAD {
+    my($autoload) = $AUTOLOAD;
+    $autoload =~ s/.*:://;
+    if ($autoload =~ /^w/) {
+	if ($CPAN::META->hasWAIT) {
+	    CPAN::WAIT->wh;
+	    return;
+	} else {
+	    print STDERR qq{
+Commands starting with "w" require CPAN::WAIT to be installed.
+Please consider installing CPAN::WAIT to use the fulltext index.
+Type "install CPAN::WAIT" and restart CPAN.pm.
+}
+	}
+    } else {
+	warn "CPAN::Shell doesn't know how to autoload $autoload :-(
+Nothing Done.
+";
+    }
+    CPAN::Shell->h;
+}
+
+#-> sub CPAN::Shell::h ;
+sub h {
+    my($class,$about) = @_;
+    if (defined $about) {
+	print "Detailed help not yet implemented\n";
+    } else {
+	print q{
+command   arguments       description
+a         string                  authors
+b         or              display bundles
+d         /regex/         info    distributions
+m         or              about   modules
+i         none                    anything of above
+
+r          as             reinstall recommendations
+u          above          uninstalled distributions
+See manpage for autobundle, recompile, force, look, etc.
+
+make                      make
+test      modules,        make test (implies make)
+install   dists, bundles, make install (implies test)
+clean     "r" or "u"      make clean
+readme                    display the README file
+
+reload    index|cpan    load most recent indices/CPAN.pm
+h or ?                  display this menu
+o         various       set and query options
+!         perl-code     eval a perl command
+q                       quit the shell subroutine
+};
+    }
+}
+
+#-> sub CPAN::Shell::a ;
+sub a { print shift->format_result('Author',@_);}
+#-> sub CPAN::Shell::b ;
+sub b {
+    my($self,@which) = @_;
+    CPAN->debug("which[@which]") if $CPAN::DEBUG;
+    my($incdir,$bdir,$dh); 
+    foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
+	$bdir = $CPAN::META->catdir($incdir,"Bundle");
+	if ($dh = DirHandle->new($bdir)) { # may fail
+	    my($entry);
+	    for $entry ($dh->read) {
+		next if -d $CPAN::META->catdir($bdir,$entry);
+		next unless $entry =~ s/\.pm$//;
+		$CPAN::META->instance('CPAN::Bundle',"Bundle::$entry");
+	    }
+	}
+    }
+    print $self->format_result('Bundle',@which);
+}
+#-> sub CPAN::Shell::d ;
+sub d { print shift->format_result('Distribution',@_);}
+#-> sub CPAN::Shell::m ;
+sub m { print shift->format_result('Module',@_);}
+
+#-> sub CPAN::Shell::i ;
+sub i {
+    my($self) = shift;
+    my(@args) = @_;
+    my(@type,$type,@m);
+    @type = qw/Author Bundle Distribution Module/;
+    @args = '/./' unless @args;
+    my(@result);
+    for $type (@type) {
+	push @result, $self->expand($type,@args);
+    }
+    my $result =  @result == 1 ?
+	$result[0]->as_string :
+	    join "", map {$_->as_glimpse} @result;
+    $result ||= "No objects found of any type for argument @args\n";
+    print $result;
+}
+
+#-> sub CPAN::Shell::o ;
+sub o {
+    my($self,$o_type,@o_what) = @_;
+    $o_type ||= "";
+    CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
+    if ($o_type eq 'conf') {
+	shift @o_what if @o_what && $o_what[0] eq 'help';
+	if (!@o_what) {
+	    my($k,$v);
+	    print "CPAN::Config options:\n";
+	    for $k (sort keys %CPAN::Config::can) {
+		$v = $CPAN::Config::can{$k};
+		printf "    %-18s %s\n", $k, $v;
+	    }
+	    print "\n";
+	    for $k (sort keys %$CPAN::Config) {
+		$v = $CPAN::Config->{$k};
+		if (ref $v) {
+		    printf "    %-18s\n", $k;
+		    print map {"\t$_\n"} @{$v};
+		} else {
+		    printf "    %-18s %s\n", $k, $v;
+		}
+	    }
+	    print "\n";
+	} elsif (!CPAN::Config->edit(@o_what)) {
+	    print qq[Type 'o conf' to view configuration edit options\n\n];
+	}
+    } elsif ($o_type eq 'debug') {
+	my(%valid);
+	@o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
+	if (@o_what) {
+	    while (@o_what) {
+		my($what) = shift @o_what;
+		if ( exists $CPAN::DEBUG{$what} ) {
+		    $CPAN::DEBUG |= $CPAN::DEBUG{$what};
+		} elsif ($what =~ /^\d/) {
+		    $CPAN::DEBUG = $what;
+		} elsif (lc $what eq 'all') {
+		    my($max) = 0;
+		    for (values %CPAN::DEBUG) {
+			$max += $_;
+		    }
+		    $CPAN::DEBUG = $max;
+		} else {
+		    my($known) = 0;
+		    for (keys %CPAN::DEBUG) {
+			next unless lc($_) eq lc($what);
+			$CPAN::DEBUG |= $CPAN::DEBUG{$_};
+			$known = 1;
+		    }
+		    print "unknown argument [$what]\n" unless $known;
+		}
+	    }
+	} else {
+	    print "Valid options for debug are ".
+		join(", ",sort(keys %CPAN::DEBUG), 'all').
+		    qq{ or a number. Completion works on the options. }.
+			qq{Case is ignored.\n\n};
+	}
+	if ($CPAN::DEBUG) {
+	    print "Options set for debugging:\n";
+	    my($k,$v);
+	    for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
+		$v = $CPAN::DEBUG{$k};
+		printf "    %-14s(%s)\n", $k, $v if $v & $CPAN::DEBUG;
+	    }
+	} else {
+	    print "Debugging turned off completely.\n";
+	}
+    } else {
+	print qq{
+Known options:
+  conf    set or get configuration variables
+  debug   set or get debugging options
+};
+    }
+}
+
+#-> sub CPAN::Shell::reload ;
+sub reload {
+    my($self,$command,@arg) = @_;
+    $command ||= "";
+    $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
+    if ($command =~ /cpan/i) {
+	CPAN->debug("reloading the whole CPAN.pm") if $CPAN::DEBUG;
+	my $fh = FileHandle->new($INC{'CPAN.pm'});
+	local($/);
+	undef $/;
+	$redef = 0;
+	local($SIG{__WARN__})
+	    = sub {
+		if ( $_[0] =~ /Subroutine \w+ redefined/ ) {
+		    ++$redef;
+		    local($|) = 1;
+		    print ".";
+		    return;
+		}
+		warn @_;
+	    };
+	eval <$fh>;
+	warn $@ if $@;
+	print "\n$redef subroutines redefined\n";
+    } elsif ($command =~ /index/) {
+	CPAN::Index->force_reload;
+    } else {
+	print qq{cpan     re-evals the CPAN.pm file\n};
+	print qq{index    re-reads the index files\n};
+    }
+}
+
+#-> sub CPAN::Shell::_binary_extensions ;
+sub _binary_extensions {
+    my($self) = shift @_;
+    my(@result,$module,%seen,%need,$headerdone);
+    for $module ($self->expand('Module','/./')) {
+	my $file  = $module->cpan_file;
+	next if $file eq "N/A";
+	next if $file =~ /^Contact Author/;
+	next if $file =~ /perl5[._-]\d{3}(?:[\d_]+)?\.tar[._-]gz$/;
+	next unless $module->xs_file;
+	local($|) = 1;
+	print ".";
+	push @result, $module;
+    }
+#    print join " | ", @result;
+    print "\n";
+    return @result;
+}
+
+#-> sub CPAN::Shell::recompile ;
+sub recompile {
+    my($self) = shift @_;
+    my($module,@module,$cpan_file,%dist);
+    @module = $self->_binary_extensions();
+    for $module (@module){  # we force now and compile later, so we don't do it twice
+	$cpan_file = $module->cpan_file;
+	my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
+	$pack->force;
+	$dist{$cpan_file}++;
+    }
+    for $cpan_file (sort keys %dist) {
+	print "  CPAN: Recompiling $cpan_file\n\n";
+	my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
+	$pack->install;
+	$CPAN::Signal = 0; # it's tempting to reset Signal, so we can
+                           # stop a package from recompiling,
+                           # e.g. IO-1.12 when we have perl5.003_10
+    }
+}
+
+#-> sub CPAN::Shell::_u_r_common ;
+sub _u_r_common {
+    my($self) = shift @_;
+    my($what) = shift @_;
+    CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
+    Carp::croak "Usage: \$obj->_u_r_common($what)" unless defined $what;
+    Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless $what =~ /^[aru]$/;
+    my(@args) = @_;
+    @args = '/./' unless @args;
+    my(@result,$module,%seen,%need,$headerdone,$version_zeroes);
+    $version_zeroes = 0;
+    my $sprintf = "%-25s %9s %9s  %s\n";
+    for $module ($self->expand('Module',@args)) {
+	my $file  = $module->cpan_file;
+	next unless defined $file; # ??
+	my($latest) = $module->cpan_version || 0;
+	my($inst_file) = $module->inst_file;
+	my($have);
+	if ($inst_file){
+	    if ($what eq "a") {
+		$have = $module->inst_version;
+	    } elsif ($what eq "r") {
+		$have = $module->inst_version;
+		local($^W) = 0;
+		$version_zeroes++ unless $have;
+		next if $have >= $latest;
+	    } elsif ($what eq "u") {
+		next;
+	    }
+	} else {
+	    if ($what eq "a") {
+		next;
+	    } elsif ($what eq "r") {
+		next;
+	    } elsif ($what eq "u") {
+		$have = "-";
+	    }
+	}
+	return if $CPAN::Signal; # this is sometimes lengthy
+	$seen{$file} ||= 0;
+	if ($what eq "a") {
+	    push @result, sprintf "%s %s\n", $module->id, $have;
+	} elsif ($what eq "r") {
+	    push @result, $module->id;
+	    next if $seen{$file}++;
+	} elsif ($what eq "u") {
+	    push @result, $module->id;
+	    next if $seen{$file}++;
+	    next if $file =~ /^Contact/;
+	}
+	unless ($headerdone++){
+	    print "\n";
+	    printf(
+		   $sprintf,
+		   "Package namespace",
+		   "installed",
+		   "latest",
+		   "in CPAN file"
+		   );
+	}
+	$latest = substr($latest,0,8) if length($latest) > 8;
+	$have = substr($have,0,8) if length($have) > 8;
+	printf $sprintf, $module->id, $have, $latest, $file;
+	$need{$module->id}++;
+    }
+    unless (%need) {
+	if ($what eq "u") {
+	    print "No modules found for @args\n";
+	} elsif ($what eq "r") {
+	    print "All modules are up to date for @args\n";
+	}
+    }
+    if ($what eq "r" && $version_zeroes) {
+	my $s = $version_zeroes > 1 ? "s have" : " has";
+	print qq{$version_zeroes installed module$s no version number to compare\n};
+    }
+    @result;
+}
+
+#-> sub CPAN::Shell::r ;
+sub r {
+    shift->_u_r_common("r",@_);
+}
+
+#-> sub CPAN::Shell::u ;
+sub u {
+    shift->_u_r_common("u",@_);
+}
+
+#-> sub CPAN::Shell::autobundle ;
+sub autobundle {
+    my($self) = shift;
+    my(@bundle) = $self->_u_r_common("a",@_);
+    my($todir) = $CPAN::META->catdir($CPAN::Config->{'cpan_home'},"Bundle");
+    File::Path::mkpath($todir);
+    unless (-d $todir) {
+	print "Couldn't mkdir $todir for some reason\n";
+	return;
+    }
+    my($y,$m,$d) =  (localtime)[5,4,3];
+    $y+=1900;
+    $m++;
+    my($c) = 0;
+    my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
+    my($to) = $CPAN::META->catfile($todir,"$me.pm");
+    while (-f $to) {
+	$me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
+	$to = $CPAN::META->catfile($todir,"$me.pm");
+    }
+    my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
+    $fh->print(
+	       "package Bundle::$me;\n\n",
+	       "\$VERSION = '0.01';\n\n",
+	       "1;\n\n",
+	       "__END__\n\n",
+	       "=head1 NAME\n\n",
+	       "Bundle::$me - Snapshot of installation on ",
+	       $Config::Config{'myhostname'},
+	       " on ",
+	       scalar(localtime),
+	       "\n\n=head1 SYNOPSIS\n\n",
+	       "perl -MCPAN -e 'install Bundle::$me'\n\n",
+	       "=head1 CONTENTS\n\n",
+	       join("\n", @bundle),
+	       "\n\n=head1 CONFIGURATION\n\n",
+	       Config->myconfig,
+	       "\n\n=head1 AUTHOR\n\n",
+	       "This Bundle has been generated automatically ",
+	       "by the autobundle routine in CPAN.pm.\n",
+	      );
+    $fh->close;
+    print "\nWrote bundle file
+    $to\n\n";
+}
+
+#-> sub CPAN::Shell::expand ;
+sub expand {
+    shift;
+    my($type,@args) = @_;
+    my($arg,@m);
+    for $arg (@args) {
+	my $regex;
+	if ($arg =~ m|^/(.*)/$|) {
+	    $regex = $1;
+	}
+	my $class = "CPAN::$type";
+	my $obj;
+	if (defined $regex) {
+	    for $obj ( sort {$a->id cmp $b->id} $CPAN::META->all($class)) {
+		push @m, $obj
+		    if
+			$obj->id =~ /$regex/i
+			    or
+			(
+			 (
+			  $] < 5.00303 ### provide sort of compatibility with 5.003
+			  ||
+			  $obj->can('name')
+			 )
+			 &&
+			 $obj->name  =~ /$regex/i
+			);
+	    }
+	} else {
+	    my($xarg) = $arg;
+	    if ( $type eq 'Bundle' ) {
+		$xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
+	    }
+	    if ($CPAN::META->exists($class,$xarg)) {
+		$obj = $CPAN::META->instance($class,$xarg);
+	    } elsif ($CPAN::META->exists($class,$arg)) {
+		$obj = $CPAN::META->instance($class,$arg);
+	    } else {
+		next;
+	    }
+	    push @m, $obj;
+	}
+    }
+    return wantarray ? @m : $m[0];
+}
+
+#-> sub CPAN::Shell::format_result ;
+sub format_result {
+    my($self) = shift;
+    my($type,@args) = @_;
+    @args = '/./' unless @args;
+    my(@result) = $self->expand($type,@args);
+    my $result =  @result == 1 ?
+	$result[0]->as_string :
+	    join "", map {$_->as_glimpse} @result;
+    $result ||= "No objects of type $type found for argument @args\n";
+    $result;
+}
+
+#-> sub CPAN::Shell::rematein ;
+sub rematein {
+    shift;
+    my($meth,@some) = @_;
+    my $pragma = "";
+    if ($meth eq 'force') {
+	$pragma = $meth;
+	$meth = shift @some;
+    }
+    CPAN->debug("pragma[$pragma]meth[$meth] some[@some]") if $CPAN::DEBUG;
+    my($s,@s);
+    foreach $s (@some) {
+	my $obj;
+	if (ref $s) {
+	    $obj = $s;
+	} elsif ($s =~ m|/|) { # looks like a file
+	    $obj = $CPAN::META->instance('CPAN::Distribution',$s);
+	} elsif ($s =~ m|^Bundle::|) {
+	    $obj = $CPAN::META->instance('CPAN::Bundle',$s);
+	} else {
+	    $obj = $CPAN::META->instance('CPAN::Module',$s)
+		if $CPAN::META->exists('CPAN::Module',$s);
+	}
+	if (ref $obj) {
+	    CPAN->debug(
+			qq{pragma[$pragma] meth[$meth] obj[$obj] as_string\[}.
+			$obj->as_string.
+			qq{\]}
+		       ) if $CPAN::DEBUG;
+	    $obj->$pragma()
+		if
+		    $pragma
+			&&
+		    ($] < 5.00303 || $obj->can($pragma)); ### compatibility with 5.003
+	    $obj->$meth();
+	} elsif ($CPAN::META->exists('CPAN::Author',$s)) {
+	    $obj = $CPAN::META->instance('CPAN::Author',$s);
+	    print "Don't be silly, you can't $meth ", $obj->fullname, " ;-)\n";
+	} else {
+	    print qq{Warning: Cannot $meth $s, don\'t know what it is.
+Try the command
+
+    i /$s/
+
+to find objects with similar identifiers.
+};
+	}
+    }
+}
+
+#-> sub CPAN::Shell::force ;
+sub force   { shift->rematein('force',@_); }
+#-> sub CPAN::Shell::get ;
+sub get     { shift->rematein('get',@_); }
+#-> sub CPAN::Shell::readme ;
+sub readme  { shift->rematein('readme',@_); }
+#-> sub CPAN::Shell::make ;
+sub make    { shift->rematein('make',@_); }
+#-> sub CPAN::Shell::test ;
+sub test    { shift->rematein('test',@_); }
+#-> sub CPAN::Shell::install ;
+sub install { shift->rematein('install',@_); }
+#-> sub CPAN::Shell::clean ;
+sub clean   { shift->rematein('clean',@_); }
+#-> sub CPAN::Shell::look ;
+sub look   { shift->rematein('look',@_); }
+
+package CPAN::FTP;
+use vars qw($Ua);
+@CPAN::FTP::ISA = qw(CPAN::Debug);
+
+#-> sub CPAN::FTP::ftp_get ;
+sub ftp_get {
+    my($class,$host,$dir,$file,$target) = @_;
+    $class->debug(
+		       qq[Going to fetch file [$file] from dir [$dir]
+	on host [$host] as local [$target]\n]
+		      ) if $CPAN::DEBUG;
+    my $ftp = Net::FTP->new($host);
+    return 0 unless defined $ftp;
+    $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
+    $class->debug(qq[Going to ->login("anonymous","$Config::Config{'cf_email'}")\n]);
+    unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
+	warn "Couldn't login on $host";
+	return;
+    }
+    # print qq[Going to ->cwd("$dir")\n];
+    unless ( $ftp->cwd($dir) ){
+	warn "Couldn't cwd $dir";
+	return;
+    }
+    $ftp->binary;
+    $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
+    unless ( $ftp->get($file,$target) ){
+	warn "Couldn't fetch $file from $host\n";
+	return;
+    }
+    $ftp->quit; # it's ok if this fails
+    return 1;
+}
+
+#-> sub CPAN::FTP::localize ;
+sub localize {
+    my($self,$file,$aslocal,$force) = @_;
+    $force ||= 0;
+    Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])"
+	unless defined $aslocal;
+    $self->debug("file [$file] aslocal [$aslocal]") if $CPAN::DEBUG;
+
+    return $aslocal if -f $aslocal && -r _ && ! $force;
+    rename $aslocal, "$aslocal.bak" if -f $aslocal;
+
+    my($aslocal_dir) = File::Basename::dirname($aslocal);
+    File::Path::mkpath($aslocal_dir);
+    print STDERR qq{Warning: You are not allowed to write into }.
+	qq{directory "$aslocal_dir".
+    I\'ll continue, but if you face any problems, they may be due
+    to insufficient permissions.\n} unless -w $aslocal_dir;
+
+    # Inheritance is not easier to manage than a few if/else branches
+    if ($CPAN::META->hasLWP) {
+	require LWP::UserAgent;
+ 	unless ($Ua) {
+	    $Ua = new LWP::UserAgent;
+	    my($var);
+	    $Ua->proxy('ftp',  $var)
+		if $var = $CPAN::Config->{'ftp_proxy'} || $ENV{'ftp_proxy'};
+	    $Ua->proxy('http', $var)
+		if $var = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
+	    $Ua->no_proxy($var)
+		if $var = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
+	}
+    }
+
+    # Try the list of urls for each single object. We keep a record
+    # where we did get a file from
+    my($i);
+    for $i (0..$#{$CPAN::Config->{urllist}}) {
+	my $url = $CPAN::Config->{urllist}[$i];
+	$url .= "/" unless substr($url,-1) eq "/";
+	$url .= $file;
+	$self->debug("localizing[$url]") if $CPAN::DEBUG;
+	if ($url =~ /^file:/) {
+	    my $l;
+	    if ($CPAN::META->hasLWP) {
+		require URI::URL;
+		my $u = new URI::URL $url;
+		$l = $u->path;
+	    } else { # works only on Unix, is poorly constructed, but
+                     # hopefully better than nothing. 
+		     # RFC 1738 says fileurl BNF is
+		     # fileurl = "file://" [ host | "localhost" ] "/" fpath
+		     # Thanks to "Mark D. Baushke" <mdb@cisco.com> for the code
+		($l = $url) =~ s,^file://[^/]+,,; # discard the host part
+		$l =~ s/^file://;	# assume they meant file://localhost
+	    }
+	    return $l if -f $l && -r _;
+	    # Maybe mirror has compressed it?
+	    if (-f "$l.gz") {
+		$self->debug("found compressed $l.gz") if $CPAN::DEBUG;
+		system("$CPAN::Config->{gzip} -dc $l.gz > $aslocal");
+		return $aslocal if -f $aslocal;
+	    }
+	}
+
+	if ($CPAN::META->hasLWP) {
+	    print "Fetching $url with LWP\n";
+	    my $res = $Ua->mirror($url, $aslocal);
+	    if ($res->is_success) {
+		return $aslocal;
+	    }
+	}
+	if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
+	    # that's the nice and easy way thanks to Graham
+	    my($host,$dir,$getfile) = ($1,$2,$3);
+	    if ($CPAN::META->hasFTP) {
+		$dir =~ s|/+|/|g;
+		$self->debug("Going to fetch file [$getfile]
+  from dir [$dir]
+  on host  [$host]
+  as local [$aslocal]") if $CPAN::DEBUG;
+		CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal) && return $aslocal;
+		warn "Net::FTP failed for some reason\n";
+	    } else {
+		warn qq{
+  Please, install Net::FTP as soon as possible. Just type
+    install Net::FTP
+  Thank you.
+
+}
+	    }
+	}
+
+	# Came back if Net::FTP couldn't establish connection (or failed otherwise)
+	# Maybe they are behind a firewall, but they gave us
+	# a socksified (or other) ftp program...
+
+	my($funkyftp);
+	# does ncftp handle http?
+	for $funkyftp ($CPAN::Config->{'lynx'},$CPAN::Config->{'ncftp'}) {
+	    next unless defined $funkyftp;
+	    next unless -x $funkyftp;
+	    my($want_compressed);
+	    print(
+		  qq{
+Trying with $funkyftp to get
+  $url
+});
+	    $want_compressed = $aslocal =~ s/\.gz//;
+	    my($source_switch) = "";
+	    $source_switch = "-source" if $funkyftp =~ /\blynx$/;
+	    my($system) = "$funkyftp $source_switch '$url' > $aslocal";
+	    my($wstatus);
+	    if (($wstatus = system($system)) == 0) {
+		if ($want_compressed) {
+		    $system = "$CPAN::Config->{'gzip'} -dt $aslocal";
+		    if (system($system) == 0) {
+			rename $aslocal, "$aslocal.gz";
+		    } else {
+			$system = "$CPAN::Config->{'gzip'} $aslocal";
+			system($system);
+		    }
+		    return "$aslocal.gz";
+		} else {
+		    $system = "$CPAN::Config->{'gzip'} -dt $aslocal";
+		    if (system($system) == 0) {
+			$system = "$CPAN::Config->{'gzip'} -d $aslocal";
+			system($system);
+		    } else {
+			# should be fine, eh?
+		    }
+		    return $aslocal;
+		}
+	    } else {
+		my $estatus = $wstatus >> 8;
+		print qq{
+System call "$system"
+returned status $estatus (wstat $wstatus)
+};
+	    }
+	}
+
+	if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
+	    my($host,$dir,$getfile) = ($1,$2,$3);
+	    my($netrcfile,$fh);
+	    if (-x $CPAN::Config->{'ftp'}) {
+		my $timestamp = 0;
+		my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
+		   $ctime,$blksize,$blocks) = stat($aslocal);
+		$timestamp = $mtime ||= 0;
+
+		my($netrc) = CPAN::FTP::netrc->new;
+		my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
+
+		my $targetfile = File::Basename::basename($aslocal);
+		my(@dialog);
+		push(
+		     @dialog,
+		     "lcd $aslocal_dir",
+		     "cd /",
+		     map("cd $_", split "/", $dir), # RFC 1738
+		     "bin",
+		     "get $getfile $targetfile",
+		     "quit"
+		    );
+		if (! $netrc->netrc) {
+		    CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
+		} elsif ($netrc->hasdefault || $netrc->contains($host)) {
+		    CPAN->debug(
+				sprint(
+				       "hasdef[%d]cont($host)[%d]",
+				       $netrc->hasdefault,
+				       $netrc->contains($host)
+				      )
+			       ) if $CPAN::DEBUG;
+		    if ($netrc->protected) {
+			print(
+			      qq{
+  Trying with external ftp to get
+    $url
+  As this requires some features that are not thoroughly tested, we\'re
+  not sure, that we get it right....
+
+}
+			     );
+			my $fh = FileHandle->new;
+			$fh->open("|$CPAN::Config->{'ftp'}$verbose $host")
+			    or die "Couldn't open ftp: $!";
+			# pilot is blind now
+			CPAN->debug("dialog [".(join "|",@dialog)."]")
+			    if $CPAN::DEBUG;
+			foreach (@dialog) { $fh->print("$_\n") }
+			$fh->close;		# Wait for process to complete
+			my $wstatus = $?;
+			my $estatus = $wstatus >> 8;
+			print qq{
+Subprocess "|$CPAN::Config->{'ftp'}$verbose $host"
+  returned status $estatus (wstat $wstatus)
+} if $wstatus;
+			($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+			 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
+			$mtime ||= 0;
+			if ($mtime > $timestamp) {
+			    print "GOT $aslocal\n";
+			    return $aslocal;
+			} else {
+			    print "Hmm... Still failed!\n";
+			}
+		    } else {
+			warn "Your $netrcfile is not correctly protected.\n";
+		    }
+		} else {
+		    warn "Your ~/.netrc neither contains $host
+  nor does it have a default entry\n";
+		}
+
+		# OK, they don't have a valid ~/.netrc. Use 'ftp -n' then and
+		# login manually to host, using e-mail as password.
+		print qq{Issuing "$CPAN::Config->{'ftp'}$verbose -n"\n};
+		unshift(
+			@dialog,
+			"open $host",
+			"user anonymous $Config::Config{'cf_email'}"
+		       );
+		CPAN->debug("dialog [".(join "|",@dialog)."]") if $CPAN::DEBUG;
+		$fh = FileHandle->new;
+		$fh->open("|$CPAN::Config->{'ftp'}$verbose -n") or
+		    die "Cannot fork: $!\n";
+		foreach (@dialog) { $fh->print("$_\n") }
+		$fh->close;
+		my $wstatus = $?;
+		my $estatus = $wstatus >> 8;
+		print qq{
+Subprocess "|$CPAN::Config->{'ftp'}$verbose -n"
+  returned status $estatus (wstat $wstatus)
+} if $wstatus;
+		($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+		   $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
+		$mtime ||= 0;
+		if ($mtime > $timestamp) {
+		    print "GOT $aslocal\n";
+		    return $aslocal;
+		} else {
+		    print "Bad luck... Still failed!\n";
+		}
+	    }
+	    sleep 2;
+	}
+
+	print "Can't access URL $url.\n\n";
+	my(@mess,$mess);
+	push @mess, "LWP" unless CPAN->hasLWP;
+	push @mess, "Net::FTP" unless CPAN->hasFTP;
+	my($ext);
+	for $ext (qw/lynx ncftp ftp/) {
+	    $CPAN::Config->{$ext} ||= "";
+	    push @mess, "an external $ext" unless -x $CPAN::Config->{$ext};
+	}
+	$mess = qq{Either get }.
+	    join(" or ",@mess).
+	    qq{ or check, if the URL found in your configuration file, }.
+	    $CPAN::Config->{urllist}[$i].
+	    qq{, is valid.};
+	print Text::Wrap::wrap("","",$mess), "\n";
+    }
+    print "Cannot fetch $file\n";
+    if (-f "$aslocal.bak") {
+	rename "$aslocal.bak", $aslocal;
+	print "Trying to get away with old file:\n";
+	print $self->ls($aslocal);
+	return $aslocal;
+    }
+    return;
+}
+
+# find2perl needs modularization, too, all the following is stolen
+# from there
+sub ls {
+    my($self,$name) = @_;
+    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
+     $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);
+
+    my($perms,%user,%group);
+    my $pname = $name;
+
+    if (defined $blocks) {
+	$blocks = int(($blocks + 1) / 2);
+    }
+    else {
+	$blocks = int(($sizemm + 1023) / 1024);
+    }
+
+    if    (-f _) { $perms = '-'; }
+    elsif (-d _) { $perms = 'd'; }
+    elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
+    elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
+    elsif (-p _) { $perms = 'p'; }
+    elsif (-S _) { $perms = 's'; }
+    else         { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
+
+    my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
+    my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
+    my $tmpmode = $mode;
+    my $tmp = $rwx[$tmpmode & 7];
+    $tmpmode >>= 3;
+    $tmp = $rwx[$tmpmode & 7] . $tmp;
+    $tmpmode >>= 3;
+    $tmp = $rwx[$tmpmode & 7] . $tmp;
+    substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
+    substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
+    substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
+    $perms .= $tmp;
+
+    my $user = $user{$uid} || $uid;   # too lazy to implement lookup
+    my $group = $group{$gid} || $gid;
+
+    my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
+    my($timeyear);
+    my($moname) = $moname[$mon];
+    if (-M _ > 365.25 / 2) {
+	$timeyear = $year + 1900;
+    }
+    else {
+	$timeyear = sprintf("%02d:%02d", $hour, $min);
+    }
+
+    sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
+	    $ino,
+		 $blocks,
+		      $perms,
+			    $nlink,
+				$user,
+				     $group,
+					  $sizemm,
+					      $moname,
+						 $mday,
+						     $timeyear,
+							 $pname;
+}
+
+package CPAN::FTP::netrc;
+
+sub new {
+    my($class) = @_;
+    my $file = MM->catfile($ENV{HOME},".netrc");
+
+    my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+       $atime,$mtime,$ctime,$blksize,$blocks)
+	= stat($file);
+    $mode ||= 0;
+    my $protected = 0;
+
+    my($fh,@machines,$hasdefault);
+    $hasdefault = 0;
+    $fh = FileHandle->new or die "Could not create a filehandle";
+
+    if($fh->open($file)){
+	$protected = ($mode & 077) == 0;
+	local($/) = "";
+      NETRC: while (<$fh>) {
+	    my(@tokens) = split " ", $_;
+	  TOKEN: while (@tokens) {
+		my($t) = shift @tokens;
+		if ($t eq "default"){
+		    $hasdefault++;
+		    # warn "saw a default entry before tokens[@tokens]";
+		    last NETRC;
+		}
+		last TOKEN if $t eq "macdef";
+		if ($t eq "machine") {
+		    push @machines, shift @tokens;
+		}
+	    }
+	}
+    } else {
+	$file = $hasdefault = $protected = "";
+    }
+
+    bless {
+	   'mach' => [@machines],
+	   'netrc' => $file,
+	   'hasdefault' => $hasdefault,
+	   'protected' => $protected,
+	  }, $class;
+}
+
+sub hasdefault { shift->{'hasdefault'} }
+sub netrc      { shift->{'netrc'}      }
+sub protected  { shift->{'protected'}  }
+sub contains {
+    my($self,$mach) = @_;
+    for ( @{$self->{'mach'}} ) {
+	return 1 if $_ eq $mach;
+    }
+    return 0;
+}
+
+package CPAN::Complete;
+@CPAN::Complete::ISA = qw(CPAN::Debug);
+
+#-> sub CPAN::Complete::complete ;
+sub complete {
+    my($word,$line,$pos) = @_;
+    $word ||= "";
+    $line ||= "";
+    $pos ||= 0;
+    CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
+    $line =~ s/^\s*//;
+    if ($line =~ s/^(force\s*)//) {
+	$pos -= length($1);
+    }
+    my @return;
+    if ($pos == 0) {
+	@return = grep(
+		       /^$word/,
+		       sort qw(
+			       ! a b d h i m o q r u autobundle clean
+			       make test install force reload look
+			      )
+		      );
+    } elsif ( $line !~ /^[\!abdhimorutl]/ ) {
+	@return = ();
+    } elsif ($line =~ /^a\s/) {
+	@return = completex('CPAN::Author',$word);
+    } elsif ($line =~ /^b\s/) {
+	@return = completex('CPAN::Bundle',$word);
+    } elsif ($line =~ /^d\s/) {
+	@return = completex('CPAN::Distribution',$word);
+    } elsif ($line =~ /^([mru]|make|clean|test|install|readme|look)\s/ ) {
+	@return = (completex('CPAN::Module',$word),completex('CPAN::Bundle',$word));
+    } elsif ($line =~ /^i\s/) {
+	@return = complete_any($word);
+    } elsif ($line =~ /^reload\s/) {
+	@return = complete_reload($word,$line,$pos);
+    } elsif ($line =~ /^o\s/) {
+	@return = complete_option($word,$line,$pos);
+    } else {
+	@return = ();
+    }
+    return @return;
+}
+
+#-> sub CPAN::Complete::completex ;
+sub completex {
+    my($class, $word) = @_;
+    grep /^\Q$word\E/, map { $_->id } $CPAN::META->all($class);
+}
+
+#-> sub CPAN::Complete::complete_any ;
+sub complete_any {
+    my($word) = shift;
+    return (
+	    completex('CPAN::Author',$word),
+	    completex('CPAN::Bundle',$word),
+	    completex('CPAN::Distribution',$word),
+	    completex('CPAN::Module',$word),
+	   );
+}
+
+#-> sub CPAN::Complete::complete_reload ;
+sub complete_reload {
+    my($word,$line,$pos) = @_;
+    $word ||= "";
+    my(@words) = split " ", $line;
+    CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
+    my(@ok) = qw(cpan index);
+    return @ok if @words == 1;
+    return grep /^\Q$word\E/, @ok if @words == 2 && $word;
+}
+
+#-> sub CPAN::Complete::complete_option ;
+sub complete_option {
+    my($word,$line,$pos) = @_;
+    $word ||= "";
+    my(@words) = split " ", $line;
+    CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
+    my(@ok) = qw(conf debug);
+    return @ok if @words == 1;
+    return grep /^\Q$word\E/, @ok if @words == 2 && $word;
+    if (0) {
+    } elsif ($words[1] eq 'index') {
+	return ();
+    } elsif ($words[1] eq 'conf') {
+	return CPAN::Config::complete(@_);
+    } elsif ($words[1] eq 'debug') {
+	return sort grep /^\Q$word\E/, sort keys %CPAN::DEBUG, 'all';
+    }
+}
+
+package CPAN::Index;
+use vars qw($last_time $date_of_03);
+@CPAN::Index::ISA = qw(CPAN::Debug);
+$last_time ||= 0;
+$date_of_03 ||= 0;
+
+#-> sub CPAN::Index::force_reload ;
+sub force_reload {
+    my($class) = @_;
+    $CPAN::Index::last_time = 0;
+    $class->reload(1);
+}
+
+#-> sub CPAN::Index::reload ;
+sub reload {
+    my($cl,$force) = @_;
+    my $time = time;
+
+    # XXX check if a newer one is available. (We currently read it from time to time)
+    for ($CPAN::Config->{index_expire}) {
+	$_ = 0.001 unless $_ > 0.001;
+    }
+    return if $last_time + $CPAN::Config->{index_expire}*86400 > $time;
+    my($debug,$t2);
+    $last_time = $time;
+
+    $cl->read_authindex($cl->reload_x(
+				      "authors/01mailrc.txt.gz",
+				      "01mailrc.gz",
+				      $force));
+    $t2 = time;
+    $debug = "timing reading 01[".($t2 - $time)."]";
+    $time = $t2;
+    return if $CPAN::Signal; # this is sometimes lengthy
+    $cl->read_modpacks($cl->reload_x(
+				     "modules/02packages.details.txt.gz",
+				     "02packag.gz",
+				     $force));
+    $t2 = time;
+    $debug .= "02[".($t2 - $time)."]";
+    $time = $t2;
+    return if $CPAN::Signal; # this is sometimes lengthy
+    $cl->read_modlist($cl->reload_x(
+				    "modules/03modlist.data.gz",
+				    "03mlist.gz",
+				    $force));
+    $t2 = time;
+    $debug .= "03[".($t2 - $time)."]";
+    $time = $t2;
+    CPAN->debug($debug) if $CPAN::DEBUG;
+}
+
+#-> sub CPAN::Index::reload_x ;
+sub reload_x {
+    my($cl,$wanted,$localname,$force) = @_;
+    $force ||= 0;
+    CPAN::Config->load; # we should guarantee loading wherever we rely on Config XXX
+    my $abs_wanted = CPAN->catfile($CPAN::Config->{'keep_source_where'},$localname);
+    if (
+	-f $abs_wanted &&
+	-M $abs_wanted < $CPAN::Config->{'index_expire'} &&
+	!$force
+       ) {
+	my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
+	$cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
+		   qq{day$s. I\'ll use that.});
+	return $abs_wanted;
+    } else {
+	$force ||= 1;
+    }
+    return CPAN::FTP->localize($wanted,$abs_wanted,$force);
+}
+
+#-> sub CPAN::Index::read_authindex ;
+sub read_authindex {
+    my($cl,$index_target) = @_;
+    my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
+    print "Going to read $index_target\n";
+    my $fh = FileHandle->new("$pipe|");
+    while (<$fh>) {
+	chomp;
+	my($userid,$fullname,$email) = /alias\s+(\S+)\s+\"([^\"\<]+)\s+<([^\>]+)\>\"/;
+	next unless $userid && $fullname && $email;
+
+	# instantiate an author object
+ 	my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
+	$userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
+	return if $CPAN::Signal;
+    }
+    $fh->close;
+    $? and Carp::croak "FAILED $pipe: exit status [$?]";
+}
+
+#-> sub CPAN::Index::read_modpacks ;
+sub read_modpacks {
+    my($cl,$index_target) = @_;
+    my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
+    print "Going to read $index_target\n";
+    my $fh = FileHandle->new("$pipe|");
+    while (<$fh>) {
+	last if /^\s*$/;
+    }
+    while (<$fh>) {
+	chomp;
+	my($mod,$version,$dist) = split;
+###	$version =~ s/^\+//;
+
+	# if it as a bundle, instatiate a bundle object
+	my($bundle,$id,$userid);
+	
+	if ($mod eq 'CPAN') {
+	    local($^W)= 0;
+	    if ($version > $CPAN::VERSION){
+		print qq{
+  There\'s a new CPAN.pm version (v$version) available!
+  You might want to try
+    install CPAN
+    reload cpan
+  without quitting the current session. It should be a seemless upgrade
+  while we are running...
+};
+		sleep 2;
+		print qq{\n};
+	    }
+	    last if $CPAN::Signal;
+	} elsif ($mod =~ /^Bundle::(.*)/) {
+	    $bundle = $1;
+	}
+
+	if ($bundle){
+	    $id =  $CPAN::META->instance('CPAN::Bundle',$mod);
+###	    $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist);
+# This "next" makes us faster but if the job is running long, we ignore
+# rereads which is bad. So we have to be a bit slower again.
+#	} elsif ($CPAN::META->exists('CPAN::Module',$mod)) {
+#	    next;
+	} else {
+	    # instantiate a module object
+	    $id = $CPAN::META->instance('CPAN::Module',$mod);
+###	    $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist)
+###		if $id->cpan_version ne $version || $id->cpan_file ne $dist; # good speed in here
+	}
+
+	if ($id->cpan_file ne $dist){
+	    # determine the author
+	    ($userid) = $dist =~ /([^\/]+)/;
+	    $id->set(
+		     'CPAN_USERID' => $userid,
+		     'CPAN_VERSION' => $version,
+		     'CPAN_FILE' => $dist
+		    );
+	}
+
+	# instantiate a distribution object
+	unless ($CPAN::META->exists('CPAN::Distribution',$dist)) {
+	    $CPAN::META->instance(
+				  'CPAN::Distribution' => $dist
+				 )->set(
+					'CPAN_USERID' => $userid
+				       );
+	}
+
+	return if $CPAN::Signal;
+    }
+    $fh->close;
+    $? and Carp::croak "FAILED $pipe: exit status [$?]";
+}
+
+#-> sub CPAN::Index::read_modlist ;
+sub read_modlist {
+    my($cl,$index_target) = @_;
+    my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
+    print "Going to read $index_target\n";
+    my $fh = FileHandle->new("$pipe|");
+    my $eval;
+    while (<$fh>) {
+	if (/^Date:\s+(.*)/){
+	    return if $date_of_03 eq $1;
+	    ($date_of_03) = $1;
+	}
+	last if /^\s*$/;
+    }
+    local($/) = undef;
+    $eval = <$fh>;
+    $fh->close;
+    $eval .= q{CPAN::Modulelist->data;};
+    local($^W) = 0;
+    my($comp) = Safe->new("CPAN::Safe1");
+    my $ret = $comp->reval($eval);
+    Carp::confess($@) if $@;
+    return if $CPAN::Signal;
+    for (keys %$ret) {
+	my $obj = $CPAN::META->instance(CPAN::Module,$_);
+	$obj->set(%{$ret->{$_}});
+	return if $CPAN::Signal;
+    }
+}
+
+package CPAN::InfoObj;
+@CPAN::InfoObj::ISA = qw(CPAN::Debug);
+
+#-> sub CPAN::InfoObj::new ;
+sub new { my $this = bless {}, shift; %$this = @_; $this }
+
+#-> sub CPAN::InfoObj::set ;
+sub set {
+    my($self,%att) = @_;
+    my(%oldatt) = %$self;
+    %$self = (%oldatt, %att);
+}
+
+#-> sub CPAN::InfoObj::id ;
+sub id { shift->{'ID'} }
+
+#-> sub CPAN::InfoObj::as_glimpse ;
+sub as_glimpse {
+    my($self) = @_;
+    my(@m);
+    my $class = ref($self);
+    $class =~ s/^CPAN:://;
+    push @m, sprintf "%-15s %s\n", $class, $self->{ID};
+    join "", @m;
+}
+
+#-> sub CPAN::InfoObj::as_string ;
+sub as_string {
+    my($self) = @_;
+    my(@m);
+    my $class = ref($self);
+    $class =~ s/^CPAN:://;
+    push @m, $class, " id = $self->{ID}\n";
+    for (sort keys %$self) {
+	next if $_ eq 'ID';
+	my $extra = "";
+	$_ eq "CPAN_USERID" and $extra = " (".$self->author.")";
+	if (ref($self->{$_}) eq "ARRAY") { # Should we setup a language interface? XXX
+	    push @m, sprintf "    %-12s %s%s\n", $_, "@{$self->{$_}}", $extra;
+	} else {
+	    push @m, sprintf "    %-12s %s%s\n", $_, $self->{$_}, $extra;
+	}
+    }
+    join "", @m, "\n";
+}
+
+#-> sub CPAN::InfoObj::author ;
+sub author {
+    my($self) = @_;
+    $CPAN::META->instance(CPAN::Author,$self->{CPAN_USERID})->fullname;
+}
+
+package CPAN::Author;
+@CPAN::Author::ISA = qw(CPAN::InfoObj);
+
+#-> sub CPAN::Author::as_glimpse ;
+sub as_glimpse {
+    my($self) = @_;
+    my(@m);
+    my $class = ref($self);
+    $class =~ s/^CPAN:://;
+    push @m, sprintf "%-15s %s (%s)\n", $class, $self->{ID}, $self->fullname;
+    join "", @m;
+}
+
+# Dead code, I would have liked to have,,, but it was never reached,,,
+#sub make {
+#    my($self) = @_;
+#    return "Don't be silly, you can't make $self->{FULLNAME} ;-)\n";
+#}
+
+#-> sub CPAN::Author::fullname ;
+sub fullname { shift->{'FULLNAME'} }
+*name = \&fullname;
+#-> sub CPAN::Author::email ;
+sub email    { shift->{'EMAIL'} }
+
+package CPAN::Distribution;
+@CPAN::Distribution::ISA = qw(CPAN::InfoObj);
+
+#-> sub CPAN::Distribution::called_for ;
+sub called_for {
+    my($self,$id) = @_;
+    $self->{'CALLED_FOR'} = $id if defined $id;
+    return $self->{'CALLED_FOR'};
+}
+
+#-> sub CPAN::Distribution::get ;
+sub get {
+    my($self) = @_;
+  EXCUSE: {
+	my @e;
+	exists $self->{'build_dir'} and push @e,
+	    "Unwrapped into directory $self->{'build_dir'}";
+	print join "", map {"  $_\n"} @e and return if @e;
+    }
+    my($local_file);
+    my($local_wanted) =
+	 CPAN->catfile(
+			$CPAN::Config->{keep_source_where},
+			"authors",
+			"id",
+			split("/",$self->{ID})
+		       );
+
+    $self->debug("Doing localize") if $CPAN::DEBUG;
+    $local_file = CPAN::FTP->localize("authors/id/$self->{ID}", $local_wanted);
+    $self->{localfile} = $local_file;
+    my $builddir = $CPAN::META->{cachemgr}->dir;
+    $self->debug("doing chdir $builddir") if $CPAN::DEBUG;
+    chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
+    my $packagedir;
+
+    $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
+    if ($CPAN::META->hasMD5) {
+	$self->verifyMD5;
+    }
+    if ($local_file =~ /(\.tar\.(gz|Z)|\.tgz|\.zip)$/i){
+	$self->debug("Removing tmp") if $CPAN::DEBUG;
+	File::Path::rmtree("tmp");
+	mkdir "tmp", 0777 or Carp::croak "Couldn't mkdir tmp: $!";
+	chdir "tmp";
+	$self->debug("Changed directory to tmp") if $CPAN::DEBUG;
+	if ($local_file =~ /z$/i){
+	    $self->{archived} = "tar";
+	    if (system("$CPAN::Config->{gzip} --decompress --stdout $local_file | $CPAN::Config->{tar} xvf -")== 0) {
+		$self->{unwrapped} = "YES";
+	    } else {
+		$self->{unwrapped} = "NO";
+	    }
+	} elsif ($local_file =~ /zip$/i) {
+	    $self->{archived} = "zip";
+	    if (system("$CPAN::Config->{unzip} $local_file") == 0) {
+		$self->{unwrapped} = "YES";
+	    } else {
+		$self->{unwrapped} = "NO";
+	    }
+	}
+	# Let's check if the package has its own directory.
+	opendir DIR, "." or Carp::croak("Weird: couldn't opendir .: $!");
+	my @readdir = grep $_ !~ /^\.\.?$/, readdir DIR; ### MAC??
+	closedir DIR;
+	my ($distdir,$packagedir);
+	if (@readdir == 1 && -d $readdir[0]) {
+	    $distdir = $readdir[0];
+	    $packagedir = $CPAN::META->catdir($builddir,$distdir);
+	    -d $packagedir and print "Removing previously used $packagedir\n";
+	    File::Path::rmtree($packagedir);
+	    rename($distdir,$packagedir) or Carp::confess("Couldn't rename $distdir to $packagedir: $!");
+	} else {
+	    my $pragmatic_dir = $self->{'CPAN_USERID'} . '000';
+	    $pragmatic_dir =~ s/\W_//g;
+	    $pragmatic_dir++ while -d "../$pragmatic_dir";
+	    $packagedir = $CPAN::META->catdir($builddir,$pragmatic_dir);
+	    File::Path::mkpath($packagedir);
+	    my($f);
+	    for $f (@readdir) { # is already without "." and ".."
+		my $to = $CPAN::META->catdir($packagedir,$f);
+		rename($f,$to) or Carp::confess("Couldn't rename $f to $to: $!");
+	    }
+	}
+	$self->{'build_dir'} = $packagedir;
+
+	chdir "..";
+	$self->debug("Changed directory to .. (self is $self [".$self->as_string."])")
+	    if $CPAN::DEBUG;
+	File::Path::rmtree("tmp");
+	if ($CPAN::Config->{keep_source_where} =~ /^no/i ){
+	    print "Going to unlink $local_file\n";
+	    unlink $local_file or Carp::carp "Couldn't unlink $local_file";
+	}
+	my($makefilepl) = $CPAN::META->catfile($packagedir,"Makefile.PL");
+	unless (-f $makefilepl) {
+	    my($configure) = $CPAN::META->catfile($packagedir,"Configure");
+	    if (-f $configure) {
+		# do we have anything to do?
+		$self->{'configure'} = $configure;
+	    } else {
+		my $fh = FileHandle->new(">$makefilepl")
+		    or Carp::croak("Could not open >$makefilepl");
+		my $cf = $self->called_for || "unknown";
+		$fh->print(qq{
+# This Makefile.PL has been autogenerated by the module CPAN.pm
+# Autogenerated on: }.scalar localtime().qq{
+		    use ExtUtils::MakeMaker;
+		    WriteMakefile(NAME => q[$cf]);
+});
+		print qq{Package comes without Makefile.PL.\n}.
+		    qq{  Writing one on our own (calling it $cf)\n};
+	    }
+	}
+    } else {
+	$self->{archived} = "NO";
+    }
+    return $self;
+}
+
+#-> sub CPAN::Distribution::new ;
+sub new {
+    my($class,%att) = @_;
+
+    $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
+
+    my $this = { %att };
+    return bless $this, $class;
+}
+
+#-> sub CPAN::Distribution::look ;
+sub look {
+    my($self) = @_;
+    if (  $CPAN::Config->{'shell'} ) {
+	print qq{
+Trying to open a subshell in the build directory...
+};
+    } else {
+	print qq{
+Your configuration does not define a value for subshells.
+Please define it with "o conf shell <your shell>"
+};
+	return;
+    }
+    my $dist = $self->id;
+    my $dir  = $self->dir or $self->get;
+    $dir = $self->dir;
+    my $getcwd;
+    $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
+    my $pwd  = Cwd->$getcwd();
+    chdir($dir);
+    print qq{Working directory is $dir.\n};
+    system($CPAN::Config->{'shell'}) == 0 or die "Subprocess shell error";
+    chdir($pwd);
+}
+
+#-> sub CPAN::Distribution::readme ;
+sub readme {
+    my($self) = @_;
+    my($dist) = $self->id;
+    my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
+    $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
+    my($local_file);
+    my($local_wanted) =
+	 CPAN->catfile(
+			$CPAN::Config->{keep_source_where},
+			"authors",
+			"id",
+			split("/","$sans.readme"),
+		       );
+    $self->debug("Doing localize") if $CPAN::DEBUG;
+    $local_file = CPAN::FTP->localize("authors/id/$sans.readme", $local_wanted);
+    my $fh_pager = FileHandle->new;
+    $fh_pager->open("|$CPAN::Config->{'pager'}")
+	or die "Could not open pager $CPAN::Config->{'pager'}: $!";
+    my $fh_readme = FileHandle->new;
+    $fh_readme->open($local_file) or die "Could not open $local_file: $!";
+    $fh_pager->print(<$fh_readme>);
+}
+
+#-> sub CPAN::Distribution::verifyMD5 ;
+sub verifyMD5 {
+    my($self) = @_;
+  EXCUSE: {
+	my @e;
+	$self->{MD5_STATUS} ||= "";
+	$self->{MD5_STATUS} eq "OK" and push @e, "MD5 Checksum was ok";
+	print join "", map {"  $_\n"} @e and return if @e;
+    }
+    my($local_file);
+    my(@local) = split("/",$self->{ID});
+    my($basename) = pop @local;
+    push @local, "CHECKSUMS";
+    my($local_wanted) =
+	CPAN->catfile(
+		      $CPAN::Config->{keep_source_where},
+		      "authors",
+		      "id",
+		      @local
+		     );
+    local($") = "/";
+    if (
+	-f $local_wanted
+	&&
+	$self->MD5_check_file($local_wanted,$basename)
+       ) {
+	return $self->{MD5_STATUS} = "OK";
+    }
+    $local_file = CPAN::FTP->localize(
+				      "authors/id/@local",
+				      $local_wanted,
+				      'force>:-{');
+    my($checksum_pipe);
+    if ($local_file) {
+	# fine
+    } else {
+	$local[-1] .= ".gz";
+	$local_file = CPAN::FTP->localize(
+					  "authors/id/@local",
+					  "$local_wanted.gz",
+					  'force>:-{'
+					 );
+	my $system = "$CPAN::Config->{gzip} --decompress $local_file";
+	system($system) == 0 or die "Could not uncompress $local_file";
+	$local_file =~ s/\.gz$//;
+    }
+    $self->MD5_check_file($local_file,$basename);
+}
+
+#-> sub CPAN::Distribution::MD5_check_file ;
+sub MD5_check_file {
+    my($self,$lfile,$basename) = @_;
+    my($cksum);
+    my $fh = new FileHandle;
+    local($/) = undef;
+    if (open $fh, $lfile){
+	my $eval = <$fh>;
+	close $fh;
+	my($comp) = Safe->new();
+	$cksum = $comp->reval($eval);
+	Carp::confess($@) if $@;
+	if ($cksum->{$basename}->{md5}) {
+	    $self->debug("Found checksum for $basename: $cksum->{$basename}->{md5}\n")
+		if $CPAN::DEBUG;
+	    my $file = $self->{localfile};
+	    my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $self->{localfile}|";
+	    if (
+		open($fh, $file) && $self->eq_MD5($fh,$cksum->{$basename}->{md5})
+		or
+		open($fh, $pipe) && $self->eq_MD5($fh,$cksum->{$basename}->{'md5-ungz'})
+	       ){
+		print "Checksum for $file ok\n";
+		return $self->{MD5_STATUS} = "OK";
+	    } else {
+		print join(
+			   "",
+			   qq{Checksum mismatch for distribution file. },
+			   qq{Please investigate.\n\n}
+			  );
+		print $self->as_string;
+		print $CPAN::META->instance(
+					    'CPAN::Author',
+					    $self->{CPAN_USERID}
+					   )->as_string;
+		my $wrap = qq{I\'d recommend removing $self->{'localfile'}}.
+		    qq{, put another URL at the top of the list of URLs to }.
+		    qq{visit, and restart CPAN.pm. If all this doesn\'t help, }.
+		    qq{please contact the author or your CPAN site admin};
+		print Text::Wrap::wrap("","",$wrap);
+		print "\n\n";
+		sleep 3;
+		return;
+	    }
+	    close $fh if fileno($fh);
+	} else {
+	    $self->{MD5_STATUS} ||= "";
+	    if ($self->{MD5_STATUS} eq "NIL") {
+		print "\nNo md5 checksum for $basename in local $lfile.";
+		print "Removing $lfile\n";
+		unlink $lfile or print "Could not unlink: $!";
+		sleep 1;
+	    }
+	    $self->{MD5_STATUS} = "NIL";
+	    return;
+	}
+    } else {
+	Carp::carp "Could not open $lfile for reading";
+    }
+}
+
+#-> sub CPAN::Distribution::eq_MD5 ;
+sub eq_MD5 {
+    my($self,$fh,$expectMD5) = @_;
+    my $md5 = new MD5;
+    $md5->addfile($fh);
+    my $hexdigest = $md5->hexdigest;
+    $hexdigest eq $expectMD5;
+}
+
+#-> sub CPAN::Distribution::force ;
+sub force {
+    my($self) = @_;
+    $self->{'force_update'}++;
+    delete $self->{'MD5_STATUS'};
+    delete $self->{'archived'};
+    delete $self->{'build_dir'};
+    delete $self->{'localfile'};
+    delete $self->{'make'};
+    delete $self->{'install'};
+    delete $self->{'unwrapped'};
+    delete $self->{'writemakefile'};
+}
+
+#-> sub CPAN::Distribution::perl ;
+sub perl {
+    my($self) = @_;
+    my($perl) = MM->file_name_is_absolute($^X) ? $^X : "";
+    my $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
+    my $pwd  = Cwd->$getcwd();
+    my $candidate = $CPAN::META->catfile($pwd,$^X);
+    $perl ||= $candidate if MM->maybe_command($candidate);
+    unless ($perl) {
+	my ($component,$perl_name);
+      DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
+	    PATH_COMPONENT: foreach $component (MM->path(), $Config::Config{'binexp'}) {
+		  next unless defined($component) && $component;
+		  my($abs) = MM->catfile($component,$perl_name);
+		  if (MM->maybe_command($abs)) {
+		      $perl = $abs;
+		      last DIST_PERLNAME;
+		  }
+	      }
+	  }
+    }
+    $perl;
+}
+
+#-> sub CPAN::Distribution::make ;
+sub make {
+    my($self) = @_;
+    $self->debug($self->id) if $CPAN::DEBUG;
+    print "Running make\n";
+    $self->get;
+  EXCUSE: {
+	my @e;
+	$self->{archived} eq "NO" and push @e,
+	"Is neither a tar nor a zip archive.";
+
+	$self->{unwrapped} eq "NO" and push @e,
+	"had problems unarchiving. Please build manually";
+
+	exists $self->{writemakefile} &&
+	    $self->{writemakefile} eq "NO" and push @e,
+	    "Had some problem writing Makefile";
+
+	defined $self->{'make'} and push @e,
+	"Has already been processed within this session";
+
+	print join "", map {"  $_\n"} @e and return if @e;
+    }
+    print "\n  CPAN.pm: Going to build ".$self->id."\n\n";
+    my $builddir = $self->dir;
+    chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
+    $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
+
+    my $system;
+    if ($self->{'configure'}) {
+	$system = $self->{'configure'};
+    } else {
+	my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
+	my $switch = "";
+# This needs a handler that can be turned on or off:
+#	$switch = "-MExtUtils::MakeMaker ".
+#	    "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
+#	    if $] > 5.00310;
+	$system = "$perl $switch Makefile.PL $CPAN::Config->{makepl_arg}";
+    }
+    {
+	local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
+	my($ret,$pid);
+	$@ = "";
+	if ($CPAN::Config->{inactivity_timeout}) {
+	    eval {
+		alarm $CPAN::Config->{inactivity_timeout};
+		local $SIG{CHLD} = sub { wait };
+		if (defined($pid = fork)) {
+		    if ($pid) { #parent
+			wait;
+		    } else {    #child
+			exec $system;
+		    }
+		} else {
+		    print "Cannot fork: $!";
+		    return;
+		}
+	    };
+	    alarm 0;
+	    if ($@){
+		kill 9, $pid;
+		waitpid $pid, 0;
+		print $@;
+		$self->{writemakefile} = "NO - $@";
+		$@ = "";
+		return;
+	    }
+	} else {
+	    $ret = system($system);
+	    if ($ret != 0) {
+		$self->{writemakefile} = "NO";
+		return;
+	    }
+	}
+    }
+    $self->{writemakefile} = "YES";
+    return if $CPAN::Signal;
+    $system = join " ", $CPAN::Config->{'make'}, $CPAN::Config->{make_arg};
+    if (system($system) == 0) {
+	 print "  $system -- OK\n";
+	 $self->{'make'} = "YES";
+    } else {
+	 $self->{writemakefile} = "YES";
+	 $self->{'make'} = "NO";
+	 print "  $system -- NOT OK\n";
+    }
+}
+
+#-> sub CPAN::Distribution::test ;
+sub test {
+    my($self) = @_;
+    $self->make;
+    return if $CPAN::Signal;
+    print "Running make test\n";
+  EXCUSE: {
+	my @e;
+	exists $self->{'make'} or push @e,
+	"Make had some problems, maybe interrupted? Won't test";
+
+	exists $self->{'make'} and
+	    $self->{'make'} eq 'NO' and
+		push @e, "Oops, make had returned bad status";
+
+	exists $self->{'build_dir'} or push @e, "Has no own directory";
+	print join "", map {"  $_\n"} @e and return if @e;
+    }
+    chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
+    $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
+    my $system = join " ", $CPAN::Config->{'make'}, "test";
+    if (system($system) == 0) {
+	 print "  $system -- OK\n";
+	 $self->{'make_test'} = "YES";
+    } else {
+	 $self->{'make_test'} = "NO";
+	 print "  $system -- NOT OK\n";
+    }
+}
+
+#-> sub CPAN::Distribution::clean ;
+sub clean {
+    my($self) = @_;
+    print "Running make clean\n";
+  EXCUSE: {
+	my @e;
+	exists $self->{'build_dir'} or push @e, "Has no own directory";
+	print join "", map {"  $_\n"} @e and return if @e;
+    }
+    chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
+    $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
+    my $system = join " ", $CPAN::Config->{'make'}, "clean";
+    if (system($system) == 0) {
+	print "  $system -- OK\n";
+	$self->force;
+    } else {
+	# Hmmm, what to do if make clean failed?
+    }
+}
+
+#-> sub CPAN::Distribution::install ;
+sub install {
+    my($self) = @_;
+    $self->test;
+    return if $CPAN::Signal;
+    print "Running make install\n";
+  EXCUSE: {
+	my @e;
+	exists $self->{'build_dir'} or push @e, "Has no own directory";
+
+	exists $self->{'make'} or push @e,
+	"Make had some problems, maybe interrupted? Won't install";
+
+	exists $self->{'make'} and
+	    $self->{'make'} eq 'NO' and
+		push @e, "Oops, make had returned bad status";
+
+	push @e, "make test had returned bad status, won't install without force"
+	    if exists $self->{'make_test'} and
+	    $self->{'make_test'} eq 'NO' and
+	    ! $self->{'force_update'};
+
+	exists $self->{'install'} and push @e,
+	$self->{'install'} eq "YES" ?
+	    "Already done" : "Already tried without success";
+
+	print join "", map {"  $_\n"} @e and return if @e;
+    }
+    chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
+    $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
+    my $system = join " ", $CPAN::Config->{'make'}, "install", $CPAN::Config->{make_install_arg};
+    my($pipe) = FileHandle->new("$system 2>&1 |");
+    my($makeout) = "";
+    while (<$pipe>){
+	print;
+	$makeout .= $_;
+    }
+    $pipe->close;
+    if ($?==0) {
+	 print "  $system -- OK\n";
+	 $self->{'install'} = "YES";
+    } else {
+	 $self->{'install'} = "NO";
+	 print "  $system -- NOT OK\n";
+	 if ($makeout =~ /permission/s && $> > 0) {
+	     print "    You may have to su to root to install the package\n";
+	 }
+    }
+}
+
+#-> sub CPAN::Distribution::dir ;
+sub dir {
+    shift->{'build_dir'};
+}
+
+package CPAN::Bundle;
+@CPAN::Bundle::ISA = qw(CPAN::Module);
+
+#-> sub CPAN::Bundle::as_string ;
+sub as_string {
+    my($self) = @_;
+    $self->contains;
+    $self->{INST_VERSION} = $self->inst_version;
+    return $self->SUPER::as_string;
+}
+
+#-> sub CPAN::Bundle::contains ;
+sub contains {
+    my($self) = @_;
+    my($parsefile) = $self->inst_file;
+    unless ($parsefile) {
+	# Try to get at it in the cpan directory
+	$self->debug("no parsefile") if $CPAN::DEBUG;
+	my $dist = $CPAN::META->instance('CPAN::Distribution',$self->{'CPAN_FILE'});
+	$dist->get;
+	$self->debug($dist->as_string) if $CPAN::DEBUG;
+	my($todir) = $CPAN::META->catdir($CPAN::Config->{'cpan_home'},"Bundle");
+	File::Path::mkpath($todir);
+	my($me,$from,$to);
+	($me = $self->id) =~ s/.*://;
+	$from = $self->find_bundle_file($dist->{'build_dir'},"$me.pm");
+	$to = $CPAN::META->catfile($todir,"$me.pm");
+	File::Copy::copy($from, $to) or Carp::confess("Couldn't copy $from to $to: $!");
+	$parsefile = $to;
+    }
+    my @result;
+    my $fh = new FileHandle;
+    local $/ = "\n";
+    open($fh,$parsefile) or die "Could not open '$parsefile': $!";
+    my $inpod = 0;
+    $self->debug("parsefile[$parsefile]") if $CPAN::DEBUG;
+    while (<$fh>) {
+	$inpod = /^=(?!head1\s+CONTENTS)/ ? 0 : /^=head1\s+CONTENTS/ ? 1 : $inpod;
+	next unless $inpod;
+	next if /^=/;
+	next if /^\s+$/;
+	chomp;
+	push @result, (split " ", $_, 2)[0];
+    }
+    close $fh;
+    delete $self->{STATUS};
+    $self->{CONTAINS} = join ", ", @result;
+    $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
+    @result;
+}
+
+#-> sub CPAN::Bundle::find_bundle_file
+sub find_bundle_file {
+    my($self,$where,$what) = @_;
+    my $bu = $CPAN::META->catfile($where,$what);
+    return $bu if -f $bu;
+    my $manifest = $CPAN::META->catfile($where,"MANIFEST");
+    unless (-f $manifest) {
+	require ExtUtils::Manifest;
+	my $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
+	my $cwd = Cwd->$getcwd();
+	chdir $where;
+	ExtUtils::Manifest::mkmanifest();
+	chdir $cwd;
+    }
+    my $fh = FileHandle->new($manifest) or Carp::croak("Couldn't open $manifest: $!");
+    local($/) = "\n";
+    while (<$fh>) {
+	next if /^\s*\#/;
+	my($file) = /(\S+)/;
+	if ($file =~ m|Bundle/$what$|) {
+	    $bu = $file;
+	    return $CPAN::META->catfile($where,$bu);
+	}
+    }
+    Carp::croak("Could't find a Bundle file in $where");
+}
+
+#-> sub CPAN::Bundle::inst_file ;
+sub inst_file {
+    my($self) = @_;
+    my($me,$inst_file);
+    ($me = $self->id) =~ s/.*://;
+    $inst_file = $CPAN::META->catfile($CPAN::Config->{'cpan_home'},"Bundle", "$me.pm");
+    return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
+#    $inst_file = 
+    $self->SUPER::inst_file;
+#    return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
+#    return $self->{'INST_FILE'}; # even if undefined?
+}
+
+#-> sub CPAN::Bundle::rematein ;
+sub rematein {
+    my($self,$meth) = @_;
+    $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
+    my($s);
+    for $s ($self->contains) {
+	my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
+	    $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
+	if ($type eq 'CPAN::Distribution') {
+	    warn qq{
+The Bundle }.$self->id.qq{ contains
+explicitly a file $s.
+};
+	    sleep 3;
+	}
+	$CPAN::META->instance($type,$s)->$meth();
+    }
+}
+
+#sub CPAN::Bundle::xs_file
+sub xs_file {
+    # If a bundle contains another that contains an xs_file we have
+    # here, we just don't bother I suppose
+    return 0;
+}
+
+#-> sub CPAN::Bundle::force ;
+sub force   { shift->rematein('force',@_); }
+#-> sub CPAN::Bundle::get ;
+sub get     { shift->rematein('get',@_); }
+#-> sub CPAN::Bundle::make ;
+sub make    { shift->rematein('make',@_); }
+#-> sub CPAN::Bundle::test ;
+sub test    { shift->rematein('test',@_); }
+#-> sub CPAN::Bundle::install ;
+sub install { shift->rematein('install',@_); }
+#-> sub CPAN::Bundle::clean ;
+sub clean   { shift->rematein('clean',@_); }
+
+#-> sub CPAN::Bundle::readme ;
+sub readme  {
+    my($self) = @_;
+    my($file) = $self->cpan_file or print("No File found for bundle ", $self->id, "\n"), return;
+    $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
+    $CPAN::META->instance('CPAN::Distribution',$file)->readme;
+}
+
+package CPAN::Module;
+@CPAN::Module::ISA = qw(CPAN::InfoObj);
+
+#-> sub CPAN::Module::as_glimpse ;
+sub as_glimpse {
+    my($self) = @_;
+    my(@m);
+    my $class = ref($self);
+    $class =~ s/^CPAN:://;
+    push @m, sprintf "%-15s %-15s (%s)\n", $class, $self->{ID}, $self->cpan_file;
+    join "", @m;
+}
+
+#-> sub CPAN::Module::as_string ;
+sub as_string {
+    my($self) = @_;
+    my(@m);
+    CPAN->debug($self) if $CPAN::DEBUG;
+    my $class = ref($self);
+    $class =~ s/^CPAN:://;
+    local($^W) = 0;
+    push @m, $class, " id = $self->{ID}\n";
+    my $sprintf = "    %-12s %s\n";
+    push @m, sprintf $sprintf, 'DESCRIPTION', $self->{description} if $self->{description};
+    my $sprintf2 = "    %-12s %s (%s)\n";
+    my($userid);
+    if ($userid = $self->{'CPAN_USERID'} || $self->{'userid'}){
+	push @m, sprintf(
+			 $sprintf2,
+			 'CPAN_USERID',
+			 $userid,
+			 CPAN::Shell->expand('Author',$userid)->fullname
+			)
+    }
+    push @m, sprintf $sprintf, 'CPAN_VERSION', $self->{CPAN_VERSION} if $self->{CPAN_VERSION};
+    push @m, sprintf $sprintf, 'CPAN_FILE', $self->{CPAN_FILE} if $self->{CPAN_FILE};
+    my $sprintf3 = "    %-12s %1s%1s%1s%1s (%s,%s,%s,%s)\n";
+    my(%statd,%stats,%statl,%stati);
+    @statd{qw,? i c a b R M S,} = qw,unknown idea pre-alpha alpha beta released mature standard,;
+    @stats{qw,? m d u n,}       = qw,unknown mailing-list developer comp.lang.perl.* none,;
+    @statl{qw,? p c + o,}       = qw,unknown perl C C++ other,;
+    @stati{qw,? f r O,}         = qw,unknown functions references+ties object-oriented,;
+    $statd{' '} = 'unknown';
+    $stats{' '} = 'unknown';
+    $statl{' '} = 'unknown';
+    $stati{' '} = 'unknown';
+    push @m, sprintf(
+		     $sprintf3,
+		     'DSLI_STATUS',
+		     $self->{statd},
+		     $self->{stats},
+		     $self->{statl},
+		     $self->{stati},
+		     $statd{$self->{statd}},
+		     $stats{$self->{stats}},
+		     $statl{$self->{statl}},
+		     $stati{$self->{stati}}
+		    ) if $self->{statd};
+    my $local_file = $self->inst_file;
+    if ($local_file && ! exists $self->{MANPAGE}) {
+	my $fh = FileHandle->new($local_file) or Carp::croak("Couldn't open $local_file: $!");
+	my $inpod = 0;
+	my(@result);
+	local $/ = "\n";
+	while (<$fh>) {
+	    $inpod = /^=(?!head1\s+NAME)/ ? 0 : /^=head1\s+NAME/ ? 1 : $inpod;
+	    next unless $inpod;
+	    next if /^=/;
+	    next if /^\s+$/;
+	    chomp;
+	    push @result, $_;
+	}
+	close $fh;
+	$self->{MANPAGE} = join " ", @result;
+    }
+    my($item);
+    for $item (qw/MANPAGE CONTAINS/) {
+	push @m, sprintf $sprintf, $item, $self->{$item} if exists $self->{$item};
+    }
+    push @m, sprintf $sprintf, 'INST_FILE', $local_file || "(not installed)";
+    push @m, sprintf $sprintf, 'INST_VERSION', $self->inst_version if $local_file;
+    join "", @m, "\n";
+}
+
+#-> sub CPAN::Module::cpan_file ;
+sub cpan_file    {
+    my $self = shift;
+    CPAN->debug($self->id) if $CPAN::DEBUG;
+    unless (defined $self->{'CPAN_FILE'}) {
+	CPAN::Index->reload;
+    }
+    if (defined $self->{'CPAN_FILE'}){
+	return $self->{'CPAN_FILE'};
+    } elsif (defined $self->{'userid'}) {
+	return "Contact Author ".$self->{'userid'}."=".$CPAN::META->instance(CPAN::Author,$self->{'userid'})->fullname
+    } else {
+	return "N/A";
+    }
+}
+
+*name = \&cpan_file;
+
+#-> sub CPAN::Module::cpan_version ;
+sub cpan_version { shift->{'CPAN_VERSION'} }
+
+#-> sub CPAN::Module::force ;
+sub force {
+    my($self) = @_;
+    $self->{'force_update'}++;
+}
+
+#-> sub CPAN::Module::rematein ;
+sub rematein {
+    my($self,$meth) = @_;
+    $self->debug($self->id) if $CPAN::DEBUG;
+    my $cpan_file = $self->cpan_file;
+    return if $cpan_file eq "N/A";
+    return if $cpan_file =~ /^Contact Author/;
+    my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
+    $pack->called_for($self->id);
+    $pack->force if exists $self->{'force_update'};
+    $pack->$meth();
+    delete $self->{'force_update'};
+}
+
+#-> sub CPAN::Module::readme ;
+sub readme { shift->rematein('readme') }
+#-> sub CPAN::Module::look ;
+sub look { shift->rematein('look') }
+#-> sub CPAN::Module::get ;
+sub get    { shift->rematein('get',@_); }
+#-> sub CPAN::Module::make ;
+sub make   { shift->rematein('make') }
+#-> sub CPAN::Module::test ;
+sub test   { shift->rematein('test') }
+#-> sub CPAN::Module::install ;
+sub install {
+    my($self) = @_;
+    my($doit) = 0;
+    my($latest) = $self->cpan_version;
+    $latest ||= 0;
+    my($inst_file) = $self->inst_file;
+    my($have) = 0;
+    if (defined $inst_file) {
+	$have = $self->inst_version;
+    }
+    if (1){ # A block for scoping $^W, the if is just for the visual
+            # appeal
+	local($^W)=0;
+	if ($inst_file && $have >= $latest && not exists $self->{'force_update'}) {
+	    print $self->id, " is up to date.\n";
+	} else {
+	    $doit = 1;
+	}
+    }
+    $self->rematein('install') if $doit;
+}
+#-> sub CPAN::Module::clean ;
+sub clean  { shift->rematein('clean') }
+
+#-> sub CPAN::Module::inst_file ;
+sub inst_file {
+    my($self) = @_;
+    my($dir,@packpath);
+    @packpath = split /::/, $self->{ID};
+    $packpath[-1] .= ".pm";
+    foreach $dir (@INC) {
+	my $pmfile = CPAN->catfile($dir,@packpath);
+	if (-f $pmfile){
+	    return $pmfile;
+	}
+    }
+    return;
+}
+
+#-> sub CPAN::Module::xs_file ;
+sub xs_file {
+    my($self) = @_;
+    my($dir,@packpath);
+    @packpath = split /::/, $self->{ID};
+    push @packpath, $packpath[-1];
+    $packpath[-1] .= "." . $Config::Config{'dlext'};
+    foreach $dir (@INC) {
+	my $xsfile = CPAN->catfile($dir,'auto',@packpath);
+	if (-f $xsfile){
+	    return $xsfile;
+	}
+    }
+    return;
+}
+
+#-> sub CPAN::Module::inst_version ;
+sub inst_version {
+    my($self) = @_;
+    my $parsefile = $self->inst_file or return 0;
+    local($^W) = 0 if $] < 5.00303 && $ExtUtils::MakeMaker::VERSION < 5.38;
+    my $have = MM->parse_version($parsefile);
+    $have ||= 0;
+    $have =~ s/\s+//g;
+    $have ||= 0;
+    $have;
+}
+
+# Do this after you have set up the whole inheritance
+CPAN::Config->load unless defined $CPAN::No_Config_is_ok;
+
+1;
+__END__
+
+=head1 NAME
+
+CPAN - query, download and build perl modules from CPAN sites
+
+=head1 SYNOPSIS
+
+Interactive mode:
+
+  perl -MCPAN -e shell;
+
+Batch mode:
+
+  use CPAN;
+
+  autobundle, clean, install, make, recompile, test
+
+=head1 DESCRIPTION
+
+The CPAN module is designed to automate the make and install of perl
+modules and extensions. It includes some searching capabilities and
+knows how to use Net::FTP or LWP (or lynx or an external ftp client)
+to fetch the raw data from the net.
+
+Modules are fetched from one or more of the mirrored CPAN
+(Comprehensive Perl Archive Network) sites and unpacked in a dedicated
+directory.
+
+The CPAN module also supports the concept of named and versioned
+'bundles' of modules. Bundles simplify the handling of sets of
+related modules. See BUNDLES below.
+
+The package contains a session manager and a cache manager. There is
+no status retained between sessions. The session manager keeps track
+of what has been fetched, built and installed in the current
+session. The cache manager keeps track of the disk space occupied by
+the make processes and deletes excess space according to a simple FIFO
+mechanism.
+
+All methods provided are accessible in a programmer style and in an
+interactive shell style.
+
+=head2 Interactive Mode
+
+The interactive mode is entered by running
+
+    perl -MCPAN -e shell
+
+which puts you into a readline interface. You will have most fun if
+you install Term::ReadKey and Term::ReadLine to enjoy both history and
+completion.
+
+Once you are on the command line, type 'h' and the rest should be
+self-explanatory.
+
+The most common uses of the interactive modes are
+
+=over 2
+
+=item Searching for authors, bundles, distribution files and modules
+
+There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
+for each of the four categories and another, C<i> for any of the
+mentioned four. Each of the four entities is implemented as a class
+with slightly differing methods for displaying an object.
+
+Arguments you pass to these commands are either strings matching exact
+the identification string of an object or regular expressions that are
+then matched case-insensitively against various attributes of the
+objects. The parser recognizes a regualar expression only if you
+enclose it between two slashes.
+
+The principle is that the number of found objects influences how an
+item is displayed. If the search finds one item, we display the result
+of object-E<gt>as_string, but if we find more than one, we display
+each as object-E<gt>as_glimpse. E.g.
+
+    cpan> a ANDK     
+    Author id = ANDK
+	EMAIL        a.koenig@franz.ww.TU-Berlin.DE
+	FULLNAME     Andreas König
+
+
+    cpan> a /andk/   
+    Author id = ANDK
+	EMAIL        a.koenig@franz.ww.TU-Berlin.DE
+	FULLNAME     Andreas König
+
+
+    cpan> a /and.*rt/
+    Author          ANDYD (Andy Dougherty)
+    Author          MERLYN (Randal L. Schwartz)
+
+=item make, test, install, clean  modules or distributions
+
+These commands do indeed exist just as written above. Each of them
+takes any number of arguments and investigates for each what it might
+be. Is it a distribution file (recognized by embedded slashes), this
+file is being processed. Is it a module, CPAN determines the
+distribution file where this module is included and processes that.
+
+Any C<make>, C<test>, and C<readme> are run unconditionally. A 
+
+  install <distribution_file>
+
+also is run unconditionally.  But for 
+
+  install <module>
+
+CPAN checks if an install is actually needed for it and prints
+I<Foo up to date> in case the module doesnE<39>t need to be updated.
+
+CPAN also keeps track of what it has done within the current session
+and doesnE<39>t try to build a package a second time regardless if it
+succeeded or not. The C<force > command takes as first argument the
+method to invoke (currently: make, test, or install) and executes the
+command from scratch.
+
+Example:
+
+    cpan> install OpenGL
+    OpenGL is up to date.
+    cpan> force install OpenGL
+    Running make
+    OpenGL-0.4/
+    OpenGL-0.4/COPYRIGHT
+    [...]
+
+=item readme, look module or distribution
+
+These two commands take only one argument, be it a module or a
+distribution file. C<readme> displays the README of the associated
+distribution file. C<Look> gets and untars (if not yet done) the
+distribution file, changes to the appropriate directory and opens a
+subshell process in that directory.
+
+=back
+
+=head2 CPAN::Shell
+
+The commands that are available in the shell interface are methods in
+the package CPAN::Shell. If you enter the shell command, all your
+input is split by the Text::ParseWords::shellwords() routine which
+acts like most shells do. The first word is being interpreted as the
+method to be called and the rest of the words are treated as arguments
+to this method.
+
+=head2 autobundle
+
+C<autobundle> writes a bundle file into the
+C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
+a list of all modules that are both available from CPAN and currently
+installed within @INC. The name of the bundle file is based on the
+current date and a counter.
+
+=head2 recompile
+
+recompile() is a very special command in that it takes no argument and
+runs the make/test/install cycle with brute force over all installed
+dynamically loadable extensions (aka XS modules) with 'force' in
+effect. Primary purpose of this command is to finish a network
+installation. Imagine, you have a common source tree for two different
+architectures. You decide to do a completely independent fresh
+installation. You start on one architecture with the help of a Bundle
+file produced earlier. CPAN installs the whole Bundle for you, but
+when you try to repeat the job on the second architecture, CPAN
+responds with a C<"Foo up to date"> message for all modules. So you
+will be glad to run recompile in the second architecture and
+youE<39>re done.
+
+Another popular use for C<recompile> is to act as a rescue in case your
+perl breaks binary compatibility. If one of the modules that CPAN uses
+is in turn depending on binary compatibility (so you cannot run CPAN
+commands), then you should try the CPAN::Nox module for recovery.
+
+=head2 The 4 Classes: Authors, Bundles, Modules, Distributions
+
+Although it may be considered internal, the class hierarchie does
+matter for both users and programmer. CPAN.pm deals with above
+mentioned four classes, and all those classes share a set of
+methods. It is a classical single polymorphism that is in effect.  A
+metaclass object registers all objects of all kinds and indexes them
+with a string. The strings referencing objects have a separated
+namespace (well, not completely separated):
+
+         Namespace                         Class
+
+   words containing a "/" (slash)      Distribution
+    words starting with Bundle::          Bundle
+          everything else            Module or Author
+
+Modules know their associated Distribution objects. They always refer
+to the most recent official release. Developers may mark their
+releases as unstable development versions (by inserting an underbar
+into the visible version number), so not always is the default
+distribution for a given module the really hottest and newest. If a
+module Foo circulates on CPAN in both version 1.23 and 1.23_90,
+CPAN.pm offers a convenient way to install version 1.23 by saying
+
+    install Foo
+
+This would install the complete distribution file (say
+BAR/Foo-1.23.tar.gz) with all accompanying material in there. But if
+you would like to install version 1.23_90, you need to know where the
+distribution file resides on CPAN relative to the authors/id/
+directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz,
+so he would have say
+
+    install BAR/Foo-1.23_90.tar.gz
+
+The first example will be driven by an object of the class
+CPAN::Module, the second by an object of class Distribution.
+
+=head2 ProgrammerE<39>s interface
+
+If you do not enter the shell, the available shell commands are both
+available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
+functions in the calling package (C<install(...)>).
+
+There's currently only one class that has a stable interface,
+CPAN::Shell. All commands that are available in the CPAN shell are
+methods of the class CPAN::Shell. The commands that produce listings
+of modules (C<r>, C<autobundle>, C<u>) return a list of the IDs of all
+modules within the list.
+
+=over 2
+
+=item expand($type,@things)
+
+The IDs of all objects available within a program are strings that can
+be expanded to the corresponding real objects with the
+C<CPAN::Shell-E<gt>expand()> method. Expand returns a list of
+CPAN::Module objects according to the C<@things> arguments given. In
+scalar context it only returns the first element of the list.
+
+=item Programming Examples
+
+This enables the programmer to do operations like these:
+
+    # install everything that is outdated on my disk:
+    perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
+
+    # install my favorite programs if necessary:
+    for $mod (qw(Net::FTP MD5 Data::Dumper)){
+        my $obj = CPAN::Shell->expand('Module',$mod);
+        $obj->install;
+    }
+
+=back
+
+=head2 Cache Manager
+
+Currently the cache manager only keeps track of the build directory
+($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
+deletes complete directories below C<build_dir> as soon as the size of
+all directories there gets bigger than $CPAN::Config->{build_cache}
+(in MB). The contents of this cache may be used for later
+re-installations that you intend to do manually, but will never be
+trusted by CPAN itself. This is due to the fact that the user might
+use these directories for building modules on different architectures.
+
+There is another directory ($CPAN::Config->{keep_source_where}) where
+the original distribution files are kept. This directory is not
+covered by the cache manager and must be controlled by the user. If
+you choose to have the same directory as build_dir and as
+keep_source_where directory, then your sources will be deleted with
+the same fifo mechanism.
+
+=head2 Bundles
+
+A bundle is just a perl module in the namespace Bundle:: that does not
+define any functions or methods. It usually only contains documentation.
+
+It starts like a perl module with a package declaration and a $VERSION
+variable. After that the pod section looks like any other pod with the
+only difference, that I<one special pod section> exists starting with
+(verbatim):
+
+	=head1 CONTENTS
+
+In this pod section each line obeys the format
+
+        Module_Name [Version_String] [- optional text]
+
+The only required part is the first field, the name of a module
+(eg. Foo::Bar, ie. I<not> the name of the distribution file). The rest
+of the line is optional. The comment part is delimited by a dash just
+as in the man page header.
+
+The distribution of a bundle should follow the same convention as
+other distributions.
+
+Bundles are treated specially in the CPAN package. If you say 'install
+Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
+the modules in the CONTENTS section of the pod.  You can install your
+own Bundles locally by placing a conformant Bundle file somewhere into
+your @INC path. The autobundle() command which is available in the
+shell interface does that for you by including all currently installed
+modules in a snapshot bundle file.
+
+There is a meaningless Bundle::Demo available on CPAN. Try to install
+it, it usually does no harm, just demonstrates what the Bundle
+interface looks like.
+
+=head2 Prerequisites
+
+If you have a local mirror of CPAN and can access all files with
+"file:" URLs, then you only need a perl better than perl5.003 to run
+this module. Otherwise Net::FTP is strongly recommended. LWP may be
+required for non-UNIX systems or if your nearest CPAN site is
+associated with an URL that is not C<ftp:>.
+
+If you have neither Net::FTP nor LWP, there is a fallback mechanism
+implemented for an external ftp command or for an external lynx
+command.
+
+This module presumes that all packages on CPAN
+
+=over 2
+
+=item *
+
+declare their $VERSION variable in an easy to parse manner. This
+prerequisite can hardly be relaxed because it consumes by far too much
+memory to load all packages into the running program just to determine
+the $VERSION variable . Currently all programs that are dealing with
+version use something like this
+
+    perl -MExtUtils::MakeMaker -le \
+        'print MM->parse_version($ARGV[0])' filename
+
+If you are author of a package and wonder if your $VERSION can be
+parsed, please try the above method.
+
+=item *
+
+come as compressed or gzipped tarfiles or as zip files and contain a
+Makefile.PL (well we try to handle a bit more, but without much
+enthusiasm).
+
+=back
+
+=head2 Debugging
+
+The debugging of this module is pretty difficult, because we have
+interferences of the software producing the indices on CPAN, of the
+mirroring process on CPAN, of packaging, of configuration, of
+synchronicity, and of bugs within CPAN.pm.
+
+In interactive mode you can try "o debug" which will list options for
+debugging the various parts of the package. The output may not be very
+useful for you as it's just a byproduct of my own testing, but if you
+have an idea which part of the package may have a bug, it's sometimes
+worth to give it a try and send me more specific output. You should
+know that "o debug" has built-in completion support.
+
+=head2 Floppy, Zip, and all that Jazz
+
+CPAN.pm works nicely without network too. If you maintain machines
+that are not networked at all, you should consider working with file:
+URLs. Of course, you have to collect your modules somewhere first. So
+you might use CPAN.pm to put together all you need on a networked
+machine. Then copy the $CPAN::Config->{keep_source_where} (but not
+$CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
+of a personal CPAN. CPAN.pm on the non-networked machines works nicely
+with this floppy.
+
+=head1 CONFIGURATION
+
+When the CPAN module is installed a site wide configuration file is
+created as CPAN/Config.pm. The default values defined there can be
+overridden in another configuration file: CPAN/MyConfig.pm. You can
+store this file in $HOME/.cpan/CPAN/MyConfig.pm if you want, because
+$HOME/.cpan is added to the search path of the CPAN module before the
+use() or require() statements.
+
+Currently the following keys in the hash reference $CPAN::Config are
+defined:
+
+  build_cache        size of cache for directories to build modules
+  build_dir          locally accessible directory to build modules
+  index_expire       after how many days refetch index files
+  cpan_home          local directory reserved for this package
+  gzip		     location of external program gzip
+  inactivity_timeout breaks interactive Makefile.PLs after that
+                     many seconds inactivity. Set to 0 to never break.
+  inhibit_startup_message
+                     if true, does not print the startup message
+  keep_source        keep the source in a local directory?
+  keep_source_where  where keep the source (if we do)
+  make               location of external program make
+  make_arg	     arguments that should always be passed to 'make'
+  make_install_arg   same as make_arg for 'make install'
+  makepl_arg	     arguments passed to 'perl Makefile.PL'
+  pager              location of external program more (or any pager)
+  tar                location of external program tar
+  unzip              location of external program unzip
+  urllist	     arrayref to nearby CPAN sites (or equivalent locations)
+
+You can set and query each of these options interactively in the cpan
+shell with the command set defined within the C<o conf> command:
+
+=over 2
+
+=item o conf E<lt>scalar optionE<gt>
+
+prints the current value of the I<scalar option>
+
+=item o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>
+
+Sets the value of the I<scalar option> to I<value>
+
+=item o conf E<lt>list optionE<gt>
+
+prints the current value of the I<list option> in MakeMaker's
+neatvalue format.
+
+=item o conf E<lt>list optionE<gt> [shift|pop]
+
+shifts or pops the array in the I<list option> variable
+
+=item o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>
+
+works like the corresponding perl commands.
+
+=back
+
+=head1 SECURITY
+
+There's no strong security layer in CPAN.pm. CPAN.pm helps you to
+install foreign, unmasked, unsigned code on your machine. We compare
+to a checksum that comes from the net just as the distribution file
+itself. If somebody has managed to tamper with the distribution file,
+they may have as well tampered with the CHECKSUMS file. Future
+development will go towards strong authentification.
+
+=head1 EXPORT
+
+Most functions in package CPAN are exported per default. The reason
+for this is that the primary use is intended for the cpan shell or for
+oneliners.
+
+=head1 BUGS
+
+we should give coverage for _all_ of the CPAN and not just the
+__PAUSE__ part, right? In this discussion CPAN and PAUSE have become
+equal -- but they are not. PAUSE is authors/ and modules/. CPAN is
+PAUSE plus the clpa/, doc/, misc/, ports/, src/, scripts/.
+
+Future development should be directed towards a better intergration of
+the other parts.
+
+=head1 AUTHOR
+
+Andreas König E<lt>a.koenig@mind.deE<gt>
+
+=head1 SEE ALSO
+
+perl(1), CPAN::Nox(3)
+
+=cut
+
diff --git a/lib/CPAN/FirstTime.pm b/lib/CPAN/FirstTime.pm
new file mode 100644
index 0000000000..8ac180dc71
--- /dev/null
+++ b/lib/CPAN/FirstTime.pm
@@ -0,0 +1,390 @@
+package CPAN::Mirrored::By;
+
+sub new { 
+    my($self,@arg) = @_;
+    bless [@arg], $self;
+}
+sub continent { shift->[0] }
+sub country { shift->[1] }
+sub url { shift->[2] }
+
+package CPAN::FirstTime;
+
+use strict;
+use ExtUtils::MakeMaker qw(prompt);
+use FileHandle ();
+use File::Path ();
+use vars qw($VERSION);
+$VERSION = substr q$Revision: 1.18 $, 10;
+
+=head1 NAME
+
+CPAN::FirstTime - Utility for CPAN::Config file Initialization
+
+=head1 SYNOPSIS
+
+CPAN::FirstTime::init()
+
+=head1 DESCRIPTION
+
+The init routine asks a few questions and writes a CPAN::Config
+file. Nothing special.
+
+=cut
+
+
+sub init {
+    my($configpm) = @_;
+    use Config;
+    require CPAN::Nox;
+    eval {require CPAN::Config;};
+    $CPAN::Config ||= {};
+    local($/) = "\n";
+    local($\) = "";
+
+    my($ans,$default,$local,$cont,$url,$expected_size);
+    
+    #
+    # Files, directories
+    #
+
+    print qq{
+The CPAN module needs a directory of its own to cache important
+index files and maybe keep a temporary mirror of CPAN files. This may
+be a site-wide directory or a personal directory.
+};
+
+    my $cpan_home = $CPAN::Config->{cpan_home} || MM->catdir($ENV{HOME}, ".cpan");
+    if (-d $cpan_home) {
+	print qq{
+
+I see you already have a  directory
+    $cpan_home
+Shall we use it as the general CPAN build and cache directory?
+
+};
+    } else {
+	print qq{
+
+First of all, I\'d like to create this directory. Where?
+
+};
+    }
+
+    $default = $cpan_home;
+    while ($ans = prompt("CPAN build and cache directory?",$default)) {
+	File::Path::mkpath($ans); # dies if it can't
+	if (-d $ans && -w _) {
+	    last;
+	} else {
+	    warn "Couldn't find directory $ans
+  or directory is not writable. Please retry.\n";
+	}
+    }
+    $CPAN::Config->{cpan_home} = $ans;
+    
+    print qq{
+
+If you want, I can keep the source files after a build in the cpan
+home directory. If you choose so then future builds will take the
+files from there. If you don\'t want to keep them, answer 0 to the
+next question.
+
+};
+
+    $CPAN::Config->{keep_source_where} = MM->catdir($CPAN::Config->{cpan_home},"sources");
+    $CPAN::Config->{build_dir} = MM->catdir($CPAN::Config->{cpan_home},"build");
+
+    #
+    # Cache size, Index expire
+    #
+
+    print qq{
+
+How big should the disk cache be for keeping the build directories
+with all the intermediate files?
+
+};
+
+    $default = $CPAN::Config->{build_cache} || 10;
+    $ans = prompt("Cache size for build directory (in MB)?", $default);
+    $CPAN::Config->{build_cache} = $ans;
+
+    # XXX This the time when we refetch the index files (in days)
+    $CPAN::Config->{'index_expire'} = 1;
+
+    #
+    # External programs
+    #
+
+    print qq{
+
+The CPAN module will need a few external programs to work
+properly. Please correct me, if I guess the wrong path for a program.
+Don\'t panic if you do not have some of them, just press ENTER for
+those.
+
+};
+
+    my(@path) = split($Config{path_sep},$ENV{PATH});
+    my $prog;
+    for $prog (qw/gzip tar unzip make lynx ncftp ftp/){
+	my $path = $CPAN::Config->{$prog} || find_exe($prog,[@path]) || $prog;
+	$ans = prompt("Where is your $prog program?",$path) || $path;
+	$CPAN::Config->{$prog} = $ans;
+    }
+    my $path = $CPAN::Config->{'pager'} || 
+	$ENV{PAGER} || find_exe("less",[@path]) || 
+	    find_exe("more",[@path]) || "more";
+    $ans = prompt("What is your favorite pager program?",$path) || $path;
+    $CPAN::Config->{'pager'} = $ans;
+    $path = $CPAN::Config->{'shell'} || $ENV{SHELL} || "";
+    $ans = prompt("What is your favorite shell?",$path) || $path;
+    $CPAN::Config->{'shell'} = $ans;
+
+    #
+    # Arguments to make etc.
+    #
+
+    print qq{
+
+Every Makefile.PL is run by perl in a separate process. Likewise we
+run \'make\' and \'make install\' in processes. If you have any parameters
+\(e.g. PREFIX, INSTALLPRIVLIB, UNINST or the like\) you want to pass to
+the calls, please specify them here.
+
+If you don\'t understand this question, just press ENTER.
+
+};
+
+    $default = $CPAN::Config->{makepl_arg} || "";
+    $CPAN::Config->{makepl_arg} =
+	prompt("Parameters for the 'perl Makefile.PL' command?",$default);
+    $default = $CPAN::Config->{make_arg} || "";
+    $CPAN::Config->{make_arg} = prompt("Parameters for the 'make' command?",$default);
+
+    $default = $CPAN::Config->{make_install_arg} || $CPAN::Config->{make_arg} || "";
+    $CPAN::Config->{make_install_arg} =
+	prompt("Parameters for the 'make install' command?",$default);
+
+    #
+    # Alarm period
+    #
+
+    print qq{
+
+Sometimes you may wish to leave the processes run by CPAN alone
+without caring about them. As sometimes the Makefile.PL contains
+question you\'re expected to answer, you can set a timer that will
+kill a 'perl Makefile.PL' process after the specified time in seconds.
+
+If you set this value to 0, these processes will wait forever. This is
+the default and recommended setting.
+
+};
+
+    $default = $CPAN::Config->{inactivity_timeout} || 0;
+    $CPAN::Config->{inactivity_timeout} =
+	prompt("Timout for inacivity during Makefile.PL?",$default);
+
+
+    #
+    # MIRRORED.BY
+    #
+
+    $local = 'MIRRORED.BY';
+    $local = MM->catfile($CPAN::Config->{keep_source_where},"MIRRORED.BY") unless -f $local;
+    if (@{$CPAN::Config->{urllist}||[]}) {
+	print qq{
+I found a list of URLs in CPAN::Config and will use this.
+You can change it later with the 'o conf' command.
+
+}
+    } elsif (
+	     -s $local
+	     &&
+	     -M $local < 30
+	    ) {
+	read_mirrored_by($local);
+    } else {
+	$CPAN::Config->{urllist} ||= [];
+	while (! @{$CPAN::Config->{urllist}}) {
+	    my($input) = prompt(qq{
+We need to know the URL of your favorite CPAN site.
+Please enter it here:});
+	    $input =~ s/\s//g;
+	    next unless $input;
+	    my($wanted) = "MIRRORED.BY";
+	    print qq{
+Testing "$input" ...
+};
+	    push @{$CPAN::Config->{urllist}}, $input;
+	    CPAN::FTP->localize($wanted,$local,"force");
+	    if (-s $local) {
+		print qq{
+"$input" seems to work
+};
+	    } else {
+		my $ans = prompt(qq{$input doesn\'t seem to work. Keep it in the list?},"n");
+		last unless $ans =~ /^n/i;
+		pop @{$CPAN::Config->{urllist}};
+	    }
+	}
+    }
+
+    unless (@{$CPAN::Config->{'wait_list'}||[]}) {
+	print qq{
+
+WAIT support is available as a Plugin. You need the CPAN::WAIT module
+to actually use it.  But we need to know your favorite WAIT server. If
+you don\'t know a WAIT server near you, just press ENTER.
+
+};
+	$default = "wait://ls6.informatik.uni-dortmund.de:1404";
+	$ans = prompt("Your favorite WAIT server?\n  ",$default);
+	push @{$CPAN::Config->{'wait_list'}}, $ans;
+    }
+
+    print qq{
+
+If you\'re accessing the net via proxies, you can specify them in the
+CPAN configuration or via environment variables. The variable in
+the \$CPAN::Config takes precedence.
+
+};
+
+    for (qw/ftp_proxy http_proxy no_proxy/) {
+	$default = $CPAN::Config->{$_} || $ENV{$_};
+	$CPAN::Config->{$_} = prompt("Your $_?",$default);
+    }
+
+    # We don't ask that now, it will be noticed in time, won't it?
+    $CPAN::Config->{'inhibit_startup_message'} = 0;
+    $CPAN::Config->{'getcwd'} = 'cwd';
+
+    print "\n\n";
+    CPAN::Config->commit($configpm);
+}
+
+sub find_exe {
+    my($exe,$path) = @_;
+    my($dir,$MY);
+    $MY = {};
+    bless $MY, 'MY';
+    for $dir (@$path) {
+	my $abs = $MY->catfile($dir,$exe);
+	if ($MY->maybe_command($abs)) {
+	    return $abs;
+	}
+    }
+}
+
+sub read_mirrored_by {
+    my($local) = @_;
+    my(%all,$url,$expected_size,$default,$ans,$host,$dst,$country,$continent,@location);
+    my $fh = FileHandle->new;
+    $fh->open($local) or die "Couldn't open $local: $!";
+    while (<$fh>) {
+	($host) = /^([\w\.\-]+)/ unless defined $host;
+	next unless defined $host;
+	next unless /\s+dst_(dst|location)/;
+	/location\s+=\s+\"([^\"]+)/ and @location = (split /\s*,\s*/, $1) and
+	    ($continent, $country) = @location[-1,-2];
+	$continent =~ s/\s\(.*//;
+	/dst_dst\s+=\s+\"([^\"]+)/  and $dst = $1;
+	next unless $host && $dst && $continent && $country;
+	$all{$continent}{$country}{$dst} = CPAN::Mirrored::By->new($continent,$country,$dst);
+	undef $host;
+	$dst=$continent=$country="";
+    }
+    $fh->close;
+    $CPAN::Config->{urllist} ||= [];
+    if ($expected_size = @{$CPAN::Config->{urllist}}) {
+	for $url (@{$CPAN::Config->{urllist}}) {
+	    # sanity check, scheme+colon, not "q" there:
+	    next unless $url =~ /^\w+:\/./;
+	    $all{"[From previous setup]"}{"found URL"}{$url}=CPAN::Mirrored::By->new('[From previous setup]','found URL',$url);
+	}
+	$CPAN::Config->{urllist} = [];
+    } else {
+	$expected_size = 6;
+    }
+    
+    print qq{
+
+Now we need to know, where your favorite CPAN sites are located. Push
+a few sites onto the array (just in case the first on the array won\'t
+work). If you are mirroring CPAN to your local workstation, specify a
+file: URL.
+
+You can enter the number in front of the URL on the next screen, a
+file:, ftp: or http: URL, or "q" to finish selecting.
+
+};
+
+    $ans = prompt("Press RETURN to continue");
+    my $other;
+    $ans = $other = "";
+    my(%seen);
+    
+    my $pipe = -t *STDIN ? "| $CPAN::Config->{'pager'}" : ">/dev/null";
+    while () {
+	my(@valid,$previous_best);
+	my $fh = FileHandle->new;
+	$fh->open($pipe);
+	{
+	    my($cont,$country,$url,$item);
+	    my(@cont) = sort keys %all;
+	    for $cont (@cont) {
+		$fh->print("    $cont\n");
+		for $country (sort {lc $a cmp lc $b} keys %{$all{$cont}}) {
+		    for $url (sort {lc $a cmp lc $b} keys %{$all{$cont}{$country}}) {
+			my $t = sprintf(
+					"      %-18s (%2d) %s\n",
+					$country,
+					++$item,
+					$url
+				       );
+			if ($cont =~ /^\[/) {
+			    $previous_best ||= $item;
+			}
+			push @valid, $all{$cont}{$country}{$url};
+			$fh->print($t);
+		    }
+		}
+	    }
+	}
+	$fh->close;
+	$previous_best ||= 1;
+	$default =
+	    @{$CPAN::Config->{urllist}} >= $expected_size ? "q" : $previous_best;
+	$ans = prompt(
+		      "\nSelect an$other ftp or file URL or a number (q to finish)",
+		      $default
+		     );
+	my $sel;
+	if ($ans =~ /^\d/) {
+	    my $this = $valid[$ans-1];
+	    my($con,$cou,$url) = ($this->continent,$this->country,$this->url);
+	    push @{$CPAN::Config->{urllist}}, $url unless $seen{$url}++;
+	    delete $all{$con}{$cou}{$url};
+	    #	    print "Was a number [$ans] con[$con] cou[$cou] url[$url]\n";
+	} elsif (@{$CPAN::Config->{urllist}} && $ans =~ /^q/i) {
+	    last;
+	} else {
+	    $ans =~ s|/?$|/|; # has to end with one slash
+	    $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
+	    if ($ans =~ /^\w+:\/./) {
+		push @{$CPAN::Config->{urllist}}, $ans unless $seen{$ans}++;
+	    } else {
+		print qq{"$ans" doesn\'t look like an URL at first sight.
+I\'ll ignore it for now. You can add it to lib/CPAN/Config.pm
+later and report a bug in my Makefile.PL to me (andreas koenig).
+Thanks.\n};
+	    }
+	}
+	$other ||= "other";
+    }
+}
+
+1;
diff --git a/lib/CPAN/Nox.pm b/lib/CPAN/Nox.pm
new file mode 100644
index 0000000000..dc561977c4
--- /dev/null
+++ b/lib/CPAN/Nox.pm
@@ -0,0 +1,33 @@
+BEGIN{$CPAN::Suppress_readline=1 unless defined $CPAN::term;}
+
+use CPAN;
+
+$CPAN::META->hasMD5(0);
+$CPAN::META->hasLWP(0);
+@EXPORT = @CPAN::EXPORT;
+
+*AUTOLOAD = \&CPAN::AUTOLOAD;
+
+=head1 NAME
+
+CPAN::Nox - Wrapper around CPAN.pm without using any XS module
+
+=head1 SYNOPSIS
+
+Interactive mode:
+
+  perl -MCPAN::Nox -e shell;
+
+=head1 DESCRIPTION
+
+This package has the same functionality as CPAN.pm, but tries to
+prevent the usage of compiled extensions during it's own
+execution. It's primary purpose is a rescue in case you upgraded perl
+and broke binary compatibility somehow.
+
+=head1  SEE ALSO
+
+CPAN(3)
+
+=cut
+
diff --git a/lib/Carp.pm b/lib/Carp.pm
index f30bd24135..c0cfe08d44 100644
--- a/lib/Carp.pm
+++ b/lib/Carp.pm
@@ -29,17 +29,21 @@ not where carp() was called.
 
 $CarpLevel = 0;		# How many extra package levels to skip on carp.
 $MaxEvalLen = 0;	# How much eval '...text...' to show. 0 = all.
+$MaxArgLen = 64;        # How much of each argument to print. 0 = all.
+$MaxArgNums = 8;        # How many arguments to print. 0 = all.
 
 require Exporter;
 @ISA = Exporter;
 @EXPORT = qw(confess croak carp);
 
 sub longmess {
-    my $error = shift;
+    my $error = join '', @_;
     my $mess = "";
     my $i = 1 + $CarpLevel;
-    my ($pack,$file,$line,$sub,$eval,$require);
-    while (($pack,$file,$line,$sub,undef,undef,$eval,$require) = caller($i++)) {
+    my ($pack,$file,$line,$sub,$hargs,$eval,$require);
+    my (@a);
+    while (do { { package DB; @a = caller($i++) } } ) {
+      ($pack,$file,$line,$sub,$hargs,undef,$eval,$require) = @a;
 	if ($error =~ m/\n$/) {
 	    $mess .= $error;
 	} else {
@@ -47,7 +51,7 @@ sub longmess {
 	        if ($require) {
 		    $sub = "require $eval";
 		} else {
-		    $eval =~ s/[\\\']/\\$&/g;
+		    $eval =~ s/([\\\'])/\\$1/g;
 		    if ($MaxEvalLen && length($eval) > $MaxEvalLen) {
 			substr($eval,$MaxEvalLen) = '...';
 		    }
@@ -56,30 +60,78 @@ sub longmess {
 	    } elsif ($sub eq '(eval)') {
 		$sub = 'eval {...}';
 	    }
+	    if ($hargs) {
+	      @a = @DB::args;	# must get local copy of args
+	      if ($MaxArgNums and @a > $MaxArgNums) {
+		$#a = $MaxArgNums;
+		$a[$#a] = "...";
+	      }
+	      for (@a) {
+		$_ = "undef", next unless defined $_;
+		if (ref $_) {
+		  $_ .= '';
+		  s/'/\\'/g;
+		}
+		else {
+		  s/'/\\'/g;
+		  substr($_,$MaxArgLen) = '...'
+		    if $MaxArgLen and $MaxArgLen < length;
+		}
+		$_ = "'$_'" unless /^-?[\d.]+$/;
+		s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
+		s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
+	      }
+	      $sub .= '(' . join(', ', @a) . ')';
+	    }
 	    $mess .= "\t$sub " if $error eq "called";
 	    $mess .= "$error at $file line $line\n";
 	}
 	$error = "called";
     }
-    $mess || $error;
+    # this kludge circumvents die's incorrect handling of NUL
+    my $msg = \($mess || $error);
+    $$msg =~ tr/\0//d;
+    $$msg;
 }
 
 sub shortmess {	# Short-circuit &longmess if called via multiple packages
-    my $error = $_[0];	# Instead of "shift"
-    my ($curpack) = caller(1);
+    my $error = join '', @_;
+    my ($prevpack) = caller(1);
     my $extra = $CarpLevel;
     my $i = 2;
     my ($pack,$file,$line);
+    my %isa = ($prevpack,1);
+
+    @isa{@{"${prevpack}::ISA"}} = ()
+	if(defined @{"${prevpack}::ISA"});
+
     while (($pack,$file,$line) = caller($i++)) {
-	if ($pack ne $curpack) {
-	    if ($extra-- > 0) {
-		$curpack = $pack;
-	    }
-	    else {
-		return "$error at $file line $line\n";
-	    }
+	if(defined @{$pack . "::ISA"}) {
+	    my @i = @{$pack . "::ISA"};
+	    my %i;
+	    @i{@i} = ();
+	    @isa{@i,$pack} = ()
+		if(exists $i{$prevpack} || exists $isa{$pack});
 	}
+
+	next
+	    if(exists $isa{$pack});
+
+	if ($extra-- > 0) {
+	    %isa = ($pack,1);
+	    @isa{@{$pack . "::ISA"}} = ()
+		if(defined @{$pack . "::ISA"});
+	}
+	else {
+	    # this kludge circumvents die's incorrect handling of NUL
+	    (my $msg = "$error at $file line $line\n") =~ tr/\0//d;
+	    return $msg;
+	}
+    }
+    continue {
+	$prevpack = $pack;
     }
+
     goto &longmess;
 }
 
diff --git a/lib/Class/Struct.pm b/lib/Class/Struct.pm
new file mode 100644
index 0000000000..eca2c6c5e3
--- /dev/null
+++ b/lib/Class/Struct.pm
@@ -0,0 +1,482 @@
+package Class::Struct;
+
+## See POD after __END__
+
+require 5.002;
+
+use strict;
+use vars qw(@ISA @EXPORT);
+
+use Carp;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(struct);
+
+## Tested on 5.002 and 5.003 without class membership tests:
+my $CHECK_CLASS_MEMBERSHIP = ($] >= 5.003_95);
+
+my $print = 0;
+sub printem {
+    if (@_) { $print = shift }
+    else    { $print++ }
+}
+
+{
+    package Class::Struct::Tie_ISA;
+
+    sub TIEARRAY {
+        my $class = shift;
+        return bless [], $class;
+    }
+
+    sub STORE {
+        my ($self, $index, $value) = @_;
+        Class::Struct::_subclass_error();
+    }
+
+    sub FETCH {
+        my ($self, $index) = @_;
+        $self->[$index];
+    }
+
+    sub DESTROY { }
+}
+
+sub struct {
+
+    # Determine parameter list structure, one of:
+    #   struct( class => [ element-list ])
+    #   struct( class => { element-list })
+    #   struct( element-list )
+    # Latter form assumes current package name as struct name.
+
+    my ($class, @decls);
+    my $base_type = ref $_[1];
+    if ( $base_type eq 'HASH' ) {
+        $class = shift;
+        @decls = %{shift()};
+        _usage_error() if @_;
+    }
+    elsif ( $base_type eq 'ARRAY' ) {
+        $class = shift;
+        @decls = @{shift()};
+        _usage_error() if @_;
+    }
+    else {
+        $base_type = 'ARRAY';
+        $class = (caller())[0];
+        @decls = @_;
+    }
+    _usage_error() if @decls % 2 == 1;
+
+    # Ensure we are not, and will not be, a subclass.
+
+    my $isa = do {
+        no strict 'refs';
+        \@{$class . '::ISA'};
+    };
+    _subclass_error() if @$isa;
+    tie @$isa, 'Class::Struct::Tie_ISA';
+
+    # Create constructor.
+
+    croak "function 'new' already defined in package $class"
+        if do { no strict 'refs'; defined &{$class . "::new"} };
+
+    my @methods = ();
+    my %refs = ();
+    my %arrays = ();
+    my %hashes = ();
+    my %classes = ();
+    my $got_class = 0;
+    my $out = '';
+
+    $out = "{\n  package $class;\n  use Carp;\n  sub new {\n";
+
+    my $cnt = 0;
+    my $idx = 0;
+    my( $cmt, $name, $type, $elem );
+
+    if( $base_type eq 'HASH' ){
+        $out .= "    my(\$r) = {};\n";
+        $cmt = '';
+    }
+    elsif( $base_type eq 'ARRAY' ){
+        $out .= "    my(\$r) = [];\n";
+    }
+    while( $idx < @decls ){
+        $name = $decls[$idx];
+        $type = $decls[$idx+1];
+        push( @methods, $name );
+        if( $base_type eq 'HASH' ){
+            $elem = "{'$name'}";
+        }
+        elsif( $base_type eq 'ARRAY' ){
+            $elem = "[$cnt]";
+            ++$cnt;
+            $cmt = " # $name";
+        }
+        if( $type =~ /^\*(.)/ ){
+            $refs{$name}++;
+            $type = $1;
+        }
+        if( $type eq '@' ){
+            $out .= "    \$r->$elem = [];$cmt\n";
+            $arrays{$name}++;
+        }
+        elsif( $type eq '%' ){
+            $out .= "    \$r->$elem = {};$cmt\n";
+            $hashes{$name}++;
+        }
+        elsif ( $type eq '$') {
+            $out .= "    \$r->$elem = undef;$cmt\n";
+        }
+        elsif( $type =~ /^\w+(?:::\w+)*$/ ){
+            $out .= "    \$r->$elem = '${type}'->new();$cmt\n";
+            $classes{$name} = $type;
+            $got_class = 1;
+        }
+        else{
+            croak "'$type' is not a valid struct element type";
+        }
+        $idx += 2;
+    }
+    $out .= "    bless \$r;\n  }\n";
+
+    # Create accessor methods.
+
+    if ( $got_class && $CHECK_CLASS_MEMBERSHIP ) {
+        $out .= "  use UNIVERSAL;\n";
+    }
+    my( $pre, $pst, $sel );
+    $cnt = 0;
+    foreach $name (@methods){
+        if ( do { no strict 'refs'; defined &{$class . "::$name"} } ) {
+            carp "function '$name' already defined, overrides struct accessor method"
+                if $^W;
+        }
+        else {
+            $pre = $pst = $cmt = $sel = '';
+            if( defined $refs{$name} ){
+                $pre = "\\(";
+                $pst = ")";
+                $cmt = " # returns ref";
+            }
+            $out .= "  sub $name {$cmt\n    my \$r = shift;\n";
+            if( $base_type eq 'ARRAY' ){
+                $elem = "[$cnt]";
+                ++$cnt;
+            }
+            elsif( $base_type eq 'HASH' ){
+                $elem = "{'$name'}";
+            }
+            if( defined $arrays{$name} ){
+                $out .= "    my \$i;\n";
+                $out .= "    \@_ ? (\$i = shift) : return $pre\$r->$elem$pst;\n";
+                $sel = "->[\$i]";
+            }
+            elsif( defined $hashes{$name} ){
+                $out .= "    my \$i;\n";
+                $out .= "    \@_ ? (\$i = shift) : return $pre\$r->$elem$pst;\n";
+                $sel = "->{\$i}";
+            }
+            elsif( defined $classes{$name} ){
+                if ( $CHECK_CLASS_MEMBERSHIP ) {
+                    $out .= "    croak '$name argument is wrong class' if \@_ && ! UNIVERSAL::isa(\$_[0], '$type');\n";
+                }
+            }
+            $out .= "    croak 'Too many args to $name' if \@_ > 1;\n";
+            $out .= "    \@_ ? ($pre\$r->$elem$sel = shift$pst) : $pre\$r->$elem$sel$pst;\n";
+            $out .= "  }\n";
+        }
+    }
+    $out .= "}\n1;\n";
+
+    print $out if $print;
+    my $result = eval $out;
+    carp $@ if $@;
+}
+
+sub _usage_error {
+    confess "struct usage error";
+}
+
+sub _subclass_error {
+    croak 'struct class cannot be a subclass (@ISA not allowed)';
+}
+
+1; # for require
+
+
+__END__
+
+=head1 NAME
+
+Class::Struct - declare struct-like datatypes as Perl classes
+
+=head1 SYNOPSIS
+
+    use Class::Struct;
+            # declare struct, based on array:
+    struct( CLASS_NAME => [ ELEMENT_NAME => ELEMENT_TYPE, ... ]);
+            # declare struct, based on hash:
+    struct( CLASS_NAME => { ELEMENT_NAME => ELEMENT_TYPE, ... });
+
+    package CLASS_NAME;
+    use Class::Struct;
+            # declare struct, based on array, implicit class name:
+    struct( ELEMENT_NAME => ELEMENT_TYPE, ... );
+
+
+    package Myobj;
+    use Class::Struct;
+            # declare struct with four types of elements:
+    struct( s => '$', a => '@', h => '%', c => 'My_Other_Class' );
+
+    $obj = new Myobj;               # constructor
+
+                                    # scalar type accessor:
+    $element_value = $obj->s;           # element value
+    $obj->s('new value');               # assign to element
+
+                                    # array type accessor:
+    $ary_ref = $obj->a;                 # reference to whole array
+    $ary_element_value = $obj->a(2);    # array element value
+    $obj->a(2, 'new value');            # assign to array element
+
+                                    # hash type accessor:
+    $hash_ref = $obj->h;                # reference to whole hash
+    $hash_element_value = $obj->h('x'); # hash element value
+    $obj->h('x', 'new value');        # assign to hash element
+
+                                    # class type accessor:
+    $element_value = $obj->c;           # object reference
+    $obj->c->method(...);               # call method of object
+    $obj->c(new My_Other_Class);        # assign a new object
+
+
+=head1 DESCRIPTION
+
+C<Class::Struct> exports a single function, C<struct>.
+Given a list of element names and types, and optionally
+a class name, C<struct> creates a Perl 5 class that implements
+a "struct-like" data structure.
+
+The new class is given a constructor method, C<new>, for creating
+struct objects.
+
+Each element in the struct data has an accessor method, which is
+used to assign to the element and to fetch its value.  The
+default accessor can be overridden by declaring a C<sub> of the
+same name in the package.  (See Example 2.)
+
+Each element's type can be scalar, array, hash, or class.
+
+
+=head2 The C<struct()> function
+
+The C<struct> function has three forms of parameter-list.
+
+    struct( CLASS_NAME => [ ELEMENT_LIST ]);
+    struct( CLASS_NAME => { ELEMENT_LIST });
+    struct( ELEMENT_LIST );
+
+The first and second forms explicitly identify the name of the
+class being created.  The third form assumes the current package
+name as the class name.
+
+An object of a class created by the first and third forms is
+based on an array, whereas an object of a class created by the
+second form is based on a hash. The array-based forms will be
+somewhat faster and smaller; the hash-based forms are more
+flexible.
+
+The class created by C<struct> must not be a subclass of another
+class other than C<UNIVERSAL>.
+
+A function named C<new> must not be explicitly defined in a class
+created by C<struct>.
+
+The I<ELEMENT_LIST> has the form
+
+    NAME => TYPE, ...
+
+Each name-type pair declares one element of the struct. Each
+element name will be defined as an accessor method unless a
+method by that name is explicitly defined; in the latter case, a
+warning is issued if the warning flag (B<-w>) is set.
+
+
+=head2 Element Types and Accessor Methods
+
+The four element types -- scalar, array, hash, and class -- are
+represented by strings -- C<'$'>, C<'@'>, C<'%'>, and a class name --
+optionally preceded by a C<'*'>.
+
+The accessor method provided by C<struct> for an element depends
+on the declared type of the element.
+
+=over
+
+=item Scalar (C<'$'> or C<'*$'>)
+
+The element is a scalar, and is initialized to C<undef>.
+
+The accessor's argument, if any, is assigned to the element.
+
+If the element type is C<'$'>, the value of the element (after
+assignment) is returned. If the element type is C<'*$'>, a reference
+to the element is returned.
+
+=item Array (C<'@'> or C<'*@'>)
+
+The element is an array, initialized to C<()>.
+
+With no argument, the accessor returns a reference to the
+element's whole array.
+
+With one or two arguments, the first argument is an index
+specifying one element of the array; the second argument, if
+present, is assigned to the array element.  If the element type
+is C<'@'>, the accessor returns the array element value.  If the
+element type is C<'*@'>, a reference to the array element is
+returned.
+
+=item Hash (C<'%'> or C<'*%'>)
+
+The element is a hash, initialized to C<()>.
+
+With no argument, the accessor returns a reference to the
+element's whole hash.
+
+With one or two arguments, the first argument is a key specifying
+one element of the hash; the second argument, if present, is
+assigned to the hash element.  If the element type is C<'%'>, the
+accessor returns the hash element value.  If the element type is
+C<'*%'>, a reference to the hash element is returned.
+
+=item Class (C<'Class_Name'> or C<'*Class_Name'>)
+
+The element's value must be a reference blessed to the named
+class or to one of its subclasses. The element is initialized to
+the result of calling the C<new> constructor of the named class.
+
+The accessor's argument, if any, is assigned to the element. The
+accessor will C<croak> if this is not an appropriate object
+reference.
+
+If the element type does not start with a C<'*'>, the accessor
+returns the element value (after assignment). If the element type
+starts with a C<'*'>, a reference to the element itself is returned.
+
+=back
+
+=head1 EXAMPLES
+
+=over
+
+=item Example 1
+
+Giving a struct element a class type that is also a struct is how
+structs are nested.  Here, C<timeval> represents a time (seconds and
+microseconds), and C<rusage> has two elements, each of which is of
+type C<timeval>.
+
+    use Class::Struct;
+
+    struct( rusage => {
+        ru_utime => timeval,  # seconds
+        ru_stime => timeval,  # microseconds
+    });
+
+    struct( timeval => [
+        tv_secs  => '$',
+        tv_usecs => '$',
+    ]);
+
+        # create an object:
+    my $t = new rusage;
+    	# $t->ru_utime and $t->ru_stime are objects of type timeval.
+
+        # set $t->ru_utime to 100.0 sec and $t->ru_stime to 5.0 sec.
+    $t->ru_utime->tv_secs(100);
+    $t->ru_utime->tv_usecs(0);
+    $t->ru_stime->tv_secs(5);
+    $t->ru_stime->tv_usecs(0);
+
+
+=item Example 2
+
+An accessor function can be redefined in order to provide
+additional checking of values, etc.  Here, we want the C<count>
+element always to be nonnegative, so we redefine the C<count>
+accessor accordingly.
+
+    package MyObj;
+    use Class::Struct;
+
+    		# declare the struct
+    struct ( 'MyObj', { count => '$', stuff => '%' } );
+
+    		# override the default accessor method for 'count'
+    sub count {
+        my $self = shift;
+        if ( @_ ) {
+            die 'count must be nonnegative' if $_[0] < 0;
+            $self->{'count'} = shift;
+            warn "Too many args to count" if @_;
+        }
+        return $self->{'count'};
+    }
+
+    package main;
+    $x = new MyObj;
+    print "\$x->count(5) = ", $x->count(5), "\n";
+                            # prints '$x->count(5) = 5'
+
+    print "\$x->count = ", $x->count, "\n";
+                            # prints '$x->count = 5'
+
+    print "\$x->count(-5) = ", $x->count(-5), "\n";
+                            # dies due to negative argument!
+
+
+=head1 Author and Modification History
+
+
+Renamed to C<Class::Struct> and modified by Jim Miner, 1997-04-02.
+
+    members() function removed.
+    Documentation corrected and extended.
+    Use of struct() in a subclass prohibited.
+    User definition of accessor allowed.
+    Treatment of '*' in element types corrected.
+    Treatment of classes as element types corrected.
+    Class name to struct() made optional.
+    Diagnostic checks added.
+
+
+Originally C<Class::Template> by Dean Roehrich.
+
+    # Template.pm   --- struct/member template builder
+    #   12mar95
+    #   Dean Roehrich
+    #
+    # changes/bugs fixed since 28nov94 version:
+    #  - podified
+    # changes/bugs fixed since 21nov94 version:
+    #  - Fixed examples.
+    # changes/bugs fixed since 02sep94 version:
+    #  - Moved to Class::Template.
+    # changes/bugs fixed since 20feb94 version:
+    #  - Updated to be a more proper module.
+    #  - Added "use strict".
+    #  - Bug in build_methods, was using @var when @$var needed.
+    #  - Now using my() rather than local().
+    #
+    # Uses perl5 classes to create nested data types.
+    # This is offered as one implementation of Tom Christiansen's "structs.pl"
+    # idea.
+
+=cut
diff --git a/lib/Cwd.pm b/lib/Cwd.pm
index bee2e179ae..efcfeca261 100644
--- a/lib/Cwd.pm
+++ b/lib/Cwd.pm
@@ -1,6 +1,5 @@
 package Cwd;
 require 5.000;
-require Exporter;
 
 =head1 NAME
 
@@ -38,22 +37,30 @@ the trailing line terminator). It is recommended that cwd (or another
 
 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.
+L<perlsub/Overriding Builtin Functions>.) Note that it will only be
+kept up to date if all packages which use chdir import it from Cwd.
 
 =cut
 
+## use strict;
+
+use Carp;
+
+$VERSION = '2.00';
+
+require Exporter;
 @ISA = qw(Exporter);
 @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
-@EXPORT_OK = qw(chdir);
+@EXPORT_OK = qw(chdir abs_path fast_abs_path);
 
-# use strict;
 
-sub _backtick_pwd {  # The 'natural and safe form' for UNIX (pwd may be setuid root)
+# The 'natural and safe form' for UNIX (pwd may be setuid root)
+
+sub _backtick_pwd {
     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().
@@ -108,7 +115,7 @@ sub getcwd
 		}
 		unless (@tst = lstat("$dotdots/$dir"))
 		{
-		    warn "lstat($dotdots/$dir): $!";
+		    # warn "lstat($dotdots/$dir): $!";
 		    # Just because you can't lstat this directory
 		    # doesn't mean you'll never find the right one.
 		    # closedir(PARENT);
@@ -121,7 +128,7 @@ sub getcwd
 	$cwd = "$dir/$cwd";
 	closedir(PARENT);
     } while ($dir);
-    chop($cwd); # drop the trailing /
+    chop($cwd) unless $cwd eq '/'; # drop the trailing /
     $cwd;
 }
 
@@ -172,7 +179,7 @@ sub fastcwd {
 my $chdir_init = 0;
 
 sub chdir_init {
-    if ($ENV{'PWD'} and $^O ne 'os2') {
+    if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'msdos') {
 	my($dd,$di) = stat('.');
 	my($pd,$pi) = stat($ENV{'PWD'});
 	if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
@@ -216,20 +223,94 @@ sub chdir {
     1;
 }
 
+# Taken from Cwd.pm It is really getcwd with an optional
+# parameter instead of '.'
+#
+
+sub abs_path
+{
+    my $start = shift || '.';
+    my($dotdots, $cwd, @pst, @cst, $dir, @tst);
+
+    unless (@cst = stat( $start ))
+    {
+	carp "stat($start): $!";
+	return '';
+    }
+    $cwd = '';
+    $dotdots = $start;
+    do
+    {
+	$dotdots .= '/..';
+	@pst = @cst;
+	unless (opendir(PARENT, $dotdots))
+	{
+	    carp "opendir($dotdots): $!";
+	    return '';
+	}
+	unless (@cst = stat($dotdots))
+	{
+	    carp "stat($dotdots): $!";
+	    closedir(PARENT);
+	    return '';
+	}
+	if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
+	{
+	    $dir = '';
+	}
+	else
+	{
+	    do
+	    {
+		unless (defined ($dir = readdir(PARENT)))
+	        {
+		    carp "readdir($dotdots): $!";
+		    closedir(PARENT);
+		    return '';
+		}
+		$tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir"))
+	    }
+	    while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
+		   $tst[1] != $pst[1]);
+	}
+	$cwd = "$dir/$cwd";
+	closedir(PARENT);
+    } while ($dir);
+    chop($cwd); # drop the trailing /
+    $cwd;
+}
+
+sub fast_abs_path {
+    my $cwd = getcwd();
+    my $path = shift || '.';
+    chdir($path) || croak "Cannot chdir to $path:$!";
+    my $realpath = getcwd();
+    chdir($cwd)  || croak "Cannot chdir back to $cwd:$!";
+    $realpath;
+}
+
 
 # --- PORTING SECTION ---
 
 # VMS: $ENV{'DEFAULT'} points to default directory at all times
 # 06-Mar-1996  Charles Bailey  bailey@genetics.upenn.edu
 # Note: Use of Cwd::chdir() 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 
+#   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.
 
 sub _vms_cwd {
-    return $ENV{'DEFAULT'}
+    return $ENV{'DEFAULT'};
+}
+
+sub _vms_abs_path {
+    return $ENV{'DEFAULT'} unless @_;
+    my $path = VMS::Filespec::pathify($_[0]);
+    croak("Invalid path name $_[0]") unless defined $path;
+    return VMS::Filespec::rmsexpand($path);
 }
+
 sub _os2_cwd {
     $ENV{'PWD'} = `cmd /c cd`;
     chop $ENV{'PWD'};
@@ -237,27 +318,59 @@ sub _os2_cwd {
     return $ENV{'PWD'};
 }
 
-my($oldw) = $^W;
-$^W = 0;  # assignments trigger 'subroutine redefined' warning
-if ($^O eq 'VMS') {
-
-    *cwd        = \&_vms_cwd;
-    *getcwd     = \&_vms_cwd;
-    *fastcwd    = \&_vms_cwd;
-    *fastgetcwd = \&_vms_cwd;
+sub _win32_cwd {
+    $ENV{'PWD'} = Win32::GetCurrentDirectory();
+    $ENV{'PWD'} =~ s:\\:/:g ;
+    return $ENV{'PWD'};
 }
-elsif ($^O eq 'NT') {
 
-    *getcwd     = \&cwd;
-    *fastgetcwd = \&cwd;
+*_NT_cwd = \&_win32_cwd if (!defined &_NT_cwd && 
+                            defined &Win32::GetCurrentDirectory);
+
+*_NT_cwd = \&_os2_cwd unless defined &_NT_cwd;
+
+sub _msdos_cwd {
+    $ENV{'PWD'} = `command /c cd`;
+    chop $ENV{'PWD'};
+    $ENV{'PWD'} =~ s:\\:/:g ;
+    return $ENV{'PWD'};
 }
-elsif ($^O eq 'os2') {
-    *cwd     = \&_os2_cwd;
-    *getcwd     = \&_os2_cwd;
-    *fastgetcwd = \&_os2_cwd;
-    *fastcwd = \&_os2_cwd;
+
+{
+    local $^W = 0;	# assignments trigger 'subroutine redefined' warning
+
+    if ($^O eq 'VMS') {
+        *cwd		= \&_vms_cwd;
+        *getcwd		= \&_vms_cwd;
+        *fastcwd	= \&_vms_cwd;
+        *fastgetcwd	= \&_vms_cwd;
+        *abs_path	= \&_vms_abs_path;
+        *fast_abs_path	= \&_vms_abs_path;
+    }
+    elsif ($^O eq 'NT' or $^O eq 'MSWin32') {
+        # We assume that &_NT_cwd is defined as an XSUB or in the core.
+        *cwd		= \&_NT_cwd;
+        *getcwd		= \&_NT_cwd;
+        *fastcwd	= \&_NT_cwd;
+        *fastgetcwd	= \&_NT_cwd;
+        *abs_path	= \&fast_abs_path;
+    }
+    elsif ($^O eq 'os2') {
+        # sys_cwd may keep the builtin command
+        *cwd		= defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
+        *getcwd		= \&cwd;
+        *fastgetcwd	= \&cwd;
+        *fastcwd	= \&cwd;
+        *abs_path	= \&fast_abs_path;
+    }
+    elsif ($^O eq 'msdos') {
+        *cwd		= \&_msdos_cwd;
+        *getcwd		= \&_msdos_cwd;
+        *fastgetcwd	= \&_msdos_cwd;
+        *fastcwd	= \&_msdos_cwd;
+        *abs_path	= \&fast_abs_path;
+    }
 }
-$^W = $oldw;
 
 # package main; eval join('',<DATA>) || die $@;	# quick test
 
diff --git a/lib/Devel/SelfStubber.pm b/lib/Devel/SelfStubber.pm
index fc7ee4b511..4c2d039580 100644
--- a/lib/Devel/SelfStubber.pm
+++ b/lib/Devel/SelfStubber.pm
@@ -35,7 +35,7 @@ sub stub {
     $fh = "${module}::DATA";
 
     open($fh,$mod_file) || die "Unable to open $mod_file";
-    while($line = <$fh> and $line !~ m/^__DATA__/) {
+    while(defined ($line = <$fh>) and $line !~ m/^__DATA__/) {
 	push(@BEFORE_DATA,$line);
 	$line =~ /use\s+SelfLoader/ && $found_selfloader++;
     }
@@ -45,7 +45,7 @@ sub stub {
     $self->_load_stubs($module);
     if ( fileno($fh) ) {
 	$end = 1;
-	while($line = <$fh>) {
+	while(defined($line = <$fh>)) {
 	    push(@AFTER_DATA,$line);
 	}
     }
@@ -118,7 +118,7 @@ So, for classes and subclasses to have inheritance correctly
 work with autoloading, you need to ensure stubs are loaded.
 
 The SelfLoader can load stubs automatically at module initialization
-with the statement 'SelfLoader->load_stubs()';, but you may wish to
+with the statement 'SelfLoader-E<gt>load_stubs()';, but you may wish to
 avoid having the stub loading overhead associated with your
 initialization (though note that the SelfLoader::load_stubs method
 will be called sooner or later - at latest when the first sub
diff --git a/lib/English.pm b/lib/English.pm
index ce4520a891..0cf62bd3b6 100644
--- a/lib/English.pm
+++ b/lib/English.pm
@@ -138,8 +138,8 @@ sub import {
 
 	*CHILD_ERROR				= *?	;
 	*OS_ERROR				= *!	;
-	*EXTENDED_OS_ERROR			= *^E	;
 	    *ERRNO				= *!	;
+	*EXTENDED_OS_ERROR			= *^E	;
 	*EVAL_ERROR				= *@	;
 
 # Process info.
diff --git a/lib/Env.pm b/lib/Env.pm
index 0e790754a8..f2fe4af422 100644
--- a/lib/Env.pm
+++ b/lib/Env.pm
@@ -11,10 +11,9 @@ Env - perl module that imports environment variables
 
 =head1 DESCRIPTION
 
-Perl maintains environment variables in a pseudo-associative-array
-named %ENV.  For when this access method is inconvenient, the Perl
-module C<Env> allows environment variables to be treated as simple
-variables.
+Perl maintains environment variables in a pseudo-hash named %ENV.  For
+when this access method is inconvenient, the Perl module C<Env> allows
+environment variables to be treated as simple variables.
 
 The Env::import() function ties environment variables with suitable
 names to global Perl variables with the same names.  By default it
@@ -39,7 +38,7 @@ the environment, assign it the undefined value
 
 =head1 AUTHOR
 
-Chip Salzenberg <chip@fin.uucp>
+Chip Salzenberg E<lt>F<chip@fin.uucp>E<gt>
 
 =cut
 
@@ -47,7 +46,11 @@ sub import {
     my ($callpack) = caller(0);
     my $pack = shift;
     my @vars = @_ ? @_ : keys(%ENV);
+    return unless @vars;
 
+    eval "package $callpack; use vars qw("
+	 . join(' ', map { '$'.$_ } @vars) . ")";
+    die $@ if $@;
     foreach (@vars) {
 	tie ${"${callpack}::$_"}, Env, $_ if /^[A-Za-z_]\w*$/;
     }
diff --git a/lib/Exporter.pm b/lib/Exporter.pm
index 343b9fbd17..66459b8af0 100644
--- a/lib/Exporter.pm
+++ b/lib/Exporter.pm
@@ -2,21 +2,31 @@ package Exporter;
 
 require 5.001;
 
+#
+# We go to a lot of trouble not to 'require Carp' at file scope,
+#  because Carp requires Exporter, and something has to give.
+#
+
 $ExportLevel = 0;
 $Verbose = 0 unless $Verbose;
 
-require Carp;
-
 sub export {
 
     # First make import warnings look like they're coming from the "use".
     local $SIG{__WARN__} = sub {
 	my $text = shift;
-	$text =~ s/ at \S*Exporter.pm line \d+.*\n//;
-	local $Carp::CarpLevel = 1;	# ignore package calling us too.
-	Carp::carp($text);
+	if ($text =~ s/ at \S*Exporter.pm line \d+.*\n//) {
+	    require Carp;
+	    local $Carp::CarpLevel = 1;	# ignore package calling us too.
+	    Carp::carp($text);
+	}
+	else {
+	    warn $text;
+	}
     };
     local $SIG{__DIE__} = sub {
+	require Carp;
+	local $Carp::CarpLevel = 1;	# ignore package calling us too.
 	Carp::croak("$_[0]Illegal null symbol in \@${1}::EXPORT")
 	    if $_[0] =~ /^Unable to create sub named "(.*?)::"/;
     };
@@ -91,13 +101,22 @@ sub export {
 			@imports = @exports;
 			last;
 		    }
+		    # We need a way to emulate 'use Foo ()' but still
+		    # allow an easy version check: "use Foo 1.23, ''";
+		    if (@imports == 2 and !$imports[1]) {
+			@imports = ();
+			last;
+		    }
 		} elsif ($sym !~ s/^&// || !$exports{$sym}) {
 		    warn qq["$sym" is not exported by the $pkg module];
 		    $oops++;
 		}
 	    }
 	}
-	Carp::croak("Can't continue after import errors") if $oops;
+	if ($oops) {
+	    require Carp;
+	    Carp::croak("Can't continue after import errors");
+	}
     }
     else {
 	@imports = @exports;
@@ -121,7 +140,10 @@ sub export {
 		warn qq["$sym" is not implemented by the $pkg module ],
 			"on this architecture";
 	    }
-	    Carp::croak("Can't continue after import errors") if @failed;
+	    if (@failed) {
+		require Carp;
+		Carp::croak("Can't continue after import errors");
+	    }
 	}
     }
 
@@ -139,7 +161,7 @@ sub export {
 	    $type eq '@' ? \@{"${pkg}::$sym"} :
 	    $type eq '%' ? \%{"${pkg}::$sym"} :
 	    $type eq '*' ?  *{"${pkg}::$sym"} :
-		Carp::croak("Can't export symbol: $type$sym");
+	    do { require Carp; Carp::croak("Can't export symbol: $type$sym") };
     }
 }
 
@@ -159,8 +181,11 @@ sub _push_tags {
     push(@{"${pkg}::$var"},
 	map { $export_tags{$_} ? @{$export_tags{$_}} : scalar(++$nontag,$_) }
 		(@$syms) ? @$syms : keys %export_tags);
-    # This may change to a die one day
-    Carp::carp("Some names are not tags") if $nontag and $^W;
+    if ($nontag and $^W) {
+	# This may change to a die one day
+	require Carp;
+	Carp::carp("Some names are not tags");
+    }
 }
 
 sub export_tags    { _push_tags((caller)[0], "EXPORT",    \@_) }
@@ -170,15 +195,21 @@ sub export_ok_tags { _push_tags((caller)[0], "EXPORT_OK", \@_) }
 # Default methods
 
 sub export_fail {
+    my $self = shift;
     @_;
 }
 
 sub require_version {
     my($self, $wanted) = @_;
     my $pkg = ref $self || $self;
-    my $version = ${"${pkg}::VERSION"} || "(undef)";
-    Carp::croak("$pkg $wanted required--this is only version $version")
-		if $version < $wanted;
+    my $version = ${"${pkg}::VERSION"};
+    if (!$version or $version < $wanted) {
+	$version ||= "(undef)";
+	my $file = $INC{"$pkg.pm"};
+	$file &&= " ($file)";
+	require Carp;
+	Carp::croak("$pkg $wanted required--this is only version $version$file")
+    }
     $version;
 }
 
@@ -235,7 +266,7 @@ In other files which wish to use ModuleName:
 =head1 DESCRIPTION
 
 The Exporter module implements a default C<import> method which
-many modules choose inherit rather than implement their own.
+many modules choose to inherit rather than implement their own.
 
 Perl automatically calls the C<import> method when processing a
 C<use> statement for a module. Modules and C<use> are documented
@@ -254,7 +285,7 @@ try to use @EXPORT_OK in preference to @EXPORT and avoid short or
 common symbol names to reduce the risk of name clashes.
 
 Generally anything not exported is still accessible from outside the
-module using the ModuleName::item_name (or $blessed_ref->method)
+module using the ModuleName::item_name (or $blessed_ref-E<gt>method)
 syntax.  By convention you can use a leading underscore on names to
 informally indicate that they are 'internal' and not for public use.
 
@@ -318,7 +349,7 @@ into modules.
 =head2 Module Version Checking
 
 The Exporter module will convert an attempt to import a number from a
-module into a call to $module_name->require_version($value). This can
+module into a call to $module_name-E<gt>require_version($value). This can
 be used to validate that the version of the module being used is
 greater than or equal to the required version.
 
@@ -339,7 +370,7 @@ or constants that may not exist on some systems.
 The names of any symbols that cannot be exported should be listed
 in the C<@EXPORT_FAIL> array.
 
-If a module attempts to import any of these symbols the Exporter will
+If a module attempts to import any of these symbols the Exporter
 will give the module an opportunity to handle the situation before
 generating an error. The Exporter will call an export_fail method
 with a list of the failed symbols:
diff --git a/lib/ExtUtils/Command.pm b/lib/ExtUtils/Command.pm
new file mode 100644
index 0000000000..bdf32d4218
--- /dev/null
+++ b/lib/ExtUtils/Command.pm
@@ -0,0 +1,208 @@
+package ExtUtils::Command;
+use strict;
+# use AutoLoader;
+use Carp;
+use File::Copy;
+use File::Compare;
+use File::Basename;
+use File::Path qw(rmtree);
+require Exporter;
+use vars qw(@ISA @EXPORT $VERSION);
+@ISA     = qw(Exporter);
+@EXPORT  = qw(cp rm_f rm_rf mv cat eqtime mkpath touch test_f);
+$VERSION = '1.00';
+
+=head1 NAME
+
+ExtUtils::Command - utilities to replace common UNIX commands in Makefiles etc.
+
+=head1 SYNOPSIS
+
+  perl -MExtUtils::command -e cat files... > destination
+  perl -MExtUtils::command -e mv source... destination
+  perl -MExtUtils::command -e cp source... destination
+  perl -MExtUtils::command -e touch files...
+  perl -MExtUtils::command -e rm_f file...
+  perl -MExtUtils::command -e rm_rf directories...
+  perl -MExtUtils::command -e mkpath directories...
+  perl -MExtUtils::command -e eqtime source destination
+  perl -MExtUtils::command -e chmod mode files...
+  perl -MExtUtils::command -e test_f file
+
+=head1 DESCRIPTION
+
+The module is used in Win32 port to replace common UNIX commands.
+Most commands are wrapers on generic modules File::Path and File::Basename.
+
+=over 4
+
+=cut
+
+sub expand_wildcards
+{
+ @ARGV = map(/[\*\?]/ ? glob($_) : $_,@ARGV);
+}
+
+=item cat 
+
+Concatenates all files mentioned on command line to STDOUT.
+
+=cut 
+
+sub cat ()
+{
+ expand_wildcards();
+ print while (<>);
+}
+
+=item eqtime src dst
+
+Sets modified time of dst to that of src
+
+=cut 
+
+sub eqtime
+{
+ my ($src,$dst) = @ARGV;
+ open(F,">$dst");
+ close(F);
+ utime((stat($src))[8,9],$dst);
+}
+
+=item rm_f files....
+
+Removes directories - recursively (even if readonly)
+
+=cut 
+
+sub rm_rf
+{
+ rmtree([grep -e $_,expand_wildcards()],0,0);
+}
+
+=item rm_f files....
+
+Removes files (even if readonly)
+
+=cut 
+
+sub rm_f
+{
+ foreach (expand_wildcards())
+  {
+   next unless -f $_;        
+   next if unlink($_);
+   chmod(0777,$_);           
+   next if unlink($_);
+   carp "Cannot delete $_:$!";
+  }
+}
+
+=item touch files ...
+
+Makes files exist, with current timestamp 
+
+=cut 
+
+sub touch
+{
+ expand_wildcards();
+ while (@ARGV)
+  {
+   my $file = shift(@ARGV);               
+   open(FILE,">>$file") || die "Cannot write $file:$!";
+   close(FILE);
+  }
+}
+
+=item mv source... destination
+
+Moves source to destination.
+Multiple sources are allowed if destination is an existing directory.
+
+=cut 
+
+sub mv
+{
+ my $dst = pop(@ARGV);
+ expand_wildcards();
+ croak("Too many arguments") if (@ARGV > 1 && ! -d $dst);
+ while (@ARGV)
+  {
+   my $src = shift(@ARGV);               
+   move($src,$dst);
+  }
+}
+
+=item cp source... destination
+
+Copies source to destination.
+Multiple sources are allowed if destination is an existing directory.
+
+=cut 
+
+sub cp
+{
+ my $dst = pop(@ARGV);
+ expand_wildcards();
+ croak("Too many arguments") if (@ARGV > 1 && ! -d $dst);
+ while (@ARGV)
+  {
+   my $src = shift(@ARGV);               
+   copy($src,$dst);
+  }
+}
+
+=item chmod mode files...
+
+Sets UNIX like permissions 'mode' on all the files.
+
+=cut 
+
+sub chmod
+{
+ my $mode = shift(@ARGV);
+ chmod($mode,expand_wildcards()) || die "Cannot chmod ".join(' ',$mode,@ARGV).":$!";
+}
+
+=item mkpath directory...
+
+Creates directory, including any parent directories.
+
+=cut 
+
+sub mkpath
+{
+ File::Path::mkpath([expand_wildcards()],1,0777);
+}
+
+=item test_f file
+
+Tests if a file exists
+
+=cut 
+
+sub test_f
+{
+ exit !-f shift(@ARGV);
+}
+
+1;
+__END__ 
+
+=back
+
+=head1 BUGS
+
+Should probably be Auto/Self loaded.
+
+=head1 SEE ALSO 
+
+ExtUtils::MakeMaker, ExtUtils::MM_Unix, ExtUtils::MM_Win32
+
+=head1 AUTHOR
+
+Nick Ing-Simmons <F<nick@ni-s.u-net.com>>.
+
+=cut
+
diff --git a/lib/ExtUtils/Embed.pm b/lib/ExtUtils/Embed.pm
new file mode 100644
index 0000000000..0db3ecfcc4
--- /dev/null
+++ b/lib/ExtUtils/Embed.pm
@@ -0,0 +1,479 @@
+# $Id: Embed.pm,v 1.2501 $
+require 5.002;
+
+package ExtUtils::Embed;
+require Exporter;
+require FileHandle;
+use Config;
+use Getopt::Std;
+
+#Only when we need them
+#require ExtUtils::MakeMaker;
+#require ExtUtils::Liblist;
+
+use vars qw(@ISA @EXPORT $VERSION
+	    @Extensions $Verbose $lib_ext
+	    $opt_o $opt_s 
+	    );
+use strict;
+
+$VERSION = sprintf("%d.%02d", q$Revision: 1.2501 $ =~ /(\d+)\.(\d+)/);
+#for the namespace change
+$Devel::embed::VERSION = "99.99";
+
+sub Version { $VERSION; }
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&xsinit &ldopts 
+	     &ccopts &ccflags &ccdlflags &perl_inc
+	     &xsi_header &xsi_protos &xsi_body);
+
+#let's have Miniperl borrow from us instead
+#require ExtUtils::Miniperl;
+#*canon = \&ExtUtils::Miniperl::canon;
+
+$Verbose = 0;
+$lib_ext = $Config{lib_ext} || '.a';
+
+sub xsinit { 
+    my($file, $std, $mods) = @_;
+    my($fh,@mods,%seen);
+    $file ||= "perlxsi.c";
+
+    if (@_) {
+       @mods = @$mods if $mods;
+    }
+    else {
+       getopts('o:s:');
+       $file = $opt_o if defined $opt_o;
+       $std  = $opt_s  if defined $opt_s;
+       @mods = @ARGV;
+    }
+    $std = 1 unless scalar @mods;
+
+    if ($file eq "STDOUT") {
+	$fh = \*STDOUT;
+    }
+    else {
+	$fh = new FileHandle "> $file";
+    }
+
+    push(@mods, static_ext()) if defined $std;
+    @mods = grep(!$seen{$_}++, @mods);
+
+    print $fh &xsi_header();
+    print $fh "EXTERN_C void xs_init _((void));\n\n";     
+    print $fh &xsi_protos(@mods);
+
+    print $fh "\nEXTERN_C void\nxs_init()\n{\n";
+    print $fh &xsi_body(@mods);
+    print $fh "}\n";
+
+}
+
+sub xsi_header {
+    return <<EOF;
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#include <EXTERN.h>
+#include <perl.h>
+
+#ifdef __cplusplus
+}
+#  ifndef EXTERN_C
+#    define EXTERN_C extern "C"
+#  endif
+#else
+#  ifndef EXTERN_C
+#    define EXTERN_C extern
+#  endif
+#endif
+
+EOF
+}    
+
+sub xsi_protos {
+    my(@exts) = @_;
+    my(@retval,%seen);
+
+    foreach $_ (@exts){
+        my($pname) = canon('/', $_);
+        my($mname, $cname);
+        ($mname = $pname) =~ s!/!::!g;
+        ($cname = $pname) =~ s!/!__!g;
+	my($ccode) = "EXTERN_C void boot_${cname} _((CV* cv));\n";
+	next if $seen{$ccode}++;
+        push(@retval, $ccode);
+    }
+    return join '', @retval;
+}
+
+sub xsi_body {
+    my(@exts) = @_;
+    my($pname,@retval,%seen);
+    my($dl) = canon('/','DynaLoader');
+    push(@retval, "\tchar *file = __FILE__;\n");
+    push(@retval, "\tdXSUB_SYS;\n") if $] > 5.002;
+    push(@retval, "\n");
+
+    foreach $_ (@exts){
+        my($pname) = canon('/', $_);
+        my($mname, $cname, $ccode);
+        ($mname = $pname) =~ s!/!::!g;
+        ($cname = $pname) =~ s!/!__!g;
+        if ($pname eq $dl){
+            # Must NOT install 'DynaLoader::boot_DynaLoader' as 'bootstrap'!
+            # boot_DynaLoader is called directly in DynaLoader.pm
+            $ccode = "\t/* DynaLoader is a special case */\n\tnewXS(\"${mname}::boot_${cname}\", boot_${cname}, file);\n";
+            push(@retval, $ccode) unless $seen{$ccode}++;
+        } else {
+            $ccode = "\tnewXS(\"${mname}::bootstrap\", boot_${cname}, file);\n";
+            push(@retval, $ccode) unless $seen{$ccode}++;
+        }
+    }
+    return join '', @retval;
+}
+
+sub static_ext {
+    unless (scalar @Extensions) {
+	@Extensions = sort split /\s+/, $Config{static_ext};
+	unshift @Extensions, qw(DynaLoader);
+    }
+    @Extensions;
+}
+
+sub ldopts {
+    require ExtUtils::MakeMaker;
+    require ExtUtils::Liblist;
+    my($std,$mods,$link_args,$path) = @_;
+    my(@mods,@link_args,@argv);
+    my($dllib,$config_libs,@potential_libs,@path);
+    local($") = ' ' unless $" eq ' ';
+    my $MM = bless {} => 'MY';
+    if (scalar @_) {
+       @link_args = @$link_args if $link_args;
+       @mods = @$mods if $mods;
+    }
+    else {
+       @argv = @ARGV;
+       #hmm
+       while($_ = shift @argv) {
+	   /^-std$/  && do { $std = 1; next; };
+	   /^--$/    && do { @link_args = @argv; last; };
+	   /^-I(.*)/ && do { $path = $1 || shift @argv; next; };
+	   push(@mods, $_); 
+       }
+    }
+    $std = 1 unless scalar @link_args;
+    @path = $path ? split(/:/, $path) : @INC;
+
+    push(@potential_libs, @link_args)    if scalar @link_args;
+    push(@potential_libs, $Config{libs}) if defined $std;
+
+    push(@mods, static_ext()) if $std;
+
+    my($mod,@ns,$root,$sub,$extra,$archive,@archives);
+    print STDERR "Searching (@path) for archives\n" if $Verbose;
+    foreach $mod (@mods) {
+	@ns = split('::', $mod);
+	$sub = $ns[-1];
+	$root = $MM->catdir(@ns);
+	
+	print STDERR "searching for '$sub${lib_ext}'\n" if $Verbose;
+	foreach (@path) {
+	    next unless -e ($archive = $MM->catdir($_,"auto",$root,"$sub$lib_ext"));
+	    push @archives, $archive;
+	    if(-e ($extra = $MM->catdir($_,"auto",$root,"extralibs.ld"))) {
+		local(*FH); 
+		if(open(FH, $extra)) {
+		    my($libs) = <FH>; chomp $libs;
+		    push @potential_libs, split /\s+/, $libs;
+		}
+		else {  
+		    warn "Couldn't open '$extra'"; 
+		}
+	    }
+	    last;
+	}
+    }
+    #print STDERR "\@potential_libs = @potential_libs\n";
+
+    my $libperl = (grep(/^-l\w*perl\w*$/, @link_args))[0] || "-lperl";
+
+    my($extralibs, $bsloadlibs, $ldloadlibs, $ld_run_path) =
+	$MM->ext(join ' ', 
+		 $MM->catdir("-L$Config{archlibexp}", "CORE"), " $libperl", 
+		 @potential_libs);
+
+    my $ld_or_bs = $bsloadlibs || $ldloadlibs;
+    print STDERR "bs: $bsloadlibs ** ld: $ldloadlibs" if $Verbose;
+    my $linkage = "$Config{ccdlflags} $Config{ldflags} @archives $ld_or_bs";
+    print STDERR "ldopts: '$linkage'\n" if $Verbose;
+
+    return $linkage if scalar @_;
+    print "$linkage\n";
+}
+
+sub ccflags {
+   print " $Config{ccflags} ";
+}
+
+sub ccdlflags {
+   print " $Config{ccdlflags} ";
+}
+
+sub perl_inc {
+   print " -I$Config{archlibexp}/CORE ";
+}
+
+sub ccopts {
+   ccflags;
+   perl_inc;
+}
+
+sub canon {
+    my($as, @ext) = @_;
+    foreach(@ext) {
+       # might be X::Y or lib/auto/X/Y/Y.a
+       next if s!::!/!g;
+       s:^(lib|ext)/(auto/)?::;
+       s:/\w+\.\w+$::;
+    }
+    grep(s:/:$as:, @ext) if ($as ne '/');
+    @ext;
+}
+
+__END__
+
+=head1 NAME
+
+ExtUtils::Embed - Utilities for embedding Perl in C/C++ applications
+
+=head1 SYNOPSIS
+
+
+ perl -MExtUtils::Embed -e xsinit 
+ perl -MExtUtils::Embed -e ldopts 
+
+=head1 DESCRIPTION
+
+ExtUtils::Embed provides utility functions for embedding a Perl interpreter
+and extensions in your C/C++ applications.  
+Typically, an application B<Makefile> will invoke ExtUtils::Embed
+functions while building your application.  
+
+=head1 @EXPORT
+
+ExtUtils::Embed exports the following functions:
+
+xsinit(), ldopts(), ccopts(), perl_inc(), ccflags(), 
+ccdlflags(), xsi_header(), xsi_protos(), xsi_body()
+
+=head1 FUNCTIONS
+
+=over
+
+=item xsinit()
+
+Generate C/C++ code for the XS initializer function.
+
+When invoked as C<`perl -MExtUtils::Embed -e xsinit --`>
+the following options are recognized:
+
+B<-o> E<lt>output filenameE<gt> (Defaults to B<perlxsi.c>)
+
+B<-o STDOUT> will print to STDOUT.
+
+B<-std> (Write code for extensions that are linked with the current Perl.)
+
+Any additional arguments are expected to be names of modules
+to generate code for.
+
+When invoked with parameters the following are accepted and optional:
+
+C<xsinit($filename,$std,[@modules])>
+
+Where,
+
+B<$filename> is equivalent to the B<-o> option.
+
+B<$std> is boolean, equivalent to the B<-std> option.  
+
+B<[@modules]> is an array ref, same as additional arguments mentioned above.
+
+=item Examples
+
+
+ perl -MExtUtils::Embed -e xsinit -- -o xsinit.c Socket
+
+
+This will generate code with an B<xs_init> function that glues the perl B<Socket::bootstrap> function 
+to the C B<boot_Socket> function and writes it to a file named "xsinit.c".
+
+Note that B<DynaLoader> is a special case where it must call B<boot_DynaLoader> directly.
+
+ perl -MExtUtils::Embed -e xsinit
+
+
+This will generate code for linking with B<DynaLoader> and 
+each static extension found in B<$Config{static_ext}>.
+The code is written to the default file name B<perlxsi.c>.
+
+
+ perl -MExtUtils::Embed -e xsinit -- -o xsinit.c -std DBI DBD::Oracle
+
+
+Here, code is written for all the currently linked extensions along with code
+for B<DBI> and B<DBD::Oracle>.
+
+If you have a working B<DynaLoader> then there is rarely any need to statically link in any 
+other extensions.
+
+=item ldopts()
+
+Output arguments for linking the Perl library and extensions to your
+application.
+
+When invoked as C<`perl -MExtUtils::Embed -e ldopts --`>
+the following options are recognized:
+
+B<-std> 
+
+Output arguments for linking the Perl library and any extensions linked
+with the current Perl.
+
+B<-I> E<lt>path1:path2E<gt>
+
+Search path for ModuleName.a archives.  
+Default path is B<@INC>.
+Library archives are expected to be found as 
+B</some/path/auto/ModuleName/ModuleName.a>
+For example, when looking for B<Socket.a> relative to a search path, 
+we should find B<auto/Socket/Socket.a>  
+
+When looking for B<DBD::Oracle> relative to a search path,
+we should find B<auto/DBD/Oracle/Oracle.a>
+
+Keep in mind, you can always supply B</my/own/path/ModuleName.a>
+as an additional linker argument.
+
+B<-->  E<lt>list of linker argsE<gt>
+
+Additional linker arguments to be considered.
+
+Any additional arguments found before the B<--> token 
+are expected to be names of modules to generate code for.
+
+When invoked with parameters the following are accepted and optional:
+
+C<ldopts($std,[@modules],[@link_args],$path)>
+
+Where,
+
+B<$std> is boolean, equivalent to the B<-std> option.  
+
+B<[@modules]> is equivalent to additional arguments found before the B<--> token.
+
+B<[@link_args]> is equivalent to arguments found after the B<--> token.
+
+B<$path> is equivalent to the B<-I> option.
+
+In addition, when ldopts is called with parameters, it will return the argument string
+rather than print it to STDOUT.
+
+=item Examples
+
+
+ perl -MExtUtils::Embed -e ldopts
+
+
+This will print arguments for linking with B<libperl.a>, B<DynaLoader> and 
+extensions found in B<$Config{static_ext}>.  This includes libraries
+found in B<$Config{libs}> and the first ModuleName.a library
+for each extension that is found by searching B<@INC> or the path 
+specifed by the B<-I> option.  
+In addition, when ModuleName.a is found, additional linker arguments
+are picked up from the B<extralibs.ld> file in the same directory.
+
+
+ perl -MExtUtils::Embed -e ldopts -- -std Socket
+
+
+This will do the same as the above example, along with printing additional arguments for linking with the B<Socket> extension.
+
+
+ perl -MExtUtils::Embed -e ldopts -- DynaLoader
+
+
+This will print arguments for linking with just the B<DynaLoader> extension
+and B<libperl.a>.
+
+
+ perl -MExtUtils::Embed -e ldopts -- -std Msql -- -L/usr/msql/lib -lmsql
+
+
+Any arguments after the second '--' token are additional linker
+arguments that will be examined for potential conflict.  If there is no
+conflict, the additional arguments will be part of the output.  
+
+
+=item perl_inc()
+
+For including perl header files this function simply prints:
+
+ -I$Config{archlibexp}/CORE  
+
+So, rather than having to say:
+
+ perl -MConfig -e 'print "-I$Config{archlibexp}/CORE"'
+
+Just say:
+
+ perl -MExtUtils::Embed -e perl_inc
+
+=item ccflags(), ccdlflags()
+
+These functions simply print $Config{ccflags} and $Config{ccdlflags}
+
+=item ccopts()
+
+This function combines perl_inc(), ccflags() and ccdlflags() into one.
+
+=item xsi_header()
+
+This function simply returns a string defining the same B<EXTERN_C> macro as
+B<perlmain.c> along with #including B<perl.h> and B<EXTERN.h>.  
+
+=item xsi_protos(@modules)
+
+This function returns a string of B<boot_$ModuleName> prototypes for each @modules.
+
+=item xsi_body(@modules)
+
+This function returns a string of calls to B<newXS()> that glue the module B<bootstrap>
+function to B<boot_ModuleName> for each @modules.
+
+B<xsinit()> uses the xsi_* functions to generate most of it's code.
+
+=back
+
+=head1 EXAMPLES
+
+For examples on how to use B<ExtUtils::Embed> for building C/C++ applications
+with embedded perl, see the eg/ directory and L<perlembed>.
+
+=head1 SEE ALSO
+
+L<perlembed>
+
+=head1 AUTHOR
+
+Doug MacEachern E<lt>F<dougm@osf.org>E<gt>
+
+Based on ideas from Tim Bunce E<lt>F<Tim.Bunce@ig.co.uk>E<gt> and
+B<minimod.pl> by Andreas Koenig E<lt>F<k@anna.in-berlin.de>E<gt> and Tim Bunce.
+
+=cut
+
diff --git a/lib/ExtUtils/Install.pm b/lib/ExtUtils/Install.pm
index 5d7a9dee85..71f553bcbf 100644
--- a/lib/ExtUtils/Install.pm
+++ b/lib/ExtUtils/Install.pm
@@ -1,7 +1,7 @@
 package ExtUtils::Install;
 
-$VERSION = substr q$Revision: 1.1.1.1 $, 10;
-# $Id: Install.pm,v 1.1.1.1 1997/01/11 12:48:51 mbeattie Exp $
+$VERSION = substr q$Revision: 1.16 $, 10;
+# $Date: 1996/12/17 00:31:26 $
 
 use Exporter;
 use Carp ();
@@ -12,7 +12,7 @@ use vars qw(@ISA @EXPORT $VERSION);
 $Is_VMS = $^O eq 'VMS';
 
 my $splitchar = $^O eq 'VMS' ? '|' : $^O eq 'os2' ? ';' : ':';
-my @PERL_ENV_LIB = split $splitchar, defined $ENV{'PERL5LIB'} ? $ENV{'PERL5LIB'} : $ENV{'PERLLIB'};
+my @PERL_ENV_LIB = split $splitchar, defined $ENV{'PERL5LIB'} ? $ENV{'PERL5LIB'} : $ENV{'PERLLIB'} || '';
 my $Inc_uninstall_warn_handler;
 
 #use vars qw( @EXPORT @ISA $Is_VMS );
@@ -34,16 +34,9 @@ sub install {
     use File::Copy qw(copy);
     use File::Find qw(find);
     use File::Path qw(mkpath);
-    # The following lines were needed with AutoLoader (left for the record)
-    # my $my_req = $self->catfile(qw(auto ExtUtils Install my_cmp.al));
-    # require $my_req;
-    # $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
-    # require $my_req; # Hairy, but for the first
-    # time use we are in a different directory when autoload happens, so
-    # the relativ path to ./blib is ill.
 
     my(%hash) = %$hash;
-    my(%pack, %write, $dir);
+    my(%pack, %write, $dir, $warn_permissions);
     local(*DIR, *P);
     for (qw/read write/) {
 	$pack{$_}=$hash{$_};
@@ -59,7 +52,8 @@ sub install {
 	    if (-w $hash{$source_dir_or_file} || mkpath($hash{$source_dir_or_file})) {
 		last;
 	    } else {
-		Carp::croak("You do not have permissions to install into $hash{$source_dir_or_file}");
+		warn "Warning: You do not have permissions to install into $hash{$source_dir_or_file}"
+		    unless $warn_permissions++;
 	    }
 	}
 	closedir DIR;
@@ -239,6 +233,17 @@ sub pm_to_blib {
     # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
     # require $my_req; # Hairy, but for the first
 
+    if (!ref($fromto) && -r $fromto)
+     {
+      # Win32 has severe command line length limitations, but
+      # can generate temporary files on-the-fly
+      # so we pass name of file here - eval it to get hash 
+      open(FROMTO,"<$fromto") or die "Cannot open $fromto:$!";
+      my $str = '$fromto = {qw{'.join('',<FROMTO>).'}}';
+      eval $str;
+      close(FROMTO);
+     }
+
     my $umask = umask 0022 unless $Is_VMS;
     mkpath($autodir,0,0755);
     foreach (keys %$fromto) {
@@ -253,7 +258,9 @@ sub pm_to_blib {
 	    mkpath(dirname($fromto->{$_}),0,0755);
 	}
 	copy($_,$fromto->{$_});
-	chmod(0444 | ( (stat)[2] & 0111 ? 0111 : 0 ),$fromto->{$_});
+	my($mode,$atime,$mtime) = (stat)[2,8,9];
+	utime($atime,$mtime+$Is_VMS,$fromto->{$_});
+	chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$fromto->{$_});
 	print "cp $_ $fromto->{$_}\n";
 	next unless /\.pm$/;
 	autosplit($fromto->{$_},$autodir);
@@ -318,8 +325,8 @@ be copied preserving timestamps and permissions.
 
 There are two keys with a special meaning in the hash: "read" and
 "write". After the copying is done, install will write the list of
-target files to the file named by $hashref->{write}. If there is
-another file named by $hashref->{read}, the contents of this file will
+target files to the file named by C<$hashref-E<gt>{write}>. If there is
+another file named by C<$hashref-E<gt>{read}>, the contents of this file will
 be merged into the written file. The read and the written file may be
 identical, but on AFS it is quite likely, people are installing to a
 different directory than the one where the files later appear.
@@ -334,4 +341,3 @@ the extension pm are autosplit. Second argument is the autosplit
 directory.
 
 =cut
-
diff --git a/lib/ExtUtils/Liblist.pm b/lib/ExtUtils/Liblist.pm
index 77aa831bc7..2a43022638 100644
--- a/lib/ExtUtils/Liblist.pm
+++ b/lib/ExtUtils/Liblist.pm
@@ -1,16 +1,19 @@
 package ExtUtils::Liblist;
-
+use vars qw($VERSION);
 # Broken out of MakeMaker from version 4.11
 
-$ExtUtils::Liblist::VERSION = substr q$Revision: 1.19 $, 10;
+$VERSION = substr q$Revision: 1.2201 $, 10;
 
 use Config;
 use Cwd 'cwd';
 use File::Basename;
 
-my $Config_libext = $Config{lib_ext} || ".a";
-
 sub ext {
+  if   ($^O eq 'VMS') { return &_vms_ext;      }
+  else                { return &_unix_os2_ext; }
+}
+
+sub _unix_os2_ext {
     my($self,$potential_libs, $Verbose) = @_;
     if ($^O =~ 'os2' and $Config{libs}) { 
 	# Dynamic libraries are not transitive, so we may need including
@@ -24,6 +27,8 @@ sub ext {
 
     my($so)   = $Config{'so'};
     my($libs) = $Config{'libs'};
+    my $Config_libext = $Config{lib_ext} || ".a";
+
 
     # compute $extralibs, $bsloadlibs and $ldloadlibs from
     # $potential_libs
@@ -72,7 +77,8 @@ sub ext {
 		# For gcc-2.6.2 on linux (March 1995), DLD can not load
 		# .sa libraries, with the exception of libm.sa, so we
 		# deliberately skip them.
-	    if (@fullname = $self->lsdir($thispth,"^lib$thislib\.$so\.[0-9]+")){
+	    if (@fullname =
+		    $self->lsdir($thispth,"^\Qlib$thislib.$so.\E[0-9]+")){
 		# Take care that libfoo.so.10 wins against libfoo.so.9.
 		# Compare two libraries to find the most recent version
 		# number.  E.g.  if you have libfoo.so.9.0.7 and
@@ -135,15 +141,18 @@ sub ext {
 
 	    # Do not add it into the list if it is already linked in
 	    # with the main perl executable.
-	    # We have to special-case the NeXT, because all the math 
-	    # is also in libsys_s
+	    # We have to special-case the NeXT, because math and ndbm 
+	    # are both in libsys_s
 	    unless ($in_perl || 
-		    ($^O eq 'next' && $thislib eq 'm') ){
+		($Config{'osname'} eq 'next' &&
+		    ($thislib eq 'm' || $thislib eq 'ndbm')) ){
 		push(@extralibs, "-l$thislib");
 	    }
 
 	    # We might be able to load this archive file dynamically
-	    if ( $Config{'dlsrc'} =~ /dl_next|dl_dld/){
+	    if ( ($Config{'dlsrc'} =~ /dl_next/ && $Config{'osvers'} lt '4_0')
+	    ||   ($Config{'dlsrc'} =~ /dl_dld/) )
+	    {
 		# We push -l$thislib instead of $fullname because
 		# it avoids hardwiring a fixed path into the .bs file.
 		# Mkbootstrap will automatically add dl_findfile() to
@@ -164,13 +173,148 @@ sub ext {
 	    }
 	    last;	# found one here so don't bother looking further
 	}
-	print STDOUT "Warning (will try anyway): No library found for -l$thislib\n"
+	print STDOUT "Note (probably harmless): "
+		     ."No library found for -l$thislib\n"
 	    unless $found_lib>0;
     }
     return ('','','','') unless $found;
     ("@extralibs", "@bsloadlibs", "@ldloadlibs",join(":",@ld_run_path));
 }
 
+
+sub _vms_ext {
+  my($self, $potential_libs,$verbose) = @_;
+  return ('', '', '', '') unless $potential_libs;
+
+  my(@dirs,@libs,$dir,$lib,%sh,%olb,%obj);
+  my $cwd = cwd();
+  my($so,$lib_ext,$obj_ext) = @Config{'so','lib_ext','obj_ext'};
+  # List of common Unix library names and there VMS equivalents
+  # (VMS equivalent of '' indicates that the library is automatially
+  # searched by the linker, and should be skipped here.)
+  my %libmap = ( 'm' => '', 'f77' => '', 'F77' => '', 'V77' => '', 'c' => '',
+                 'malloc' => '', 'crypt' => '', 'resolv' => '', 'c_s' => '',
+                 'socket' => '', 'X11' => 'DECW$XLIBSHR',
+                 'Xt' => 'DECW$XTSHR', 'Xm' => 'DECW$XMLIBSHR',
+                 'Xmu' => 'DECW$XMULIBSHR');
+  if ($Config{'vms_cc_type'} ne 'decc') { $libmap{'curses'} = 'VAXCCURSE'; }
+
+  print STDOUT "Potential libraries are '$potential_libs'\n" if $verbose;
+
+  # First, sort out directories and library names in the input
+  foreach $lib (split ' ',$potential_libs) {
+    push(@dirs,$1),   next if $lib =~ /^-L(.*)/;
+    push(@dirs,$lib), next if $lib =~ /[:>\]]$/;
+    push(@dirs,$lib), next if -d $lib;
+    push(@libs,$1),   next if $lib =~ /^-l(.*)/;
+    push(@libs,$lib);
+  }
+  push(@dirs,split(' ',$Config{'libpth'}));
+
+  # Now make sure we've got VMS-syntax absolute directory specs
+  # (We don't, however, check whether someone's hidden a relative
+  # path in a logical name.)
+  foreach $dir (@dirs) {
+    unless (-d $dir) {
+      print STDOUT "Skipping nonexistent Directory $dir\n" if $verbose > 1;
+      $dir = '';
+      next;
+    }
+    print STDOUT "Resolving directory $dir\n" if $verbose;
+    if ($self->file_name_is_absolute($dir)) { $dir = $self->fixpath($dir,1); }
+    else                                    { $dir = $self->catdir($cwd,$dir); }
+  }
+  @dirs = grep { length($_) } @dirs;
+  unshift(@dirs,''); # Check each $lib without additions first
+
+  LIB: foreach $lib (@libs) {
+    if (exists $libmap{$lib}) {
+      next unless length $libmap{$lib};
+      $lib = $libmap{$lib};
+    }
+
+    my(@variants,$variant,$name,$test,$cand);
+    my($ctype) = '';
+
+    # If we don't have a file type, consider it a possibly abbreviated name and
+    # check for common variants.  We try these first to grab libraries before
+    # a like-named executable image (e.g. -lperl resolves to perlshr.exe
+    # before perl.exe).
+    if ($lib !~ /\.[^:>\]]*$/) {
+      push(@variants,"${lib}shr","${lib}rtl","${lib}lib");
+      push(@variants,"lib$lib") if $lib !~ /[:>\]]/;
+    }
+    push(@variants,$lib);
+    print STDOUT "Looking for $lib\n" if $verbose;
+    foreach $variant (@variants) {
+      foreach $dir (@dirs) {
+        my($type);
+
+        $name = "$dir$variant";
+        print "\tChecking $name\n" if $verbose > 2;
+        if (-f ($test = VMS::Filespec::rmsexpand($name))) {
+          # It's got its own suffix, so we'll have to figure out the type
+          if    ($test =~ /(?:$so|exe)$/i)      { $type = 'sh'; }
+          elsif ($test =~ /(?:$lib_ext|olb)$/i) { $type = 'olb'; }
+          elsif ($test =~ /(?:$obj_ext|obj)$/i) {
+            print STDOUT "Note (probably harmless): "
+			 ."Plain object file $test found in library list\n";
+            $type = 'obj';
+          }
+          else {
+            print STDOUT "Note (probably harmless): "
+			 ."Unknown library type for $test; assuming shared\n";
+            $type = 'sh';
+          }
+        }
+        elsif (-f ($test = VMS::Filespec::rmsexpand($name,$so))      or
+               -f ($test = VMS::Filespec::rmsexpand($name,'.exe')))     {
+          $type = 'sh';
+          $name = $test unless $test =~ /exe;?\d*$/i;
+        }
+        elsif (not length($ctype) and  # If we've got a lib already, don't bother
+               ( -f ($test = VMS::Filespec::rmsexpand($name,$lib_ext)) or
+                 -f ($test = VMS::Filespec::rmsexpand($name,'.olb'))))  {
+          $type = 'olb';
+          $name = $test unless $test =~ /olb;?\d*$/i;
+        }
+        elsif (not length($ctype) and  # If we've got a lib already, don't bother
+               ( -f ($test = VMS::Filespec::rmsexpand($name,$obj_ext)) or
+                 -f ($test = VMS::Filespec::rmsexpand($name,'.obj'))))  {
+          print STDOUT "Note (probably harmless): "
+		       ."Plain object file $test found in library list\n";
+          $type = 'obj';
+          $name = $test unless $test =~ /obj;?\d*$/i;
+        }
+        if (defined $type) {
+          $ctype = $type; $cand = $name;
+          last if $ctype eq 'sh';
+        }
+      }
+      if ($ctype) { 
+        eval '$' . $ctype . "{'$cand'}++";
+        die "Error recording library: $@" if $@;
+        print STDOUT "\tFound as $cand (really $ctest), type $ctype\n" if $verbose > 1;
+        next LIB;
+      }
+    }
+    print STDOUT "Note (probably harmless): "
+		 ."No library found for $lib\n";
+  }
+
+  @libs = sort keys %obj;
+  # This has to precede any other CRTLs, so just make it first
+  if ($olb{VAXCCURSE}) {
+    push(@libs,"$olb{VAXCCURSE}/Library");
+    delete $olb{VAXCCURSE};
+  }
+  push(@libs, map { "$_/Library" } sort keys %olb);
+  push(@libs, map { "$_/Share"   } sort keys %sh);
+  $lib = join(' ',@libs);
+  print "Result: $lib\n" if $verbose;
+  wantarray ? ($lib, '', $lib, '') : $lib;
+}
+
 1;
 
 __END__
@@ -244,11 +388,55 @@ object file.  This list is used to create a .bs (bootstrap) file.
 This module deals with a lot of system dependencies and has quite a
 few architecture specific B<if>s in the code.
 
+=head2 VMS implementation
+
+The version of ext() which is executed under VMS differs from the
+Unix-OS/2 version in several respects:
+
+=over 2
+
+=item *
+
+Input library and path specifications are accepted with or without the
+C<-l> and C<-L> prefices used by Unix linkers.  If neither prefix is
+present, a token is considered a directory to search if it is in fact
+a directory, and a library to search for otherwise.  Authors who wish
+their extensions to be portable to Unix or OS/2 should use the Unix
+prefixes, since the Unix-OS/2 version of ext() requires them.
+
+=item *
+
+Wherever possible, shareable images are preferred to object libraries,
+and object libraries to plain object files.  In accordance with VMS
+naming conventions, ext() looks for files named I<lib>shr and I<lib>rtl;
+it also looks for I<lib>lib and libI<lib> to accomodate Unix conventions
+used in some ported software.
+
+=item *
+
+For each library that is found, an appropriate directive for a linker options
+file is generated.  The return values are space-separated strings of
+these directives, rather than elements used on the linker command line.
+
+=item *
+
+LDLOADLIBS and EXTRALIBS are always identical under VMS, and BSLOADLIBS
+and LD_RIN_PATH are always empty.
+
+=back
+
+In addition, an attempt is made to recognize several common Unix library
+names, and filter them out or convert them to their VMS equivalents, as
+appropriate.
+
+In general, the VMS version of ext() should properly handle input from
+extensions originally designed for a Unix or VMS environment.  If you
+encounter problems, or discover cases where the search could be improved,
+please let us know.
+
 =head1 SEE ALSO
 
 L<ExtUtils::MakeMaker>
 
 =cut
 
-
-
diff --git a/lib/ExtUtils/MM_OS2.pm b/lib/ExtUtils/MM_OS2.pm
index 1a1f8b16a0..65abfc2d99 100644
--- a/lib/ExtUtils/MM_OS2.pm
+++ b/lib/ExtUtils/MM_OS2.pm
@@ -54,6 +54,17 @@ sub file_name_is_absolute {
     $file =~ m{^([a-z]:)?[\\/]}i ;
 }
 
+sub perl_archive
+{
+ return "\$(PERL_INC)/libperl\$(LIB_EXT)";
+}
+
+sub export_list
+{
+ my ($self) = @_;
+ return "$self->{BASEEXT}.def";
+}
+
 1;
 __END__
 
diff --git a/lib/ExtUtils/MM_Unix.pm b/lib/ExtUtils/MM_Unix.pm
index ca952c800a..b051617c38 100644
--- a/lib/ExtUtils/MM_Unix.pm
+++ b/lib/ExtUtils/MM_Unix.pm
@@ -1,18 +1,22 @@
 package ExtUtils::MM_Unix;
 
-$VERSION = substr q$Revision: 1.1.1.1 $, 10;
-# $Id: MM_Unix.pm,v 1.1.1.1 1997/01/11 12:48:52 mbeattie Exp $
-
-require Exporter;
+use Exporter ();
 use Config;
 use File::Basename qw(basename dirname fileparse);
 use DirHandle;
+use strict;
+use vars qw($VERSION $Is_Mac $Is_OS2 $Is_VMS $Is_Win32
+	    $Verbose %pm %static $Xsubpp_Version);
+
+$VERSION = substr q$Revision: 1.114 $, 10;
+# $Id: MM_Unix.pm,v 1.113 1997/02/11 21:54:09 k Exp $
 
 Exporter::import('ExtUtils::MakeMaker',
 	qw( $Verbose &neatvalue));
 
-$Is_OS2 = $^O =~ m|^os/?2$|i;
-$Is_Mac = $^O eq "MacOS";
+$Is_OS2 = $^O eq 'os2';
+$Is_Mac = $^O eq 'MacOS';
+$Is_Win32 = $^O eq 'MSWin32';
 
 if ($Is_VMS = $^O eq 'VMS') {
     require VMS::Filespec;
@@ -40,8 +44,8 @@ overrides by defining rather primitive operations within
 ExtUtils::MM_Unix.
 
 If you are going to write a platform specific MM package, please try
-to limit the necessary overrides to primitiv methods, and if it is not
-possible to do so, let's work it out how to achieve that gain.
+to limit the necessary overrides to primitive methods, and if it is not
+possible to do so, let's work out how to achieve that gain.
 
 If you are overriding any of these methods in your Makefile.PL (in the
 MY class), please report that to the makemaker mailing list. We are
@@ -97,12 +101,12 @@ sub catdir {
     my @args = @_;
     for (@args) {
 	# append a slash to each argument unless it has one there
-	$_ .= "/" unless substr($_,length($_)-1,1) eq "/";
+	$_ .= "/" if $_ eq '' or substr($_,-1) ne "/";
     }
     my $result = join('', @args);
     # remove a trailing slash unless we are root
-    substr($result,length($result)-1,1) = ""
-	if length($result) > 1 && substr($result,length($result)-1,1) eq "/";
+    substr($result,-1) = ""
+	if length($result) > 1 && substr($result,-1) eq "/";
     $result;
 }
 
@@ -173,6 +177,7 @@ sub ExtUtils::MM_Unix::dynamic ;
 sub ExtUtils::MM_Unix::dynamic_bs ;
 sub ExtUtils::MM_Unix::dynamic_lib ;
 sub ExtUtils::MM_Unix::exescan ;
+sub ExtUtils::MM_Unix::export_list ;
 sub ExtUtils::MM_Unix::extliblist ;
 sub ExtUtils::MM_Unix::file_name_is_absolute ;
 sub ExtUtils::MM_Unix::find_perl ;
@@ -198,6 +203,7 @@ sub ExtUtils::MM_Unix::nicetext ;
 sub ExtUtils::MM_Unix::parse_version ;
 sub ExtUtils::MM_Unix::pasthru ;
 sub ExtUtils::MM_Unix::path ;
+sub ExtUtils::MM_Unix::perl_archive;
 sub ExtUtils::MM_Unix::perl_script ;
 sub ExtUtils::MM_Unix::perldepend ;
 sub ExtUtils::MM_Unix::pm_to_blib ;
@@ -227,13 +233,18 @@ sub ExtUtils::MM_Unix::xsubpp_version ;
 
 package ExtUtils::MM_Unix;
 
-#use SelfLoader;
+use SelfLoader;
 
 1;
-#__DATA__
+
+__DATA__
+
+=back
 
 =head2 SelfLoaded methods
 
+=over 2
+
 =item c_o (o)
 
 Defines the suffix rules to compile different flavors of C files to
@@ -250,10 +261,12 @@ sub c_o {
     push @m, '
 .c$(OBJ_EXT):
 	$(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.c
-
+';
+    push @m, '
 .C$(OBJ_EXT):
 	$(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.C
-
+' if $^O ne 'os2';			# Case-specific
+    push @m, '
 .cpp$(OBJ_EXT):
 	$(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.cpp
 
@@ -385,7 +398,7 @@ clean ::
 ');
     # clean subdirectories first
     for $dir (@{$self->{DIR}}) {
-	push @m, "\t-cd $dir && test -f $self->{MAKEFILE} && \$(MAKE) clean\n";
+	push @m, "\t-cd $dir && \$(TEST_F) $self->{MAKEFILE} && \$(MAKE) clean\n";
     }
 
     my(@otherfiles) = values %{$self->{XS}}; # .c files from *.xs files
@@ -399,7 +412,7 @@ clean ::
     push @m, "\t-$self->{RM_RF} @otherfiles\n";
     # See realclean and ext/utils/make_ext for usage of Makefile.old
     push(@m,
-	 "\t-$self->{MV} $self->{MAKEFILE} $self->{MAKEFILE}.old 2>/dev/null\n");
+	 "\t-$self->{MV} $self->{MAKEFILE} $self->{MAKEFILE}.old \$(DEV_NULL)\n");
     push(@m,
 	 "\t$attribs{POSTOP}\n")   if $attribs{POSTOP};
     join("", @m);
@@ -486,7 +499,7 @@ sub constants {
 
 	      AR_STATIC_ARGS NAME DISTNAME NAME_SYM VERSION
 	      VERSION_SYM XS_VERSION INST_BIN INST_EXE INST_LIB
-	      INST_ARCHLIB INST_SCRIPT PREFIX INSTALLDIRS
+	      INST_ARCHLIB INST_SCRIPT PREFIX  INSTALLDIRS
 	      INSTALLPRIVLIB INSTALLARCHLIB INSTALLSITELIB
 	      INSTALLSITEARCH INSTALLBIN INSTALLSCRIPT PERL_LIB
 	      PERL_ARCHLIB SITELIBEXP SITEARCHEXP LIBPERL_A MYEXTLIB
@@ -590,20 +603,11 @@ INST_BOOT    =
 ';
     }
 
-    if ($Is_OS2) {
-	$tmp = "$self->{BASEEXT}.def";
-    } else {
-	$tmp = "";
-    }
+    $tmp = $self->export_list;
     push @m, "
 EXPORT_LIST = $tmp
 ";
-
-    if ($Is_OS2) {
-	$tmp = "\$(PERL_INC)/libperl\$(LIB_EXT)";
-    } else {
-	$tmp = "";
-    }
+    $tmp = $self->perl_archive;
     push @m, "
 PERL_ARCHIVE = $tmp
 ";
@@ -659,12 +663,17 @@ sub dir_target {
 # too often :)
 
     my($self,@dirs) = @_;
-    my(@m,$dir);
+    my(@m,$dir,$targdir);
     foreach $dir (@dirs) {
 	my($src) = $self->catfile($self->{PERL_INC},'perl.h');
 	my($targ) = $self->catfile($dir,'.exists');
-	my($targdir) = $targ;       # Necessary because catfile may have
-	$targdir =~ s:/?.exists$::; # adapted syntax of $dir to target OS
+	# catfile may have adapted syntax of $dir to target OS, so...
+	if ($Is_VMS) { # Just remove file name; dirspec is often in macro
+	    ($targdir = $targ) =~ s:/?\.exists$::;
+	}
+	else { # while elsewhere we expect to see the dir separator in $targ
+	    $targdir = dirname($targ);
+	}
 	next if $self->{DIR_TARGET}{$self}{$targdir}++;
 	push @m, qq{
 $targ :: $src
@@ -703,7 +712,7 @@ sub dist {
 
     my($to_unix)  = $attribs{TO_UNIX} || ($Is_OS2
 					  ? "$self->{NOECHO}"
-					  . 'test -f tmp.zip && $(RM) tmp.zip;'
+					  . '$(TEST_F) tmp.zip && $(RM) tmp.zip;'
 					  . ' $(ZIP) -ll -mr tmp.zip $(DISTVNAME) && unzip -o tmp.zip && $(RM) tmp.zip'
 					  : "$self->{NOECHO}\$(NOOP)");
 
@@ -747,20 +756,20 @@ distclean :: realclean distcheck
 
     push @m, q{
 distcheck :
-	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use ExtUtils::Manifest "&fullcheck";' \\
-		-e 'fullcheck();'
+	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=fullcheck \\
+		-e fullcheck
 };
 
     push @m, q{
 skipcheck :
-	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use ExtUtils::Manifest "&skipcheck";' \\
-		-e 'skipcheck();'
+	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=skipcheck \\
+		-e skipcheck
 };
 
     push @m, q{
 manifest :
-	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use ExtUtils::Manifest "&mkmanifest";' \\
-		-e 'mkmanifest();'
+	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=mkmanifest \\
+		-e mkmanifest
 };
     join "", @m;
 }
@@ -776,8 +785,8 @@ sub dist_ci {
     my @m;
     push @m, q{
 ci :
-	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use ExtUtils::Manifest "&maniread";' \\
-		-e '@all = keys %{ maniread() };' \\
+	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=maniread \\
+		-e "@all = keys %{ maniread() };" \\
 		-e 'print("Executing $(CI) @all\n"); system("$(CI) @all");' \\
 		-e 'print("Executing $(RCS_LABEL) ...\n"); system("$(RCS_LABEL) @all");'
 };
@@ -844,7 +853,7 @@ sub dist_dir {
 distdir :
 	$(RM_RF) $(DISTVNAME)
 	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=manicopy,maniread \\
-		-e 'manicopy(maniread(),"$(DISTVNAME)", "$(DIST_CP)");'
+		-e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');"
 };
     join "", @m;
 }
@@ -945,8 +954,8 @@ BOOTSTRAP = '."$self->{BASEEXT}.bs".'
 $(BOOTSTRAP): '."$self->{MAKEFILE} $self->{BOOTDEP}".' $(INST_ARCHAUTODIR)/.exists
 	'.$self->{NOECHO}.'echo "Running Mkbootstrap for $(NAME) ($(BSLOADLIBS))"
 	'.$self->{NOECHO}.'$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" \
-		-e \'use ExtUtils::Mkbootstrap;\' \
-		-e \'Mkbootstrap("$(BASEEXT)","$(BSLOADLIBS)");\'
+		-MExtUtils::Mkbootstrap \
+		-e "Mkbootstrap(\'$(BASEEXT)\',\'$(BSLOADLIBS)\');"
 	'.$self->{NOECHO}.'$(TOUCH) $(BOOTSTRAP)
 	$(CHMOD) 644 $@
 
@@ -990,7 +999,14 @@ $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists
 	push(@m,'	$(RANLIB) '."$ldfrom\n");
     }
     $ldfrom = "-all $ldfrom -none" if ($^O eq 'dec_osf');
-    push(@m,'	LD_RUN_PATH="$(LD_RUN_PATH)" $(LD) -o $@ $(LDDLFLAGS) '.$ldfrom.
+
+    # Brain dead solaris linker does not use LD_RUN_PATH?
+    # This fixes dynamic extensions which need shared libs
+    my $ldrun = '';
+    $ldrun = join ' ', map "-R$_", split /:/, $self->{LD_RUN_PATH}
+       if ($^O eq 'solaris');
+
+    push(@m,'	LD_RUN_PATH="$(LD_RUN_PATH)" $(LD) -o $@ '.$ldrun.' $(LDDLFLAGS) '.$ldfrom.
 		' $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) $(EXPORT_LIST)');
     push @m, '
 	$(CHMOD) 755 $@
@@ -1026,7 +1042,7 @@ sub extliblist {
 
 =item file_name_is_absolute
 
-Takes as argument a path and returns true, it it is an absolute path.
+Takes as argument a path and returns true, if it is an absolute path.
 
 =cut
 
@@ -1054,7 +1070,7 @@ in these dirs:
     foreach $dir (@$dirs){
 	next unless defined $dir; # $self->{PERL_SRC} may be undefined
 	foreach $name (@$names){
-	    my $abs;
+	    my ($abs, $val);
 	    if ($self->file_name_is_absolute($name)) { # /foo/bar
 		$abs = $name;
 	    } elsif ($self->canonpath($name) eq $self->canonpath(basename($name))) { # foo
@@ -1065,9 +1081,12 @@ in these dirs:
 	    print "Checking $abs\n" if ($trace >= 2);
 	    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/) {
+	    $val = `$abs -e 'require $ver; print "VER_OK\n" ' 2>&1`;
+	    if ($val =~ /VER_OK/) {
 	        print "Using PERL=$abs\n" if $trace;
 	        return $abs;
+	    } elsif ($trace >= 2) {
+		print "Result: `$val'\n";
 	    }
 	}
     }
@@ -1075,12 +1094,14 @@ in these dirs:
     0; # false and not empty
 }
 
+=back
+
 =head2 Methods to actually produce chunks of text for the Makefile
 
-The methods here are called in the order specified by
-@ExtUtils::MakeMaker::MM_Sections. This manpage reflects the order as
-well as possible. Some methods call each other, so in doubt refer to
-the code.
+The methods here are called for each MakeMaker object in the order
+specified by @ExtUtils::MakeMaker::MM_Sections.
+
+=over 2
 
 =item force (o)
 
@@ -1147,6 +1168,7 @@ sub init_dirscan {	# --- File and Directory Lists (.xs .pm .pod etc)
     $ignore{'test.pl'} = 1;
     $ignore{'makefile.pl'} = 1 if $Is_VMS;
     foreach $name ($self->lsdir($self->curdir)){
+	next if $name =~ /\#/;
 	next if $name eq $self->curdir or $name eq $self->updir or $ignore{$name};
 	next unless $self->libscan($name);
 	if (-d $name){
@@ -1222,9 +1244,10 @@ sub init_dirscan {	# --- File and Directory Lists (.xs .pm .pod etc)
 		}
 		return;
 	    }
+	    return if /\#/;
 	    my($path, $prefix) = ($File::Find::name, '$(INST_LIBDIR)');
 	    my($striplibpath,$striplibname);
-	    $prefix =  '$(INST_LIB)' if (($striplibpath = $path) =~ s:^(\W*)lib\W:$1:);
+	    $prefix =  '$(INST_LIB)' if (($striplibpath = $path) =~ s:^(\W*)lib\W:$1:i);
 	    ($striplibname,$striplibpath) = fileparse($striplibpath);
 	    my($inst) = $self->catfile($prefix,$striplibpath,$striplibname);
 	    local($_) = $inst; # for backwards compatibility
@@ -1336,7 +1359,7 @@ sub init_dirscan {	# --- File and Directory Lists (.xs .pm .pod etc)
 
 Initializes NAME, FULLEXT, BASEEXT, PARENT_NAME, DLBASE, PERL_SRC,
 PERL_LIB, PERL_ARCHLIB, PERL_INC, INSTALLDIRS, INST_*, INSTALL*,
-PREFIX, CONFIG, AR, AR_STATIC_ARGS, LD, OBJ_EXT, LIB_EXT, MAP_TARGET,
+PREFIX, CONFIG, AR, AR_STATIC_ARGS, LD, OBJ_EXT, LIB_EXT, EXE_EXT, MAP_TARGET,
 LIBPERL_A, VERSION_FROM, VERSION, DISTNAME, VERSION_SYM.
 
 =cut
@@ -1367,14 +1390,11 @@ sub init_main {
     # It may also edit @modparts if required.
     if (defined &DynaLoader::mod2fname) {
         $modfname = &DynaLoader::mod2fname(\@modparts);
-    } elsif ($Is_OS2) {                # Need manual correction if run with miniperl:-(
-        $modfname = substr($modfname, 0, 7) . '_';
     }
 
-
     ($self->{PARENT_NAME}, $self->{BASEEXT}) = $self->{NAME} =~ m!([\w:]+::)?(\w+)$! ;
 
-    if (defined &DynaLoader::mod2fname or $Is_OS2) {
+    if (defined &DynaLoader::mod2fname) {
 	# As of 5.001m, dl_os2 appends '_'
 	$self->{DLBASE} = $modfname;
     } else {
@@ -1412,10 +1432,21 @@ sub init_main {
     if ($self->{PERL_SRC}){
 	$self->{PERL_LIB}     ||= $self->catdir("$self->{PERL_SRC}","lib");
 	$self->{PERL_ARCHLIB} = $self->{PERL_LIB};
-	$self->{PERL_INC}     = $self->{PERL_SRC};
-	# catch a situation that has occurred a few times in the past:
+	$self->{PERL_INC}     = ($Is_Win32) ? $self->catdir($self->{PERL_LIB},"CORE") : $self->{PERL_SRC};
 
-	warn <<EOM unless (-s $self->catfile($self->{PERL_SRC},'cflags') or $Is_VMS && -s $self->catfile($self->{PERL_SRC},'perlshr_attr.opt') or $Is_Mac);
+	# catch a situation that has occurred a few times in the past:
+	unless (
+		-s $self->catfile($self->{PERL_SRC},'cflags')
+		or
+		$Is_VMS
+		&&
+		-s $self->catfile($self->{PERL_SRC},'perlshr_attr.opt')
+		or
+		$Is_Mac
+		or
+		$Is_Win32
+	       ){
+	    warn qq{
 You cannot build extensions below the perl source tree after executing
 a 'make clean' in the perl source tree.
 
@@ -1427,26 +1458,27 @@ usually without extra arguments.
 
 It is recommended that you unpack and build additional extensions away
 from the perl source tree.
-EOM
+};
+	}
     } else {
 	# we should also consider $ENV{PERL5LIB} here
 	$self->{PERL_LIB}     ||= $Config::Config{privlibexp};
 	$self->{PERL_ARCHLIB} ||= $Config::Config{archlibexp};
 	$self->{PERL_INC}     = $self->catdir("$self->{PERL_ARCHLIB}","CORE"); # wild guess for now
 	my $perl_h;
-	die <<EOM unless (-f ($perl_h = $self->catfile($self->{PERL_INC},"perl.h")));
+	unless (-f ($perl_h = $self->catfile($self->{PERL_INC},"perl.h"))){
+	    die qq{
 Error: Unable to locate installed Perl libraries or Perl source code.
 
 It is recommended that you install perl in a standard location before
-building extensions. You can say:
-
-    $^X Makefile.PL PERL_SRC=/path/to/perl/source/directory
-
-if you have not yet installed perl but still want to build this
-extension now.
-(You get this message, because MakeMaker could not find "$perl_h")
-EOM
+building extensions. Some precompiled versions of perl do not contain
+these header files, so you cannot build extensions. In such a case,
+please build and install your perl from a fresh perl distribution. It
+usually solves this kind of problem.
 
+\(You get this message, because MakeMaker could not find "$perl_h"\)
+};
+	}
 #	 print STDOUT "Using header files found in $self->{PERL_INC}\n"
 #	     if $Verbose && $self->needs_linking();
 
@@ -1476,13 +1508,20 @@ EOM
     $self->{INST_ARCHLIB} ||= $self->catdir($self->curdir,"blib","arch");
     $self->{INST_BIN} ||= $self->catdir($self->curdir,'blib','bin');
 
+    # We need to set up INST_LIBDIR before init_libscan() for VMS
+    my @parentdir = split(/::/, $self->{PARENT_NAME});
+    $self->{INST_LIBDIR} = $self->catdir('$(INST_LIB)',@parentdir);
+    $self->{INST_ARCHLIBDIR} = $self->catdir('$(INST_ARCHLIB)',@parentdir);
+    $self->{INST_AUTODIR} = $self->catdir('$(INST_LIB)','auto','$(FULLEXT)');
+    $self->{INST_ARCHAUTODIR} = $self->catdir('$(INST_ARCHLIB)','auto','$(FULLEXT)');
+
     # INST_EXE is deprecated, should go away March '97
     $self->{INST_EXE} ||= $self->catdir($self->curdir,'blib','script');
     $self->{INST_SCRIPT} ||= $self->catdir($self->curdir,'blib','script');
 
     # The user who requests an installation directory explicitly
     # should not have to tell us a architecture installation directory
-    # as well We look if a directory exists that is named after the
+    # as well. We look if a directory exists that is named after the
     # architecture. If not we take it as a sign that it should be the
     # same as the requested installation directory. Otherwise we take
     # the found one.
@@ -1510,23 +1549,67 @@ EOM
     # requested values. We're going to set the $Config{prefix} part of
     # all the installation path variables to literally $(PREFIX), so
     # the user can still say make PREFIX=foo
-    my($prefix) = $Config{'prefix'};
-    $prefix = VMS::Filespec::unixify($prefix) if $Is_VMS;
-    unless ($self->{PREFIX}){
-	$self->{PREFIX} = $prefix;
+    my($configure_prefix) = $Config{'prefix'};
+    $configure_prefix = VMS::Filespec::unixify($configure_prefix) if $Is_VMS;
+    $self->{PREFIX} ||= $configure_prefix;
+
+
+    my($install_variable,$search_prefix,$replace_prefix);
+
+    # The rule, taken from Configure, is that if prefix contains perl,
+    # we shape the tree
+    #    perlprefix/lib/                INSTALLPRIVLIB
+    #    perlprefix/lib/pod/
+    #    perlprefix/lib/site_perl/	INSTALLSITELIB
+    #    perlprefix/bin/		INSTALLBIN
+    #    perlprefix/man/		INSTALLMAN1DIR
+    # else
+    #    prefix/lib/perl5/		INSTALLPRIVLIB
+    #    prefix/lib/perl5/pod/
+    #    prefix/lib/perl5/site_perl/	INSTALLSITELIB
+    #    prefix/bin/			INSTALLBIN
+    #    prefix/lib/perl5/man/		INSTALLMAN1DIR
+
+    $replace_prefix = qq[\$\(PREFIX\)];
+    for $install_variable (qw/
+			   INSTALLBIN
+			   INSTALLSCRIPT
+			   /) {
+	$self->prefixify($install_variable,$configure_prefix,$replace_prefix);
+    }
+    $search_prefix = $configure_prefix =~ /perl/ ?
+	$self->catdir($configure_prefix,"lib") :
+	$self->catdir($configure_prefix,"lib","perl5");
+    if ($self->{LIB}) {
+	$self->{INSTALLPRIVLIB} = $self->{INSTALLSITELIB} = $self->{LIB};
+	$self->{INSTALLARCHLIB} = $self->{INSTALLSITEARCH} = 
+	    $self->catdir($self->{LIB},$Config{'archname'});
+    } else {
+	$replace_prefix = $self->{PREFIX} =~ /perl/ ? 
+	    $self->catdir(qq[\$\(PREFIX\)],"lib") :
+		$self->catdir(qq[\$\(PREFIX\)],"lib","perl5");
+	for $install_variable (qw/
+			       INSTALLPRIVLIB
+			       INSTALLARCHLIB
+			       INSTALLSITELIB
+			       INSTALLSITEARCH
+			       /) {
+	    $self->prefixify($install_variable,$search_prefix,$replace_prefix);
+	}
     }
-    my($install_variable);
+    $search_prefix = $configure_prefix =~ /perl/ ?
+	$self->catdir($configure_prefix,"man") :
+	    $self->catdir($configure_prefix,"lib","perl5","man");
+    $replace_prefix = $self->{PREFIX} =~ /perl/ ? 
+	$self->catdir(qq[\$\(PREFIX\)],"man") :
+	    $self->catdir(qq[\$\(PREFIX\)],"lib","perl5","man");
     for $install_variable (qw/
-
-			   INSTALLPRIVLIB INSTALLARCHLIB INSTALLBIN
-			   INSTALLMAN1DIR INSTALLMAN3DIR INSTALLSCRIPT
-			   INSTALLSITELIB INSTALLSITEARCH
-
+			   INSTALLMAN1DIR
+			   INSTALLMAN3DIR
 			   /) {
-	$self->prefixify($install_variable,$prefix,q[$(PREFIX)]);
+	$self->prefixify($install_variable,$search_prefix,$replace_prefix);
     }
 
-
     # Now we head at the manpages. Maybe they DO NOT want manpages
     # installed
     $self->{INSTALLMAN1DIR} = $Config::Config{installman1dir}
@@ -1623,9 +1706,9 @@ EOM
     foreach $component ($self->{PERL_SRC}, $self->path(), $Config::Config{binexp}) {
 	push @defpath, $component if defined $component;
     }
-    $self->{PERL} =
+    $self->{PERL} ||=
         $self->find_perl(5.0, [ $^X, 'miniperl','perl','perl5',"perl$]" ],
-	    \@defpath, $Verbose ) unless ($self->{PERL});
+	    \@defpath, $Verbose );
     # don't check if perl is executable, maybe they have decided to
     # supply switches with perl
 
@@ -1638,7 +1721,7 @@ EOM
 
 Initializes EXTRALIBS, BSLOADLIBS, LDLOADLIBS, LIBS, LD_RUN_PATH,
 OBJECT, BOOTDEP, PERLMAINCC, LDFROM, LINKTYPE, NOOP, FIRST_MAKEFILE,
-MAKEFILE, NOECHO, RM_F, RM_RF, TOUCH, CP, MV, CHMOD, UMASK_NULL
+MAKEFILE, NOECHO, RM_F, RM_RF, TEST_F, TOUCH, CP, MV, CHMOD, UMASK_NULL
 
 =cut
 
@@ -1652,7 +1735,7 @@ sub init_others {	# --- Initialize Other Attributes
     # May check $Config{libs} too, thus not empty.
     $self->{LIBS}=[''] unless $self->{LIBS};
 
-    $self->{LIBS}=[$self->{LIBS}] if ref \$self->{LIBS} eq SCALAR;
+    $self->{LIBS}=[$self->{LIBS}] if ref \$self->{LIBS} eq 'SCALAR';
     $self->{LD_RUN_PATH} = "";
     my($libs);
     foreach $libs ( @{$self->{LIBS}} ){
@@ -1688,7 +1771,7 @@ sub init_others {	# --- Initialize Other Attributes
     };
 
     # These get overridden for VMS and maybe some other systems
-    $self->{NOOP}  ||= "sh -c true";
+    $self->{NOOP}  ||= '$(SHELL) -c true';
     $self->{FIRST_MAKEFILE} ||= "Makefile";
     $self->{MAKEFILE} ||= $self->{FIRST_MAKEFILE};
     $self->{MAKE_APERL_FILE} ||= "Makefile.aperl";
@@ -1696,10 +1779,12 @@ sub init_others {	# --- Initialize Other Attributes
     $self->{RM_F}  ||= "rm -f";
     $self->{RM_RF} ||= "rm -rf";
     $self->{TOUCH} ||= "touch";
+    $self->{TEST_F} ||= "test -f";
     $self->{CP} ||= "cp";
     $self->{MV} ||= "mv";
     $self->{CHMOD} ||= "chmod";
     $self->{UMASK_NULL} ||= "umask 0";
+    $self->{DEV_NULL} ||= "> /dev/null 2>&1";
 }
 
 =item install (o)
@@ -1762,7 +1847,7 @@ pure_site_install ::
 
 doc_perl_install ::
 	}.$self->{NOECHO}.q{$(DOC_INSTALL) \
-		"$(NAME)" \
+		"Module" "$(NAME)" \
 		"installed into" "$(INSTALLPRIVLIB)" \
 		LINKTYPE "$(LINKTYPE)" \
 		VERSION "$(VERSION)" \
@@ -1771,7 +1856,7 @@ doc_perl_install ::
 
 doc_site_install ::
 	}.$self->{NOECHO}.q{$(DOC_INSTALL) \
-		"Module $(NAME)" \
+		"Module" "$(NAME)" \
 		"installed into" "$(INSTALLSITELIB)" \
 		LINKTYPE "$(LINKTYPE)" \
 		VERSION "$(VERSION)" \
@@ -1910,6 +1995,10 @@ sub macro {
 Called by staticmake. Defines how to write the Makefile to produce a
 static new perl.
 
+By default the Makefile produced includes all the static extensions in
+the perl library. (Purified versions of library files, e.g.,
+DynaLoader_pure_p1_c0_032.a are automatically ignored to avoid link errors.)
+
 =cut
 
 sub makeaperl {
@@ -1958,13 +2047,15 @@ $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
     $cccmd = $self->const_cccmd($libperl);
     $cccmd =~ s/^CCCMD\s*=\s*//;
     $cccmd =~ s/\$\(INC\)/ -I$self->{PERL_INC} /;
-    $cccmd .= " $Config::Config{cccdlflags}" if ($Config::Config{d_shrplib});
+    $cccmd .= " $Config::Config{cccdlflags}"
+	if ($Config::Config{useshrplib} eq 'true');
     $cccmd =~ s/\(CC\)/\(PERLMAINCC\)/;
 
     # The front matter of the linkcommand...
     $linkcmd = join ' ', "\$(CC)",
 	    grep($_, @Config{qw(large split ldflags ccdlflags)});
     $linkcmd =~ s/\s+/ /g;
+    $linkcmd =~ s,(perl\.exp),\$(PERL_INC)/$1,;
 
     # Which *.a files could we make use of...
     local(%static);
@@ -1972,6 +2063,8 @@ $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
     File::Find::find(sub {
 	return unless m/\Q$self->{LIB_EXT}\E$/;
 	return if m/^libperl/;
+	# Skip purified versions of libraries (e.g., DynaLoader_pure_p1_c0_032.a)
+	return if m/_pure_\w+_\w+_\w+\.\w+$/ and -f "$File::Find::dir/.pure";
 
 	if( exists $self->{INCLUDE_EXT} ){
 		my $found = 0;
@@ -2055,6 +2148,16 @@ MAP_PRELIBS   = $Config::Config{libs} $Config::Config{cryptlib}
 	$libperl   = "$dir/$libperl";
 	$lperl   ||= "libperl$self->{LIB_EXT}";
 	$lperl     = "$dir/$lperl";
+
+        if (! -f $libperl and ! -f $lperl) {
+          # We did not find a static libperl. Maybe there is a shared one?
+          if ($^O eq 'solaris' or $^O eq 'sunos') {
+            $lperl  = $libperl = "$dir/$Config::Config{libperl}";
+            # SUNOS ld does not take the full path to a shared library
+            $libperl = '' if $^O eq 'sunos';
+          }
+        }
+
 	print STDOUT "Warning: $libperl not found
     If you're going to build a static perl binary, make sure perl is installed
     otherwise ignore this warning\n"
@@ -2075,10 +2178,17 @@ MAP_LIBPERL = $libperl
     foreach $catfile (@$extra){
 	push @m, "\tcat $catfile >> \$\@\n";
     }
+    # SUNOS ld does not take the full path to a shared library
+    my $llibperl = ($libperl)?'$(MAP_LIBPERL)':'-lperl';
 
-    push @m, "
+    # Brain dead solaris linker does not use LD_RUN_PATH?
+    # This fixes dynamic extensions which need shared libs
+    my $ldfrom = ($^O eq 'solaris')?
+           join(' ', map "-R$_", split /:/, $self->{LD_RUN_PATH}):'';
+
+push @m, "
 \$(MAP_TARGET) :: $tmp/perlmain\$(OBJ_EXT) \$(MAP_LIBPERL) \$(MAP_STATIC) \$(INST_ARCHAUTODIR)/extralibs.all
-	\$(MAP_LINKCMD) -o \$\@ \$(OPTIMIZE) $tmp/perlmain\$(OBJ_EXT) \$(MAP_LIBPERL) \$(MAP_STATIC) `cat \$(INST_ARCHAUTODIR)/extralibs.all` \$(MAP_PRELIBS)
+	\$(MAP_LINKCMD) -o \$\@ \$(OPTIMIZE) $tmp/perlmain\$(OBJ_EXT) $ldfrom $llibperl \$(MAP_STATIC) `cat \$(INST_ARCHAUTODIR)/extralibs.all` \$(MAP_PRELIBS)
 	$self->{NOECHO}echo 'To install the new \"\$(MAP_TARGET)\" binary, call'
 	$self->{NOECHO}echo '    make -f $makefilename inst_perl MAP_TARGET=\$(MAP_TARGET)'
 	$self->{NOECHO}echo 'To remove the intermediate files say'
@@ -2091,8 +2201,8 @@ $tmp/perlmain\$(OBJ_EXT): $tmp/perlmain.c
     push @m, qq{
 $tmp/perlmain.c: $makefilename}, q{
 	}.$self->{NOECHO}.q{echo Writing $@
-	}.$self->{NOECHO}.q{$(PERL) $(MAP_PERLINC) -e 'use ExtUtils::Miniperl; \\
-		writemain(grep s#.*/auto/##, qw|$(MAP_STATIC)|)' > $@.tmp && mv $@.tmp $@
+	}.$self->{NOECHO}.q{$(PERL) $(MAP_PERLINC) -MExtUtils::Miniperl \\
+		-e "writemain(grep s#.*/auto/##, qw|$(MAP_STATIC)|)" > $@t && $(MV) $@t $@
 
 };
 
@@ -2100,7 +2210,7 @@ $tmp/perlmain.c: $makefilename}, q{
 doc_inst_perl:
 	}.$self->{NOECHO}.q{echo Appending installation info to $(INSTALLARCHLIB)/perllocal.pod
 	}.$self->{NOECHO}.q{$(DOC_INSTALL) \
-		"Perl binary $(MAP_TARGET)" \
+		"Perl binary" "$(MAP_TARGET)" \
 		MAP_STATIC "$(MAP_STATIC)" \
 		MAP_EXTRA "`cat $(INST_ARCHAUTODIR)/extralibs.all`" \
 		MAP_LIBPERL "$(MAP_LIBPERL)" \
@@ -2145,11 +2255,12 @@ $(OBJECT) : $(FIRST_MAKEFILE)
 }.$self->{MAKEFILE}.q{ : Makefile.PL $(CONFIGDEP)
 	}.$self->{NOECHO}.q{echo "Makefile out-of-date with respect to $?"
 	}.$self->{NOECHO}.q{echo "Cleaning current config before rebuilding Makefile..."
-	-}.$self->{NOECHO}.q{mv }."$self->{MAKEFILE} $self->{MAKEFILE}.old".q{
-	-$(MAKE) -f }.$self->{MAKEFILE}.q{.old clean >/dev/null 2>&1 || true
+	-}.$self->{NOECHO}.q{$(MV) }."$self->{MAKEFILE} $self->{MAKEFILE}.old".q{
+	-$(MAKE) -f }.$self->{MAKEFILE}.q{.old clean $(DEV_NULL) || $(NOOP)
 	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL }.join(" ",map(qq["$_"],@ARGV)).q{
-	}.$self->{NOECHO}.q{echo ">>> Your Makefile has been rebuilt. <<<"
-	}.$self->{NOECHO}.q{echo ">>> Please rerun the make command.  <<<"; false
+	}.$self->{NOECHO}.q{echo "==> Your Makefile has been rebuilt. <=="
+	}.$self->{NOECHO}.q{echo "==> Please rerun the make command.  <=="
+	false
 
 # To change behavior to :: would be nice, but would break Tk b9.02
 # so you find such a warning below the dist target.
@@ -2319,13 +2430,17 @@ sub parse_version {
 	next if $inpod;
 	chop;
 	next unless /\$(([\w\:\']*)\bVERSION)\b.*\=/;
-	local $ExtUtils::MakeMaker::module_version_variable = $1;
-	my($thispackage) = $2 || $current_package;
-	$thispackage =~ s/:+$//;
-	my($eval) = "$_;";
-	eval $eval;
+	my $eval = qq{
+	    package ExtUtils::MakeMaker::_version;
+	    no strict;
+
+	    \$$1=undef; do {
+		$_
+	    }; \$$1
+	};
+	local($^W) = 0;
+	$result = eval($eval) || 0;
 	die "Could not eval '$eval' in $parsefile: $@" if $@;
-	$result = $ {$ExtUtils::MakeMaker::module_version_variable} || 0;
 	last;
     }
     close FH;
@@ -2345,12 +2460,14 @@ sub pasthru {
     my(@m,$key);
 
     my(@pasthru);
+    my($sep) = $Is_VMS ? ',' : '';
+    $sep .= "\\\n\t";
 
-    foreach $key (qw(LIBPERL_A LINKTYPE PREFIX OPTIMIZE)){
+    foreach $key (qw(LIB LIBPERL_A LINKTYPE PREFIX OPTIMIZE)){
 	push @pasthru, "$key=\"\$($key)\"";
     }
 
-    push @m, "\nPASTHRU = ", join ("\\\n\t", @pasthru), "\n";
+    push @m, "\nPASTHRU = ", join ($sep, @pasthru), "\n";
     join "", @m;
 }
 
@@ -2366,6 +2483,8 @@ sub path {
     my $path = $ENV{PATH};
     $path =~ s:\\:/:g if $Is_OS2;
     my @path = split $path_sep, $path;
+    foreach(@path) { $_ = '.' if $_ eq '' }
+    @path;
 }
 
 =item perl_script
@@ -2430,7 +2549,7 @@ $(OBJECT) : $(PERL_HDRS)
 =item pm_to_blib
 
 Defines target that copies all files in the hash PM to their
-destination and autosplits them. See L<ExtUtils::Install/pm_to_blib>
+destination and autosplits them. See L<ExtUtils::Install/DESCRIPTION>
 
 =cut
 
@@ -2441,7 +2560,7 @@ sub pm_to_blib {
 pm_to_blib: $(TO_INST_PM)
 	}.$self->{NOECHO}.q{$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" \
 	"-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Install \
-        -e 'pm_to_blib({qw{$(PM_TO_BLIB)}},"}.$autodir.q{")'
+        -e "pm_to_blib({qw{$(PM_TO_BLIB)}},'}.$autodir.q{')"
 	}.$self->{NOECHO}.q{$(TOUCH) $@
 };
 }
@@ -2460,7 +2579,7 @@ sub post_constants{
 
 =item post_initialize (o)
 
-Returns an ampty string per default. Used in Makefile.PLs to add some
+Returns an empty string per default. Used in Makefile.PLs to add some
 chunk of text to the Makefile after the object is initialized.
 
 =cut
@@ -2534,7 +2653,7 @@ sub realclean {
 realclean purge ::  clean
 ');
     # realclean subdirectories first (already cleaned)
-    my $sub = "\t-cd %s && test -f %s && \$(MAKE) %s realclean\n";
+    my $sub = "\t-cd %s && \$(TEST_F) %s && \$(MAKE) %s realclean\n";
     foreach(@{$self->{DIR}}){
 	push(@m, sprintf($sub,$_,"$self->{MAKEFILE}.old","-f $self->{MAKEFILE}.old"));
 	push(@m, sprintf($sub,$_,"$self->{MAKEFILE}",''));
@@ -2609,14 +2728,14 @@ END
 
     push @m,
 q{	$(AR) $(AR_STATIC_ARGS) $@ $(OBJECT) && $(RANLIB) $@
-	}.$self->{NOECHO}.q{echo "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)/extralibs.ld
 	$(CHMOD) 755 $@
+	}.$self->{NOECHO}.q{echo "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)/extralibs.ld
 };
-
-# Old mechanism - still available:
-
-    push @m, "\t$self->{NOECHO}".q{echo "$(EXTRALIBS)" >> $(PERL_SRC)/ext.libs}."\n\n"
-	if $self->{PERL_SRC};
+    # Old mechanism - still available:
+    push @m,
+"\t$self->{NOECHO}".q{echo "$(EXTRALIBS)" >> $(PERL_SRC)/ext.libs
+}	if $self->{PERL_SRC} && $self->{EXTRALIBS};
+    push @m, "\n";
 
     push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
     join('', "\n",@m);
@@ -2720,7 +2839,10 @@ sub test {
 # --- Test and Installation Sections ---
 
     my($self, %attribs) = @_;
-    my($tests) = $attribs{TESTS} || (-d "t" ? "t/*.t" : "");
+    my $tests = $attribs{TESTS};
+    if (!$tests && -d 't') {
+	$tests = $Is_Win32 ? join(' ', <t\\*.t>) : 't/*.t';
+    }
     my(@m);
     push(@m,"
 TEST_VERBOSE=0
@@ -2732,7 +2854,7 @@ testdb :: testdb_\$(LINKTYPE)
 
 test :: \$(TEST_TYPE)
 ");
-    push(@m, map("\t$self->{NOECHO}cd $_ && test -f $self->{MAKEFILE} && \$(MAKE) test \$(PASTHRU)\n",
+    push(@m, map("\t$self->{NOECHO}cd $_ && \$(TEST_F) $self->{MAKEFILE} && \$(MAKE) test \$(PASTHRU)\n",
 		 @{$self->{DIR}}));
     push(@m, "\t$self->{NOECHO}echo 'No tests defined for \$(NAME) extension.'\n")
 	unless $tests or -f "test.pl" or @{$self->{DIR}};
@@ -2773,7 +2895,8 @@ Helper method to write the test targets
 
 sub test_via_harness {
     my($self, $perl, $tests) = @_;
-    "\tPERL_DL_NONLAZY=1 $perl".q! -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use Test::Harness qw(&runtests $$verbose); $$verbose=$(TEST_VERBOSE); runtests @ARGV;' !."$tests\n";
+    $perl = "PERL_DL_NONLAZY=1 $perl" unless $Is_Win32;
+    "\t$perl".q! -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use Test::Harness qw(&runtests $$verbose); $$verbose=$(TEST_VERBOSE); runtests @ARGV;' !."$tests\n";
 }
 
 =item test_via_script (o)
@@ -2784,7 +2907,8 @@ Other helper method for test.
 
 sub test_via_script {
     my($self, $perl, $script) = @_;
-    qq{\tPERL_DL_NONLAZY=1 $perl}.q{ -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) }.qq{$script
+    $perl = "PERL_DL_NONLAZY=1 $perl" unless $Is_Win32;
+    qq{\t$perl}.q{ -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) }.qq{$script
 };
 }
 
@@ -2823,27 +2947,23 @@ sub tools_other {
 SHELL = $bin_sh
 };
 
-    for (qw/ CHMOD CP LD MV NOOP RM_F RM_RF TOUCH UMASK_NULL / ) {
+    for (qw/ CHMOD CP LD MV NOOP RM_F RM_RF TEST_F TOUCH UMASK_NULL DEV_NULL/ ) {
 	push @m, "$_ = $self->{$_}\n";
     }
 
-
     push @m, q{
 # The following is a portable way to say mkdir -p
 # To see which directories are created, change the if 0 to if 1
-MKPATH = $(PERL) -wle '$$"="/"; foreach $$p (@ARGV){' \\
--e 'next if -d $$p; my(@p); foreach(split(/\//,$$p)){' \\
--e 'push(@p,$$_); next if -d "@p/"; print "mkdir @p" if 0;' \\
--e 'mkdir("@p",0777)||die $$! } } exit 0;'
+MKPATH = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e mkpath
 
 # This helps us to minimize the effect of the .exists files A yet
 # better solution would be to have a stable file in the perl
 # distribution with a timestamp of zero. But this solution doesn't
 # need any changes to the core distribution and works with older perls
-EQUALIZE_TIMESTAMP = $(PERL) -we 'open F, ">$$ARGV[1]"; close F;' \\
--e 'utime ((stat("$$ARGV[0]"))[8,9], $$ARGV[1])'
+EQUALIZE_TIMESTAMP = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e eqtime
 };
 
+
     return join "", @m if $self->{PARENT};
 
     push @m, q{
@@ -2858,16 +2978,18 @@ UNINST=0
 VERBINST=1
 
 MOD_INSTALL = $(PERL) -I$(INST_LIB) -I$(PERL_LIB) -MExtUtils::Install \
--e 'install({@ARGV},"$(VERBINST)",0,"$(UNINST)");'
+-e "install({@ARGV},'$(VERBINST)',0,'$(UNINST)');"
 
-DOC_INSTALL = $(PERL) -e '$$\="\n\n";print "=head3 ", scalar(localtime), ": C<", shift, ">";' \
+DOC_INSTALL = $(PERL) -e '$$\="\n\n";' \
+-e 'print "=head2 ", scalar(localtime), ": C<", shift, ">", " L<", shift, ">";' \
 -e 'print "=over 4";' \
 -e 'while (defined($$key = shift) and defined($$val = shift)){print "=item *";print "C<$$key: $$val>";}' \
 -e 'print "=back";'
 
 UNINSTALL =   $(PERL) -MExtUtils::Install \
--e 'uninstall($$ARGV[0],1);'
-
+-e 'uninstall($$ARGV[0],1,1); print "\nUninstall is deprecated. Please check the";' \
+-e 'print " packlist above carefully.\n  There may be errors. Remove the";' \
+-e 'print " appropriate files manually.\n  Sorry for the inconveniences.\n"'
 };
 
     return join "", @m;
@@ -2995,10 +3117,15 @@ sub top_targets {
     my(@m);
     push @m, '
 #all ::	config $(INST_PM) subdirs linkext manifypods
+';
 
+    push @m, '
 all :: pure_all manifypods
 	'.$self->{NOECHO}.'$(NOOP)
-
+' 
+	  unless $self->{SKIPHASH}{'all'};
+    
+    push @m, '
 pure_all :: config pm_to_blib subdirs linkext
 	'.$self->{NOECHO}.'$(NOOP)
 
@@ -3053,7 +3180,7 @@ help:
 Version_check:
 	}.$self->{NOECHO}.q{$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \
 		-MExtUtils::MakeMaker=Version_check \
-		-e 'Version_check("$(MM_VERSION)")'
+		-e "Version_check('$(MM_VERSION)')"
 };
 
     join('',@m);
@@ -3085,7 +3212,7 @@ sub xs_c {
     return '' unless $self->needs_linking();
     '
 .xs.c:
-	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs >$*.tc && mv $*.tc $@
+	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs >$*.tc && $(MV) $*.tc $@
 ';
 }
 
@@ -3101,13 +3228,41 @@ sub xs_o {	# many makes are too dumb to use xs_c then c_o
     return '' unless $self->needs_linking();
     '
 .xs$(OBJ_EXT):
-	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs >xstmp.c && mv xstmp.c $*.c
+	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs >xstmp.c && $(MV) xstmp.c $*.c
 	$(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.c
 ';
 }
 
+=item perl_archive
+
+This is internal method that returns path to libperl.a equivalent
+to be linked to dynamic extensions. UNIX does not have one but OS2
+and Win32 do.
+
+=cut 
+
+sub perl_archive
+{
+ return "";
+}
+
+=item export_list
+
+This is internal method that returns name of a file that is
+passed to linker to define symbols to be exported.
+UNIX does not have one but OS2 and Win32 do.
+
+=cut 
+
+sub export_list
+{
+ return "";
+}
+
+
 1;
 
+=back
 
 =head1 SEE ALSO
 
diff --git a/lib/ExtUtils/MM_VMS.pm b/lib/ExtUtils/MM_VMS.pm
index 9a382284d1..23e8fdbe7d 100644
--- a/lib/ExtUtils/MM_VMS.pm
+++ b/lib/ExtUtils/MM_VMS.pm
@@ -6,14 +6,18 @@
 #   Author:  Charles Bailey  bailey@genetics.upenn.edu
 
 package ExtUtils::MM_VMS;
-$ExtUtils::MM_VMS::Revision=$ExtUtils::MM_VMS::Revision = '5.35 (23-Jun-1996)';
-unshift @MM::ISA, 'ExtUtils::MM_VMS';
 
+use Carp qw( &carp );
 use Config;
 require Exporter;
 use VMS::Filespec;
 use File::Basename;
 
+use vars qw($Revision);
+$Revision = '5.3901 (6-Mar-1997)';
+
+unshift @MM::ISA, 'ExtUtils::MM_VMS';
+
 Exporter::import('ExtUtils::MakeMaker', '$Verbose', '&neatvalue');
 
 =head1 NAME
@@ -32,6 +36,8 @@ the semantics.
 
 =head2 Methods always loaded
 
+=over
+
 =item eliminate_macros
 
 Expands MM[KS]/Make macros in a text string, using the contents of
@@ -47,16 +53,23 @@ sub eliminate_macros {
 	return '';
     }
     my($npath) = unixify($path);
+    my($complex) = 0;
     my($head,$macro,$tail);
 
     # perform m##g in scalar context so it acts as an iterator
     while ($npath =~ m#(.*?)\$\((\S+?)\)(.*)#g) { 
         if ($self->{$2}) {
             ($head,$macro,$tail) = ($1,$2,$3);
-            ($macro = unixify($self->{$macro})) =~ s#/$##;
+            if (ref $self->{$macro}) {
+              carp "Can't expand macro containing " . ref $self->{$macro};
+              $npath = "$head\cB$macro\cB$tail";
+              $complex = 1;
+            }
+            else { ($macro = unixify($self->{$macro})) =~ s#/$##; }
             $npath = "$head$macro$tail";
         }
     }
+    if ($complex) { $npath =~ s#\cB(.*?)\cB#\$($1)#g; }
     print "eliminate_macros($path) = |$npath|\n" if $Verbose >= 3;
     $npath;
 }
@@ -92,7 +105,7 @@ sub fixpath {
         }
     }
     elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#)) && $self->{$prefix}) {
-        my($vmspre) = vmspath($self->{$prefix}) || ''; # is it a dir or just a name?
+        my($vmspre) = vmspath($self->eliminate_macros("\$($prefix)")) || ''; # is it a dir or just a name?
         $fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name;
         $fixedpath = vmspath($fixedpath) if $force_path;
     }
@@ -102,6 +115,8 @@ sub fixpath {
     }
     # Convert names without directory or type to paths
     if (!$force_path and $fixedpath !~ /[:>(.\]]/) { $fixedpath = vmspath($fixedpath); }
+    # Trim off root dirname if it's had other dirs inserted in front of it.
+    $fixedpath =~ s/\.000000([\]>])/$1/;
     print "fixpath($path) = |$fixedpath|\n" if $Verbose >= 3;
     $fixedpath;
 }
@@ -123,9 +138,12 @@ sub catdir {
       my($spath,$sdir) = ($path,$dir);
       $spath =~ s/.dir$//; $sdir =~ s/.dir$//; 
       $sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+$/;
-      $rslt = vmspath($self->eliminate_macros($spath)."/$sdir");
+      $rslt = $self->fixpath($self->eliminate_macros($spath)."/$sdir",1);
+    }
+    else { 
+      if ($dir =~ /^\$\([^\)]+\)$/) { $rslt = $dir; }
+      else                          { $rslt = vmspath($dir); }
     }
-    else { $rslt = vmspath($dir); }
     print "catdir(",join(',',@_[1..$#_]),") = |$rslt|\n" if $Verbose >= 3;
     $rslt;
 }
@@ -157,6 +175,30 @@ sub catfile {
     $rslt;
 }
 
+=item wraplist
+
+Converts a list into a string wrapped at approximately 80 columns.
+
+=cut
+
+sub wraplist {
+    my($self) = shift;
+    my($line,$hlen) = ('',0);
+    my($word);
+
+    foreach $word (@_) {
+      # Perl bug -- seems to occasionally insert extra elements when
+      # traversing array (scalar(@array) doesn't show them, but
+      # foreach(@array) does) (5.00307)
+      next unless $word =~ /\w/;
+      $line .= ', ' if length($line);
+      if ($hlen > 80) { $line .= "\\\n\t"; $hlen = 0; }
+      $line .= $word;
+      $hlen += length($word) + 2;
+    }
+    $line;
+}
+
 =item curdir (override)
 
 Returns a string representing of the current directory.
@@ -189,6 +231,7 @@ sub updir {
 
 package ExtUtils::MM_VMS;
 
+sub ExtUtils::MM_VMS::ext;
 sub ExtUtils::MM_VMS::guess_name;
 sub ExtUtils::MM_VMS::find_perl;
 sub ExtUtils::MM_VMS::path;
@@ -199,7 +242,6 @@ sub ExtUtils::MM_VMS::file_name_is_absolute;
 sub ExtUtils::MM_VMS::replace_manpage_separator;
 sub ExtUtils::MM_VMS::init_others;
 sub ExtUtils::MM_VMS::constants;
-sub ExtUtils::MM_VMS::const_loadlibs;
 sub ExtUtils::MM_VMS::cflags;
 sub ExtUtils::MM_VMS::const_cccmd;
 sub ExtUtils::MM_VMS::pm_to_blib;
@@ -263,6 +305,17 @@ sub AUTOLOAD {
 
 #__DATA__
 
+
+# This isn't really an override.  It's just here because ExtUtils::MM_VMS
+# appears in @MM::ISA before ExtUtils::Liblist, so if there isn't an ext()
+# in MM_VMS, then AUTOLOAD is called, and bad things happen.  So, we just
+# mimic inheritance here and hand off to ExtUtils::Liblist.
+sub ext {
+  ExtUtils::Liblist::ext(@_);
+}
+
+=back
+
 =head2 SelfLoaded methods
 
 Those methods which override default MM_Unix methods are marked
@@ -271,6 +324,8 @@ For overridden methods, documentation is limited to an explanation
 of why this method overrides the MM_Unix method; see the ExtUtils::MM_Unix
 documentation for more details.
 
+=over
+
 =item guess_name (override)
 
 Try to determine name of extension being built.  We begin with the name
@@ -284,12 +339,24 @@ package name.
 
 sub guess_name {
     my($self) = @_;
-    my($defname,$defpm);
+    my($defname,$defpm,@pm,%xs,$pm);
     local *PM;
 
     $defname = basename(fileify($ENV{'DEFAULT'}));
     $defname =~ s![\d\-_]*\.dir.*$!!;  # Clip off .dir;1 suffix, and package version
     $defpm = $defname;
+    # Fallback in case for some reason a user has copied the files for an
+    # extension into a working directory whose name doesn't reflect the
+    # extension's name.  We'll use the name of a unique .pm file, or the
+    # first .pm file with a matching .xs file.
+    if (not -e "${defpm}.pm") {
+      @pm = map { s/.pm$//; $_ } glob('*.pm');
+      if (@pm == 1) { ($defpm = $pm[0]) =~ s/.pm$//; }
+      elsif (@pm) {
+        %xs = map { s/.xs$//; ($_,1) } glob('*.xs');
+        if (%xs) { foreach $pm (@pm) { $defpm = $pm, last if exists $xs{$pm}; } }
+      }
+    }
     if (open(PM,"${defpm}.pm")){
         while (<PM>) {
             if (/^\s*package\s+([^;]+)/i) {
@@ -317,13 +384,14 @@ invoke Perl images.
 
 =cut
 
-sub find_perl{
+sub find_perl {
     my($self, $ver, $names, $dirs, $trace) = @_;
     my($name,$dir,$vmsfile,@sdirs,@snames,@cand);
+    my($inabs) = 0;
     # Check in relative directories first, so we pick up the current
     # version of Perl if we're running MakeMaker as part of the main build.
-    @sdirs = sort { my($absb) = file_name_is_absolute($a);
-                    my($absb) = file_name_is_absolute($b);
+    @sdirs = sort { my($absa) = $self->file_name_is_absolute($a);
+                    my($absb) = $self->file_name_is_absolute($b);
                     if ($absa && $absb) { return $a cmp $b }
                     else { return $absa ? 1 : ($absb ? -1 : ($a cmp $b)); }
                   } @$dirs;
@@ -332,9 +400,16 @@ sub find_perl{
     # executable that's less likely to be from an old installation.
     @snames = sort { my($ba) = $a =~ m!([^:>\]/]+)$!;  # basename
                      my($bb) = $b =~ m!([^:>\]/]+)$!;
-                     substr($ba,0,1) cmp substr($bb,0,1)
-                     or -1*(length($ba) <=> length($bb)) } @$names;
-    if ($trace){
+                     my($ahasdir) = (length($a) - length($ba) > 0);
+                     my($bhasdir) = (length($b) - length($bb) > 0);
+                     if    ($ahasdir and not $bhasdir) { return 1; }
+                     elsif ($bhasdir and not $ahasdir) { return -1; }
+                     else { $bb =~ /\d/ <=> $ba =~ /\d/
+                            or substr($ba,0,1) cmp substr($bb,0,1)
+                            or length($bb) <=> length($ba) } } @$names;
+    # Image names containing Perl version use '_' instead of '.' under VMS
+    foreach $name (@snames) { $name =~ s/\.(\d+)$/_$1/; }
+    if ($trace >= 2){
 	print "Looking for perl $ver by these names:\n";
 	print "\t@snames,\n";
 	print "in these dirs:\n";
@@ -342,6 +417,14 @@ sub find_perl{
     }
     foreach $dir (@sdirs){
 	next unless defined $dir; # $self->{PERL_SRC} may be undefined
+	$inabs++ if $self->file_name_is_absolute($dir);
+	if ($inabs == 1) {
+	    # We've covered relative dirs; everything else is an absolute
+	    # dir (probably an installed location).  First, we'll try potential
+	    # command names, to see whether we can avoid a long MCR expression.
+	    foreach $name (@snames) { push(@cand,$name) if $name =~ /^[\w\-\$]+$/; }
+	    $inabs++; # Should happen above in next $dir, but just in case . . .
+	}
 	foreach $name (@snames){
 	    if ($name !~ m![/:>\]]!) { push(@cand,$self->catfile($dir,$name)); }
 	    else                     { push(@cand,$self->fixpath($name));      }
@@ -349,12 +432,18 @@ sub find_perl{
     }
     foreach $name (@cand) {
 	print "Checking $name\n" if ($trace >= 2);
+	# If it looks like a potential command, try it without the MCR
+	if ($name =~ /^[\w\-\$]+$/ &&
+	    `$name -e "require $ver; print ""VER_OK\n"""` =~ /VER_OK/) {
+	    print "Using PERL=$name\n" if $trace;
+	    return $name;
+	}
 	next unless $vmsfile = $self->maybe_command($name);
 	$vmsfile =~ s/;[\d\-]*$//;  # Clip off version number; we can use a newer version as well
 	print "Executing $vmsfile\n" if ($trace >= 2);
 	if (`MCR $vmsfile -e "require $ver; print ""VER_OK\n"""` =~ /VER_OK/) {
 	    print "Using PERL=MCR $vmsfile\n" if $trace;
-	    return "MCR $vmsfile"
+	    return "MCR $vmsfile";
 	}
     }
     print STDOUT "Unable to find a perl $ver (by these names: @$names, in these dirs: @$dirs)\n";
@@ -378,22 +467,32 @@ sub path {
 
 Follows VMS naming conventions for executable files.
 If the name passed in doesn't exactly match an executable file,
-appends F<.Exe> to check for executable image, and F<.Com> to check
-for DCL procedure.  If this fails, checks F<Sys$Share:> for an
-executable file having the name specified.  Finally, appends F<.Exe>
-and checks again.
+appends F<.Exe> (or equivalent) to check for executable image, and F<.Com>
+to check for DCL procedure.  If this fails, checks directories in DCL$PATH
+and finally F<Sys$System:> for an executable file having the name specified,
+with or without the F<.Exe>-equivalent suffix.
 
 =cut
 
 sub maybe_command {
     my($self,$file) = @_;
     return $file if -x $file && ! -d _;
-    return "$file.exe" if -x "$file.exe";
-    return "$file.com" if -x "$file.com";
+    my(@dirs) = ('');
+    my(@exts) = ('',$Config{'exe_ext'},'.exe','.com');
+    my($dir,$ext);
     if ($file !~ m![/:>\]]!) {
-	my($shrfile) = 'Sys$Share:' . $file;
-	return $file if -x $shrfile && ! -d _;
-	return "$file.exe" if -x "$shrfile.exe";
+	for (my $i = 0; defined $ENV{"DCL\$PATH;$i"}; $i++) {
+	    $dir = $ENV{"DCL\$PATH;$i"};
+	    $dir .= ':' unless $dir =~ m%[\]:]$%;
+	    push(@dirs,$dir);
+	}
+	push(@dirs,'Sys$System:');
+	foreach $dir (@dirs) {
+	    my $sysfile = "$dir$file";
+	    foreach $ext (@exts) {
+		return $file if -x "$sysfile$ext" && ! -d _;
+	    }
+	}
     }
     return 0;
 }
@@ -424,7 +523,7 @@ sub maybe_command_in_dirs {	# $ver is optional argument if looking for perl
 	    if (defined $ver) {
 		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;
+		    print "Using $abs\n" if $trace;
 		    return $abs;
 		}
 	    } else { # Do not look for perl
@@ -436,8 +535,8 @@ sub maybe_command_in_dirs {	# $ver is optional argument if looking for perl
 
 =item perl_script (override)
 
-If name passed in doesn't specify a readable file, appends F<.pl> and
-tries again, since it's customary to have file types on all files
+If name passed in doesn't specify a readable file, appends F<.com> or
+F<.pl> and tries again, since it's customary to have file types on all files
 under VMS.
 
 =cut
@@ -445,7 +544,8 @@ under VMS.
 sub perl_script {
     my($self,$file) = @_;
     return $file if -r $file && ! -d _;
-    return "$file.pl" if -r "$file.pl" && ! -d _;
+    return "$file.com" if -r "$file.com";
+    return "$file.pl" if -r "$file.pl";
     return '';
 }
 
@@ -456,8 +556,10 @@ Checks for VMS directory spec as well as Unix separators.
 =cut
 
 sub file_name_is_absolute {
-    my($self,$file);
-    $file =~ m!^/! or $file =~ m![:<\[][^.\-]!;
+    my($self,$file) = @_;
+    # If it's a logical name, expand it.
+    $file = $ENV{$file} while $file =~ /^[\w\$\-]+$/ and $ENV{$file};
+    $file =~ m!^/! or $file =~ m![<\[][^.\-\]>]! or $file =~ /:[^<\[]/;
 }
 
 =item replace_manpage_separator
@@ -483,7 +585,7 @@ off to the default MM_Unix method.
 sub init_others {
     my($self) = @_;
 
-    $self->{NOOP} = "\t@ Continue";
+    $self->{NOOP} = 'Continue';
     $self->{FIRST_MAKEFILE} ||= 'Descrip.MMS';
     $self->{MAKE_APERL_FILE} ||= 'Makeaperl.MMS';
     $self->{MAKEFILE} ||= $self->{FIRST_MAKEFILE};
@@ -494,7 +596,7 @@ sub init_others {
     $self->{CHMOD} = '$(PERL) -e "chmod @ARGV"';  # expect Unix syntax from MakeMaker
     $self->{CP} = 'Copy/NoConfirm';
     $self->{MV} = 'Rename/NoConfirm';
-    $self->{UMASK_NULL} = "\t!";  
+    $self->{UMASK_NULL} = '! ';  
     &ExtUtils::MM_Unix::init_others;
 }
 
@@ -514,29 +616,24 @@ sub constants {
 	my(@defs) = split(/\s+/,$self->{DEFINE});
 	foreach $def (@defs) {
 	    next unless $def;
-	    $def =~ s/^-D//;
-	    $def = "\"$def\"" if $def =~ /=/;
+	    if ($def =~ s/^-D//) {       # If it was a Unix-style definition
+		$def =~ s/='(.*)'$/=$1/;  # then remove shell-protection ''
+		$def =~ s/^'(.*)'$/$1/;   # from entire term or argument
+	    }
+	    if ($def =~ /=/) {
+		$def =~ s/"/""/g;  # Protect existing " from DCL
+		$def = qq["$def"]; # and quote to prevent parsing of =
+	    }
 	}
 	$self->{DEFINE} = join ',',@defs;
     }
 
     if ($self->{OBJECT} =~ /\s/) {
 	$self->{OBJECT} =~ s/(\\)?\n+\s+/ /g;
-	$self->{OBJECT} = map($self->fixpath($_),split(/,?\s+/,$self->{OBJECT}));
+	$self->{OBJECT} = join(' ',map($self->fixpath($_),split(/,?\s+/,$self->{OBJECT})));
     }
     $self->{LDFROM} = join(' ',map($self->fixpath($_),split(/,?\s+/,$self->{LDFROM})));
 
-    if ($self->{'INC'} && $self->{INC} !~ m!/Include=!i) {
-	my(@val) = ( '/Include=(' );
-	my(@includes) = split(/\s+/,$self->{INC});
-	my($plural);
-	foreach (@includes) {
-	    s/^-I//;
-	    push @val,', ' if $plural++;
-	    push @val,$self->fixpath($_,1);
-	}
-	$self->{INC} = join('',@val,')');
-    }
 
     # Fix up directory specs
     $self->{ROOTEXT} = $self->{ROOTEXT} ? $self->fixpath($self->{ROOTEXT},1)
@@ -593,8 +690,14 @@ MM_VMS_REVISION = $ExtUtils::MM_VMS::Revision
 ];
 
     for $tmp (qw/
-	      FULLEXT BASEEXT PARENT_NAME DLBASE VERSION_FROM INC DEFINE OBJECT
-	      LDFROM LINKTYPE
+	      FULLEXT VERSION_FROM OBJECT LDFROM
+	      /	) {
+	next unless defined $self->{$tmp};
+	push @m, "$tmp = ",$self->fixpath($self->{$tmp}),"\n";
+    }
+
+    for $tmp (qw/
+	      BASEEXT PARENT_NAME DLBASE INC DEFINE LINKTYPE
 	      /	) {
 	next unless defined $self->{$tmp};
 	push @m, "$tmp = $self->{$tmp}\n";
@@ -621,12 +724,12 @@ MM_VMS_REVISION = $ExtUtils::MM_VMS::Revision
     push @m,'
 
 # Handy lists of source code files:
-XS_FILES = ',join(', ', sort keys %{$self->{XS}}),'
-C_FILES  = ',join(', ', @{$self->{C}}),'
-O_FILES  = ',join(', ', @{$self->{O_FILES}} ),'
-H_FILES  = ',join(', ', @{$self->{H}}),'
-MAN1PODS = ',join(', ', sort keys %{$self->{MAN1PODS}}),'
-MAN3PODS = ',join(', ', sort keys %{$self->{MAN3PODS}}),'
+XS_FILES = ',$self->wraplist(', ', sort keys %{$self->{XS}}),'
+C_FILES  = ',$self->wraplist(', ', @{$self->{C}}),'
+O_FILES  = ',$self->wraplist(', ', @{$self->{O_FILES}} ),'
+H_FILES  = ',$self->wraplist(', ', @{$self->{H}}),'
+MAN1PODS = ',$self->wraplist(', ', sort keys %{$self->{MAN1PODS}}),'
+MAN3PODS = ',$self->wraplist(', ', sort keys %{$self->{MAN3PODS}}),'
 
 ';
 
@@ -638,18 +741,19 @@ MAN3PODS = ',join(', ', sort keys %{$self->{MAN3PODS}}),'
     }
 
 push @m,"
+.SUFFIXES :
 .SUFFIXES : \$(OBJ_EXT) .c .cpp .cxx .xs
 
 # Here is the Config.pm that we are using/depend on
 CONFIGDEP = \$(PERL_ARCHLIB)Config.pm, \$(PERL_INC)config.h \$(VERSION_FROM)
 
 # Where to put things:
-INST_LIBDIR = ",($self->{'INST_LIBDIR'} = $self->catdir($self->{INST_LIB},$self->{ROOTEXT})),"
-INST_ARCHLIBDIR = ",($self->{'INST_ARCHLIBDIR'} = $self->catdir($self->{INST_ARCHLIB},$self->{ROOTEXT})),"
+INST_LIBDIR      = $self->{INST_LIBDIR}
+INST_ARCHLIBDIR  = $self->{INST_ARCHLIBDIR}
 
-INST_AUTODIR = ",($self->{'INST_AUTODIR'} = $self->catdir($self->{INST_LIB},'auto',$self->{FULLEXT})),'
-INST_ARCHAUTODIR = ',($self->{'INST_ARCHAUTODIR'} = $self->catdir($self->{INST_ARCHLIB},'auto',$self->{FULLEXT})),'
-';
+INST_AUTODIR     = $self->{INST_AUTODIR}
+INST_ARCHAUTODIR = $self->{INST_ARCHAUTODIR}
+";
 
     if ($self->has_link_code()) {
 	push @m,'
@@ -663,79 +767,27 @@ INST_STATIC =
 INST_DYNAMIC =
 INST_BOOT =
 EXPORT_LIST = $(BASEEXT).opt
-PERL_ARCHIVE = ',($ENV{'PERLSHR'} ? $ENV{'PERLSHR'} : 'Sys$Share:PerlShr.Exe'),'
+PERL_ARCHIVE = ',($ENV{'PERLSHR'} ? $ENV{'PERLSHR'} : "Sys\$Share:PerlShr.$Config{'dlext'}"),'
 ';
     }
 
     $self->{TO_INST_PM} = [ sort keys %{$self->{PM}} ];
     $self->{PM_TO_BLIB} = [ %{$self->{PM}} ];
     push @m,'
-TO_INST_PM = ',join(', ',@{$self->{TO_INST_PM}}),'
+TO_INST_PM = ',$self->wraplist(', ',@{$self->{TO_INST_PM}}),'
 
-PM_TO_BLIB = ',join(', ',@{$self->{PM_TO_BLIB}}),'
+PM_TO_BLIB = ',$self->wraplist(', ',@{$self->{PM_TO_BLIB}}),'
 ';
 
     join('',@m);
 }
 
-=item const_loadlibs (override)
-
-Basically a stub which passes through library specfications provided
-by the caller.  Will be updated or removed when VMS support is added
-to ExtUtils::Liblist.
-
-=cut
-
-sub const_loadlibs{
-    my($self) = @_;
-    my (@m);
-    push @m, "
-# $self->{NAME} might depend on some other libraries.
-# (These comments may need revising:)
-#
-# Dependent libraries can be linked in one of three ways:
-#
-#  1.  (For static extensions) by the ld command when the perl binary
-#      is linked with the extension library. See EXTRALIBS below.
-#
-#  2.  (For dynamic extensions) by the ld command when the shared
-#      object is built/linked. See LDLOADLIBS below.
-#
-#  3.  (For dynamic extensions) by the DynaLoader when the shared
-#      object is loaded. See BSLOADLIBS below.
-#
-# EXTRALIBS =	List of libraries that need to be linked with when
-#		linking a perl binary which includes this extension
-#		Only those libraries that actually exist are included.
-#		These are written to a file and used when linking perl.
-#
-# LDLOADLIBS =	List of those libraries which can or must be linked into
-#		the shared library when created using ld. These may be
-#		static or dynamic libraries.
-#		LD_RUN_PATH is a colon separated list of the directories
-#		in LDLOADLIBS. It is passed as an environment variable to
-#		the process that links the shared library.
-#
-# BSLOADLIBS =	List of those libraries that are needed but can be
-#		linked in dynamically at run time on this platform.
-#		SunOS/Solaris does not need this because ld records
-#		the information (from LDLOADLIBS) into the object file.
-#		This list is used to create a .bs (bootstrap) file.
-#
-EXTRALIBS  = ",map($self->fixpath($_) . ' ',$self->{'EXTRALIBS'}),"
-BSLOADLIBS = ",map($self->fixpath($_) . ' ',$self->{'BSLOADLIBS'}),"
-LDLOADLIBS = ",map($self->fixpath($_) . ' ',$self->{'LDLOADLIBS'}),"\n";
-
-    join('',@m);
-}
-
 =item cflags (override)
 
 Bypass shell script and produce qualifiers for CC directly (but warn
 user if a shell script for this extension exists).  Fold multiple
-/Defines into one, and do the same with /Includes, since some C
-compilers pay attention to only one instance of these qualifiers
-on the command line.
+/Defines into one, since some C compilers pay attention to only one
+instance of this qualifier on the command line.
 
 =cut
 
@@ -780,10 +832,7 @@ sub cflags {
 	    $incstr .= ', '.$self->fixpath($_,1);
 	}
     }
-    if ($quals =~ m:(.*)/include=\(?([^\(\/\)\s]+)\)?(.*):i) {
-	$quals = "$1$incstr,$2)$3";
-    }
-    else { $quals .= "$incstr)"; }
+    $quals .= "$incstr)";
 
     $optimize = '/Debug/NoOptimize'
 	if ($self->{OPTIMIZE} =~ /-g/ or $self->{OPTIMIZE} =~ m!/Debug!i);
@@ -800,7 +849,7 @@ LARGE =
 =item const_cccmd (override)
 
 Adds directives to point C preprocessor to the right place when
-handling #include <sys/foo.h> directives.  Also constructs CC
+handling #include E<lt>sys/foo.hE<gt> directives.  Also constructs CC
 command line a bit differently than MM_Unix method.
 
 =cut
@@ -851,25 +900,31 @@ sub pm_to_blib {
     my(@files) = @{$self->{PM_TO_BLIB}};
 
     push @m, q{
+
+# Dummy target to match Unix target name; we use pm_to_blib.ts as
+# timestamp file to avoid repeated invocations under VMS
+pm_to_blib : pm_to_blib.ts
+	$(NOECHO) $(NOOP)
+
 # As always, keep under DCL's 255-char limit
-pm_to_blib : $(TO_INST_PM)
-	},$self->{NOECHO},q{$(PERL) -e "print '},shift(@files),q{ },shift(@files),q{'" >.MM_tmp
+pm_to_blib.ts : $(TO_INST_PM)
+	$(NOECHO) $(PERL) -e "print '},shift(@files),q{ },shift(@files),q{'" >.MM_tmp
 };
 
     $line = '';  # avoid uninitialized var warning
     while ($from = shift(@files),$to = shift(@files)) {
 	$line .= " $from $to";
 	if (length($line) > 128) {
-	    push(@m,"\t$self->{NOECHO}\$(PERL) -e \"print '$line'\" >>.MM_tmp\n");
+	    push(@m,"\t\$(NOECHO) \$(PERL) -e \"print '$line'\" >>.MM_tmp\n");
 	    $line = '';
 	}
     }
-    push(@m,"\t$self->{NOECHO}\$(PERL) -e \"print '$line'\" >>.MM_tmp\n") if $line;
+    push(@m,"\t\$(NOECHO) \$(PERL) -e \"print '$line'\" >>.MM_tmp\n") if $line;
 
     push(@m,q[	$(PERL) "-I$(PERL_LIB)" "-MExtUtils::Install" -e "pm_to_blib({split(' ',<STDIN>)},'].$autodir.q[')" <.MM_tmp]);
     push(@m,qq[
-	$self->{NOECHO}Delete/NoLog/NoConfirm .MM_tmp;
-	$self->{NOECHO}\$(TOUCH) pm_to_blib.ts
+	\$(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;
+	\$(NOECHO) \$(TOUCH) pm_to_blib.ts
 ]);
 
     join('',@m);
@@ -948,8 +1003,8 @@ XSUBPPARGS = @tmargs
 
 =item xsubpp_version (override)
 
-Test xsubpp exit status according to VMS rules ($sts & 1 ==> good)
-rather than Unix rules ($sts == 0 ==> good).
+Test xsubpp exit status according to VMS rules ($sts & 1 ==E<gt> good)
+rather than Unix rules ($sts == 0 ==E<gt> good).
 
 =cut
 
@@ -966,7 +1021,10 @@ sub xsubpp_version
     my $command = "$self->{PERL} \"-I$self->{PERL_LIB}\" $xsubpp -v";
     print "Running: $command\n" if $Verbose;
     $version = `$command` ;
-    warn "Running '$command' exits with status " . $? unless ($? & 1);
+    if ($?) {
+	use vmsish 'status';
+	warn "Running '$command' exits with status $?";
+    }
     chop $version ;
 
     return $1 if $version =~ /^xsubpp version (.*)/ ;
@@ -993,7 +1051,10 @@ EOM
     $command = "$self->{PERL} $xsubpp $file";
     print "Running: $command\n" if $Verbose;
     my $text = `$command` ;
-    warn "Running '$command' exits with status " . $? unless ($? & 1);
+    if ($?) {
+	use vmsish 'status';
+	warn "Running '$command' exits with status $?";
+    }
     unlink $file ;
 
     # gets 1.2 -> 1.92 and 2.000a1
@@ -1034,15 +1095,17 @@ CP = $self->{CP}
 MV = $self->{MV}
 RM_F  = $self->{RM_F}
 RM_RF = $self->{RM_RF}
+SAY = Write Sys\$Output
 UMASK_NULL = $self->{UMASK_NULL}
 NOOP = $self->{NOOP}
+NOECHO = $self->{NOECHO}
 MKPATH = Create/Directory
 EQUALIZE_TIMESTAMP = \$(PERL) -we "open F,qq{>\$ARGV[1]};close F;utime(0,(stat(\$ARGV[0]))[9]+1,\$ARGV[1])"
 !. ($self->{PARENT} ? '' : 
 qq!WARN_IF_OLD_PACKLIST = \$(PERL) -e "if (-f \$ARGV[0]){print qq[WARNING: Old package found (\$ARGV[0]); please check for collisions\\n]}"
 MOD_INSTALL = \$(PERL) "-I\$(PERL_LIB)" "-MExtUtils::Install" -e "install({split(' ',<STDIN>)},1);"
-DOC_INSTALL = \$(PERL) -e "\@ARGV=split('|',<STDIN>);print '=head3 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];while(\$key=shift && \$val=shift){print qq[=item *\\n\\nC<\$key: \$val>\\n\\n];}print qq[=back\\n\\n]"
-UNINSTALL = \$(PERL) "-I\$(PERL_LIB)" "-MExtUtils::Install" -e "uninstall(\$ARGV[0],1);"
+DOC_INSTALL = \$(PERL) -e "\@ARGV=split(/\\|/,<STDIN>);print '=head2 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];while(\$key=shift && \$val=shift){print qq[=item *\\n\\nC<\$key: \$val>\\n\\n];}print qq[=back\\n\\n]"
+UNINSTALL = \$(PERL) "-I\$(PERL_LIB)" "-MExtUtils::Install" -e "uninstall(\$ARGV[0],1,1);"
 !);
 }
 
@@ -1056,12 +1119,17 @@ default MM_Unix method.
 sub dist {
     my($self, %attribs) = @_;
     $attribs{VERSION}      ||= $self->{VERSION_SYM};
+    $attribs{NAME}         ||= $self->{DISTNAME};
     $attribs{ZIPFLAGS}     ||= '-Vu';
     $attribs{COMPRESS}     ||= 'gzip';
     $attribs{SUFFIX}       ||= '-gz';
     $attribs{SHAR}         ||= 'vms_share';
     $attribs{DIST_DEFAULT} ||= 'zipdist';
 
+    # Sanitize these for use in $(DISTVNAME) filespec
+    $attribs{VERSION} =~ s/[^\w\$]/_/g;
+    $attribs{NAME} =~ s/[^\w\$]/_/g;
+
     return ExtUtils::MM_Unix::dist($self,%attribs);
 }
 
@@ -1130,27 +1198,27 @@ sub top_targets {
     my(@m);
     push @m, '
 all :: pure_all manifypods
-	$(NOOP)
+	$(NOECHO) $(NOOP)
 
 pure_all :: config pm_to_blib subdirs linkext
-	$(NOOP)
+	$(NOECHO) $(NOOP)
 
 subdirs :: $(MYEXTLIB)
-	$(NOOP)
+	$(NOECHO) $(NOOP)
 
 config :: $(MAKEFILE) $(INST_LIBDIR).exists
-	$(NOOP)
+	$(NOECHO) $(NOOP)
 
 config :: $(INST_ARCHAUTODIR).exists
-	$(NOOP)
+	$(NOECHO) $(NOOP)
 
 config :: $(INST_AUTODIR).exists
-	$(NOOP)
+	$(NOECHO) $(NOOP)
 ';
 
     push @m, q{
 config :: Version_check
-	$(NOOP)
+	$(NOECHO) $(NOOP)
 
 } unless $self->{PARENT} or ($self->{PERL_SRC} && $self->{INSTALLDIRS} eq "perl") or $self->{NO_VC};
 
@@ -1159,14 +1227,14 @@ config :: Version_check
     if (%{$self->{MAN1PODS}}) {
 	push @m, q[
 config :: $(INST_MAN1DIR).exists
-	$(NOOP)
+	$(NOECHO) $(NOOP)
 ];
 	push @m, $self->dir_target(qw[$(INST_MAN1DIR)]);
     }
     if (%{$self->{MAN3PODS}}) {
 	push @m, q[
 config :: $(INST_MAN3DIR).exists
-	$(NOOP)
+	$(NOECHO) $(NOOP)
 ];
 	push @m, $self->dir_target(qw[$(INST_MAN3DIR)]);
     }
@@ -1182,7 +1250,7 @@ help :
 
     push @m, q{
 Version_check :
-	},$self->{NOECHO},q{$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -
+	$(NOECHO) $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -
 	"-MExtUtils::MakeMaker=Version_check" -e "&Version_check('$(MM_VERSION)')"
 };
 
@@ -1210,12 +1278,12 @@ sub dlsyms {
     unless ($self->{SKIPHASH}{'dynamic'}) {
 	push(@m,'
 dynamic :: rtls.opt $(INST_ARCHAUTODIR)$(BASEEXT).opt
-	$(NOOP)
+	$(NOECHO) $(NOOP)
 ');
 	if ($srcdir) {
 	   my($popt) = $self->catfile($srcdir,'perlshr.opt');
 	   my($lopt) = $self->catfile($srcdir,'crtl.opt');
-	   push(@m,"# Depend on $(BASEEXT).opt to insure we copy here *after* autogenerating (wrong) rtls.opt in Mksymlists
+	   push(@m,"# Depend on \$(BASEEXT).opt to insure we copy here *after* autogenerating (wrong) rtls.opt in Mksymlists
 rtls.opt : $popt $lopt \$(BASEEXT).opt
 	Copy/Log $popt Sys\$Disk:[]rtls.opt
 	Append/Log $lopt Sys\$Disk:[]rtls.opt
@@ -1232,7 +1300,7 @@ rtls.opt : $(BASEEXT).opt
 
     push(@m,'
 static :: $(INST_ARCHAUTODIR)$(BASEEXT).opt
-	$(NOOP)
+	$(NOECHO) $(NOOP)
 ') unless $self->{SKIPHASH}{'static'};
 
     push(@m,'
@@ -1246,7 +1314,21 @@ $(BASEEXT).opt : Makefile.PL
 	$(PERL) -e "print ""$(INST_STATIC)/Include=$(BASEEXT)\n$(INST_STATIC)/Library\n"";" >>$(MMS$TARGET)
 ');
 
+    if (length $self->{LDLOADLIBS}) {
+	my($lib); my($line) = '';
+	foreach $lib (split ' ', $self->{LDLOADLIBS}) {
+	    $lib =~ s%\$%\\\$%g;  # Escape '$' in VMS filespecs
+	    if (length($line) + length($lib) > 160) {
+		push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n";
+		$line = $lib . '\n';
+	    }
+	    else { $line .= $lib . '\n'; }
+	}
+	push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n" if $line;
+    }
+
     join('',@m);
+
 }
 
 =item dynamic_lib (override)
@@ -1272,7 +1354,8 @@ INST_DYNAMIC_DEP = $inst_dynamic_dep
 ";
     push @m, '
 $(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt rtls.opt $(INST_ARCHAUTODIR).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
-	',$self->{NOECHO},'$(MKPATH) $(INST_ARCHAUTODIR)
+	$(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR)
+	$(NOECHO) If F$TrnLNm("PerlShr").eqs."" Then Define/NoLog/User PerlShr Sys$Share:PerlShr.',$Config{'dlext'},'
 	Link $(LDFLAGS) /Shareable=$(MMS$TARGET)$(OTHERLDFLAGS) $(BASEEXT).opt/Option,rtls.opt/Option,$(PERL_INC)perlshr_attr.opt/Option
 ';
 
@@ -1298,13 +1381,13 @@ BOOTSTRAP = '."$self->{BASEEXT}.bs".'
 # we use touch to prevent make continually trying to remake it.
 # The DynaLoader only reads a non-empty file.
 $(BOOTSTRAP) : $(MAKEFILE) '."$self->{BOOTDEP}".' $(INST_ARCHAUTODIR).exists
-	'.$self->{NOECHO}.'Write Sys$Output "Running mkbootstrap for $(NAME) ($(BSLOADLIBS))"
-	'.$self->{NOECHO}.'$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -
+	$(NOECHO) $(SAY) "Running mkbootstrap for $(NAME) ($(BSLOADLIBS))"
+	$(NOECHO) $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -
 	-e "use ExtUtils::Mkbootstrap; Mkbootstrap(\'$(BASEEXT)\',\'$(BSLOADLIBS)\');"
-	'.$self->{NOECHO}.' $(TOUCH) $(MMS$TARGET)
+	$(NOECHO) $(TOUCH) $(MMS$TARGET)
 
 $(INST_BOOT) : $(BOOTSTRAP) $(INST_ARCHAUTODIR).exists
-	'.$self->{NOECHO}.'$(RM_RF) $(INST_BOOT)
+	$(NOECHO) $(RM_RF) $(INST_BOOT)
 	- $(CP) $(BOOTSTRAP) $(INST_BOOT)
 ';
 }
@@ -1321,7 +1404,7 @@ sub static_lib {
 
     return '
 $(INST_STATIC) :
-	$(NOOP)
+	$(NOECHO) $(NOOP)
 ' unless ($self->{OBJECT} or @{$self->{C} || []} or $self->{MYEXTLIB});
 
     my(@m);
@@ -1338,7 +1421,7 @@ $(INST_STATIC) : $(OBJECT) $(MYEXTLIB)
     push(@m,'
 	If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET)
 	Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)
-	',$self->{NOECHO},'$(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR)extralibs.ld\';print F qq[$(EXTRALIBS)\n];close F;"
+	$(NOECHO) $(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR)extralibs.ld\';print F qq{$(EXTRALIBS)\n};close F;"
 ');
     push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
     join('',@m);
@@ -1358,8 +1441,8 @@ $(INST_STATIC) : $(OBJECT) $(MYEXTLIB)
 # 
 #     push(@m, "
 # $inst : $dist \$(MAKEFILE) ${instdir}.exists \$(INST_ARCHAUTODIR).exists
-# ",'	',$self->{NOECHO},'$(RM_F) $(MMS$TARGET)
-# 	',$self->{NOECHO},'$(CP) ',"$dist $inst",'
+# ",'	$(NOECHO) $(RM_F) $(MMS$TARGET)
+# 	$(NOECHO) $(CP) ',"$dist $inst",'
 # 	$(CHMOD) 644 $(MMS$TARGET)
 # ');
 #     push(@m, '	$(AUTOSPLITFILE) $(MMS$TARGET) ',
@@ -1380,7 +1463,7 @@ to specify fallback location at build time if we can't find pod2man.
 
 sub manifypods {
     my($self, %attribs) = @_;
-    return "\nmanifypods :\n\t\$(NOOP)\n" unless %{$self->{MAN3PODS}} or %{$self->{MAN1PODS}};
+    return "\nmanifypods :\n\t\$(NOECHO) \$(NOOP)\n" unless %{$self->{MAN3PODS}} or %{$self->{MAN1PODS}};
     my($dist);
     my($pod2man_exe);
     if (defined $self->{PERL_SRC}) {
@@ -1388,8 +1471,7 @@ sub manifypods {
     } else {
 	$pod2man_exe = $self->catfile($Config{scriptdirexp},'pod2man');
     }
-    if ($pod2man_exe = $self->perl_script($pod2man_exe)) { $found_pod2man = 1; }
-    else {
+    if (not ($pod2man_exe = $self->perl_script($pod2man_exe))) {
 	# No pod2man but some MAN3PODS to be installed
 	print <<END;
 
@@ -1406,9 +1488,7 @@ qq[POD2MAN_EXE = $pod2man_exe\n],
 q[POD2MAN = $(PERL) -we "%m=@ARGV;for (keys %m){" -
 -e "system(""MCR $^X $(POD2MAN_EXE) $_ >$m{$_}"");}"
 ];
-    push @m, "\nmanifypods : ";
-    push @m, join " ", keys %{$self->{MAN1PODS}}, keys %{$self->{MAN3PODS}};
-    push(@m,"\n");
+    push @m, "\nmanifypods : \$(MAN1PODS) \$(MAN3PODS)\n";
     if (%{$self->{MAN1PODS}} || %{$self->{MAN3PODS}}) {
 	my($pod);
 	foreach $pod (sort keys %{$self->{MAN1PODS}}) {
@@ -1434,12 +1514,14 @@ sub processPL {
     return "" unless $self->{PL_FILES};
     my(@m, $plfile);
     foreach $plfile (sort keys %{$self->{PL_FILES}}) {
+	my $vmsplfile = vmsify($plfile);
+	my $vmsfile = vmsify($self->{PL_FILES}->{$plfile});
 	push @m, "
-all :: $self->{PL_FILES}->{$plfile}
-	\$(NOOP)
+all :: $vmsfile
+	\$(NOECHO) \$(NOOP)
 
-$self->{PL_FILES}->{$plfile} :: $plfile
-",'	$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" '," $plfile
+$vmsfile :: $vmsplfile
+",'	$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" '," $vmsplfile
 ";
     }
     join "", @m;
@@ -1458,19 +1540,20 @@ sub installbin {
     return '' unless $self->{EXE_FILES} && ref $self->{EXE_FILES} eq "ARRAY";
     return '' unless @{$self->{EXE_FILES}};
     my(@m, $from, $to, %fromto, @to, $line);
-    for $from (@{$self->{EXE_FILES}}) {
+    my(@exefiles) = map { vmsify($_) } @{$self->{EXE_FILES}};
+    for $from (@exefiles) {
 	my($path) = '$(INST_SCRIPT)' . basename($from);
 	local($_) = $path;  # backward compatibility
 	$to = $self->libscan($path);
 	print "libscan($from) => '$to'\n" if ($Verbose >=2);
-	$fromto{$from}=$to;
+	$fromto{$from} = vmsify($to);
     }
-    @to   = values %fromto;
+    @to = values %fromto;
     push @m, "
-EXE_FILES = @{$self->{EXE_FILES}}
+EXE_FILES = @exefiles
 
 all :: @to
-	\$(NOOP)
+	\$(NOECHO) \$(NOOP)
 
 realclean ::
 ";
@@ -1514,7 +1597,7 @@ sub subdir_x {
 subdirs ::
 	olddef = F$Environment("Default")
 	Set Default ',$subdir,'
-	- $(MMS) all $(USEMACROS)$(PASTHRU)$(MACROEND)
+	- $(MMS)$(MMSQUALIFIERS) all $(USEMACROS)$(PASTHRU)$(MACROEND)
 	Set Default \'olddef\'
 ';
     join('',@m);
@@ -1538,14 +1621,26 @@ clean ::
 ';
     foreach $dir (@{$self->{DIR}}) { # clean subdirectories first
 	my($vmsdir) = $self->fixpath($dir,1);
-	push( @m, '	If F$Search("'.$vmsdir.'$(MAKEFILE)") Then \\',"\n\t",
-	      '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS) clean`;"',"\n");
+	push( @m, '	If F$Search("'.$vmsdir.'$(MAKEFILE)").nes."" Then \\',"\n\t",
+	      '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS)$(MMSQUALIFIERS) clean`;"',"\n");
     }
-    push @m, '	$(RM_F) *.Map *.Dmp *.Lis *.cpp *.$(DLEXT) *$(OBJ_EXT) *$(LIB_EXT) *.Opt $(BOOTSTRAP) $(BASEEXT).bso
+    push @m, '	$(RM_F) *.Map *.Dmp *.Lis *.cpp *.$(DLEXT) *$(OBJ_EXT) *$(LIB_EXT) *.Opt $(BOOTSTRAP) $(BASEEXT).bso .MM_Tmp
 ';
 
     my(@otherfiles) = values %{$self->{XS}}; # .c files from *.xs files
-    push(@otherfiles, $attribs{FILES}) if $attribs{FILES};
+    # Unlink realclean, $attribs{FILES} is a string here; it may contain
+    # a list or a macro that expands to a list.
+    if ($attribs{FILES}) {
+	my($word,$key,@filist);
+	if (ref $attribs{FILES} eq 'ARRAY') { @filist = @{$attribs{FILES}}; }
+	else { @filist = split /\s+/, $attribs{FILES}; }
+	foreach $word (@filist) {
+	    if (($key) = $word =~ m#^\$\((.*)\)$# and ref $self->{$key} eq 'ARRAY') {
+		push(@otherfiles, @{$self->{$key}});
+	    }
+	    else { push(@otherfiles, $attribs{FILES}); }
+	}
+    }
     push(@otherfiles, qw[ blib $(MAKE_APERL_FILE) extralibs.ld perlmain.c pm_to_blib.ts ]);
     push(@otherfiles,$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'));
     my($file,$line);
@@ -1558,7 +1653,7 @@ clean ::
 	}
 	else { $line .= " $file"; }
     }
-    push @m, "\t\$(RM_RF) $line\n" if line;
+    push @m, "\t\$(RM_RF) $line\n" if $line;
     push(@m, "	$attribs{POSTOP}\n") if $attribs{POSTOP};
     join('', @m);
 }
@@ -1579,7 +1674,7 @@ realclean :: clean
     foreach(@{$self->{DIR}}){
 	my($vmsdir) = $self->fixpath($_,1);
 	push(@m, '	If F$Search("'."$vmsdir".'$(MAKEFILE)").nes."" Then \\',"\n\t",
-	      '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS) realclean`;"',"\n");
+	      '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS)$(MMSQUALIFIERS) realclean`;"',"\n");
     }
     push @m,'	$(RM_RF) $(INST_AUTODIR) $(INST_ARCHAUTODIR)
 ';
@@ -1604,9 +1699,18 @@ realclean :: clean
 	else { $line .= " $file"; }
     }
     push @m, "\t\$(RM_F) $line\n" if $line;
-    if ($attribs{FILES} && ref $attribs{FILES} eq 'ARRAY') {
+    if ($attribs{FILES}) {
+	my($word,$key,@filist,@allfiles);
+	if (ref $attribs{FILES} eq 'ARRAY') { @filist = @{$attribs{FILES}}; }
+	else { @filist = split /\s+/, $attribs{FILES}; }
+	foreach $word (@filist) {
+	    if (($key) = $word =~ m#^\$\((.*)\)$# and ref $self->{$key} eq 'ARRAY') {
+		push(@allfiles, @{$self->{$key}});
+	    }
+	    else { push(@allfiles, $attribs{FILES}); }
+	}
 	$line = '';
-	foreach $file (@{$attribs{'FILES'}}) {
+	foreach $file (@allfiles) {
 	    $file = $self->fixpath($file);
 	    if (length($line) + length($file) > 80) {
 		push @m, "\t\$(RM_RF) $line\n";
@@ -1630,13 +1734,13 @@ sub dist_basics {
     my($self) = @_;
 '
 distclean :: realclean distcheck
-	$(NOOP)
+	$(NOECHO) $(NOOP)
 
 distcheck :
 	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest \'&fullcheck\'; fullcheck()"
 
 skipcheck :
-	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest \'&fullcheck\'; skipcheck()"
+	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest \'&skipcheck\'; skipcheck()"
 
 manifest :
 	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest \'&mkmanifest\'; mkmanifest()"
@@ -1654,28 +1758,28 @@ sub dist_core {
     my($self) = @_;
 q[
 dist : $(DIST_DEFAULT)
-	].$self->{NOECHO}.q[$(PERL) -le "print 'Warning: $m older than $vf' if -e ($vf = '$(VERSION_FROM)') && -M $vf < -M ($m = '$(MAKEFILE)'"
+	$(NOECHO) $(PERL) -le "print 'Warning: $m older than $vf' if -e ($vf = '$(VERSION_FROM)') && -M $vf < -M ($m = '$(MAKEFILE)')"
 
 zipdist : $(DISTVNAME).zip
-	$(NOOP)
+	$(NOECHO) $(NOOP)
 
 $(DISTVNAME).zip : distdir
 	$(PREOP)
-	$(ZIP) "$(ZIPFLAGS)" $(MMS$TARGET) $(SRC)
+	$(ZIP) "$(ZIPFLAGS)" $(MMS$TARGET) [.$(DISTVNAME)...]*.*;
 	$(RM_RF) $(DISTVNAME)
 	$(POSTOP)
 
 $(DISTVNAME).tar$(SUFFIX) : distdir
 	$(PREOP)
 	$(TO_UNIX)
-	$(TAR) "$(TARFLAGS)" $(DISTVNAME).tar $(SRC)
+	$(TAR) "$(TARFLAGS)" $(DISTVNAME).tar [.$(DISTVNAME)]
 	$(RM_RF) $(DISTVNAME)
 	$(COMPRESS) $(DISTVNAME).tar
 	$(POSTOP)
 
 shdist : distdir
 	$(PREOP)
-	$(SHARE) $(SRC) $(DISTVNAME).share
+	$(SHAR) [.$(DISTVNAME...]*.*; $(DISTVNAME).share
 	$(RM_RF) $(DISTVNAME)
 	$(POSTOP)
 ];
@@ -1711,8 +1815,8 @@ disttest : distdir
 	startdir = F$Environment("Default")
 	Set Default [.$(DISTVNAME)]
 	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL
-	$(MMS)
-	$(MMS) test
+	$(MMS)$(MMSQUALIFIERS)
+	$(MMS)$(MMSQUALIFIERS) test
 	Set Default 'startdir'
 };
 }
@@ -1735,93 +1839,110 @@ sub install {
 	foreach $file (@{$self->{EXE_FILES}}) {
 	    $line .= "$file ";
 	    if (length($line) > 128) {
-		push(@docfiles,qq[\t\$(PERL) -e "print $line" >>.MM_tmp\n]);
+		push(@docfiles,qq[\t\$(PERL) -e "print '$line'" >>.MM_tmp\n]);
 		$line = '';
 	    }
 	}
-	push(@docfiles,qq[\t\$(PERL) -e "print $line" >>.MM_tmp\n]) if $line;
+	push(@docfiles,qq[\t\$(PERL) -e "print '$line'" >>.MM_tmp\n]) if $line;
     }
 
     push @m, q[
 install :: all pure_install doc_install
-	$(NOOP)
+	$(NOECHO) $(NOOP)
 
 install_perl :: all pure_perl_install doc_perl_install
-	$(NOOP)
+	$(NOECHO) $(NOOP)
 
 install_site :: all pure_site_install doc_site_install
-	$(NOOP)
+	$(NOECHO) $(NOOP)
 
 install_ :: install_site
-	],$self->{NOECHO},q[Write Sys$Output "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
+	$(NOECHO) $(SAY) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
 
 pure_install :: pure_$(INSTALLDIRS)_install
-	$(NOOP)
+	$(NOECHO) $(NOOP)
 
 doc_install :: doc_$(INSTALLDIRS)_install
-	],$self->{NOECHO},q[Write Sys$Output "Appending installation info to $(INST_ARCHLIB)perllocal.pod"
+	$(NOECHO) $(SAY) "Appending installation info to $(INSTALLARCHLIB)perllocal.pod"
 
 pure__install : pure_site_install
-	],$self->{NOECHO},q[Write Sys$Output "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
+	$(NOECHO) $(SAY) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
 
 doc__install : doc_site_install
-	],$self->{NOECHO},q[Write Sys$Output "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
+	$(NOECHO) $(SAY) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
 
 # This hack brought to you by DCL's 255-character command line limit
 pure_perl_install ::
-	].$self->{NOECHO}.q[$(PERL) -e "print 'read ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[ '" >.MM_tmp
-	].$self->{NOECHO}.q[$(PERL) -e "print 'write ].$self->catfile('$(INSTALLARCHLIB)','auto','$(FULLEXT)','.packlist').q[ '" >>.MM_tmp
-	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_LIB) $(INSTALLPRIVLIB) '" >>.MM_tmp
-	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_ARCHLIB) $(INSTALLARCHLIB) '" >>.MM_tmp
-	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_BIN) $(INSTALLBIN) '" >>.MM_tmp
-	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_SCRIPT) $(INSTALLSCRIPT) '" >>.MM_tmp
-	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_MAN1DIR) $(INSTALLMAN1DIR) '" >>.MM_tmp
-	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_MAN3DIR) $(INSTALLMAN3DIR) '" >>.MM_tmp
+	$(NOECHO) $(PERL) -e "print 'read ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[ '" >.MM_tmp
+	$(NOECHO) $(PERL) -e "print 'write ].$self->catfile('$(INSTALLARCHLIB)','auto','$(FULLEXT)','.packlist').q[ '" >>.MM_tmp
+	$(NOECHO) $(PERL) -e "print '$(INST_LIB) $(INSTALLPRIVLIB) '" >>.MM_tmp
+	$(NOECHO) $(PERL) -e "print '$(INST_ARCHLIB) $(INSTALLARCHLIB) '" >>.MM_tmp
+	$(NOECHO) $(PERL) -e "print '$(INST_BIN) $(INSTALLBIN) '" >>.MM_tmp
+	$(NOECHO) $(PERL) -e "print '$(INST_SCRIPT) $(INSTALLSCRIPT) '" >>.MM_tmp
+	$(NOECHO) $(PERL) -e "print '$(INST_MAN1DIR) $(INSTALLMAN1DIR) '" >>.MM_tmp
+	$(NOECHO) $(PERL) -e "print '$(INST_MAN3DIR) $(INSTALLMAN3DIR) '" >>.MM_tmp
 	$(MOD_INSTALL) <.MM_tmp
-	].$self->{NOECHO}.q[Delete/NoLog/NoConfirm .MM_tmp;
-	].$self->{NOECHO}.q[$(WARN_IF_OLD_PACKLIST) ].$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q[
+	$(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;
+	$(NOECHO) $(WARN_IF_OLD_PACKLIST) ].$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q[
 
 # Likewise
 pure_site_install ::
-	].$self->{NOECHO}.q[$(PERL) -e "print 'read ].$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q[ '" >.MM_tmp
-	].$self->{NOECHO}.q[$(PERL) -e "print 'write ].$self->catfile('$(INSTALLSITEARCH)','auto','$(FULLEXT)','.packlist').q[ '" >>.MM_tmp
-	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_LIB) $(INSTALLSITELIB) '" >>.MM_tmp
-	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_ARCHLIB) $(INSTALLSITEARCH) '" >>.MM_tmp
-	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_BIN) $(INSTALLBIN) '" >>.MM_tmp
-	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_SCRIPT) $(INSTALLSCRIPT) '" >>.MM_tmp
-	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_MAN1DIR) $(INSTALLMAN1DIR) '" >>.MM_tmp
-	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_MAN3DIR) $(INSTALLMAN3DIR) '" >>.MM_tmp
+	$(NOECHO) $(PERL) -e "print 'read ].$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q[ '" >.MM_tmp
+	$(NOECHO) $(PERL) -e "print 'write ].$self->catfile('$(INSTALLSITEARCH)','auto','$(FULLEXT)','.packlist').q[ '" >>.MM_tmp
+	$(NOECHO) $(PERL) -e "print '$(INST_LIB) $(INSTALLSITELIB) '" >>.MM_tmp
+	$(NOECHO) $(PERL) -e "print '$(INST_ARCHLIB) $(INSTALLSITEARCH) '" >>.MM_tmp
+	$(NOECHO) $(PERL) -e "print '$(INST_BIN) $(INSTALLBIN) '" >>.MM_tmp
+	$(NOECHO) $(PERL) -e "print '$(INST_SCRIPT) $(INSTALLSCRIPT) '" >>.MM_tmp
+	$(NOECHO) $(PERL) -e "print '$(INST_MAN1DIR) $(INSTALLMAN1DIR) '" >>.MM_tmp
+	$(NOECHO) $(PERL) -e "print '$(INST_MAN3DIR) $(INSTALLMAN3DIR) '" >>.MM_tmp
 	$(MOD_INSTALL) <.MM_tmp
-	].$self->{NOECHO}.q[Delete/NoLog/NoConfirm .MM_tmp;
-	].$self->{NOECHO}.q[$(WARN_IF_OLD_PACKLIST) ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[
+	$(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;
+	$(NOECHO) $(WARN_IF_OLD_PACKLIST) ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[
 
 # Ditto
 doc_perl_install ::
-	].$self->{NOECHO}.q[$(PERL) -e "print 'Module $(NAME)|installed into|$(INSTALLPRIVLIB)|'" >.MM_tmp
-	].$self->{NOECHO}.q[$(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|'" >>.MM_tmp
-	].$self->{NOECHO}.q[$(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|'" >>.MM_tmp
-],@docfiles,q[	$(DOC_INSTALL) <.MM_tmp >>].$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[
-	].$self->{NOECHO}.q[Delete/NoLog/NoConfirm .MM_tmp;
+	$(NOECHO) $(PERL) -e "print 'Module $(NAME)|installed into|$(INSTALLPRIVLIB)|'" >.MM_tmp
+	$(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|'" >>.MM_tmp
+	$(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|'" >>.MM_tmp
+],@docfiles,
+q%	$(NOECHO) $(PERL) -e "print q[@ARGV=split(/\\|/,<STDIN>);]" >.MM2_tmp
+	$(NOECHO) $(PERL) -e "print q[print '=head3 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];]" >>.MM2_tmp
+	$(NOECHO) $(PERL) -e "print q[while(($key=shift) && ($val=shift)) ]" >>.MM2_tmp
+	$(NOECHO) $(PERL) -e "print q[{print qq[=item *\\n\\nC<$key: $val>\\n\\n];}print qq[=back\\n\\n];]" >>.MM2_tmp
+	$(NOECHO) $(PERL) .MM2_tmp <.MM_tmp >>%.$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[
+	$(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;,.MM2_tmp;
 
 # And again
 doc_site_install ::
-	].$self->{NOECHO}.q[$(PERL) -e "print 'Module $(NAME)|installed into|$(INSTALLSITELIB)|'" >.MM_tmp
-	].$self->{NOECHO}.q[$(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|'" >>.MM_tmp
-	].$self->{NOECHO}.q[$(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|'" >>.MM_tmp
-],@docfiles,q[	$(DOC_INSTALL) <.MM_tmp >>].$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[
-	].$self->{NOECHO}.q[Delete/NoLog/NoConfirm .MM_tmp;
+	$(NOECHO) $(PERL) -e "print 'Module $(NAME)|installed into|$(INSTALLSITELIB)|'" >.MM_tmp
+	$(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|'" >>.MM_tmp
+	$(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|'" >>.MM_tmp
+],@docfiles,
+q%	$(NOECHO) $(PERL) -e "print q[@ARGV=split(/\\|/,<STDIN>);]" >.MM2_tmp
+	$(NOECHO) $(PERL) -e "print q[print '=head3 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];]" >>.MM2_tmp
+	$(NOECHO) $(PERL) -e "print q[while(($key=shift) && ($val=shift)) ]" >>.MM2_tmp
+	$(NOECHO) $(PERL) -e "print q[{print qq[=item *\\n\\nC<$key: $val>\\n\\n];}print qq[=back\\n\\n];]" >>.MM2_tmp
+	$(NOECHO) $(PERL) .MM2_tmp <.MM_tmp >>%.$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[
+	$(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;,.MM2_tmp;
 
 ];
 
     push @m, q[
 uninstall :: uninstall_from_$(INSTALLDIRS)dirs
-	$(NOOP)
+	$(NOECHO) $(NOOP)
 
 uninstall_from_perldirs ::
-	].$self->{NOECHO}.q[$(UNINSTALL) ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[
+	$(NOECHO) $(UNINSTALL) ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[
+	$(NOECHO) $(SAY) "Uninstall is now deprecated and makes no actual changes."
+	$(NOECHO) $(SAY) "Please check the list above carefully for errors, and manually remove"
+	$(NOECHO) $(SAY) "the appropriate files.  Sorry for the inconvenience."
 
 uninstall_from_sitedirs ::
-	].$self->{NOECHO}.q[$(UNINSTALL) ].$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist')."\n";
+	$(NOECHO) $(UNINSTALL) ],$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist'),"\n",q[
+	$(NOECHO) $(SAY) "Uninstall is now deprecated and makes no actual changes."
+	$(NOECHO) $(SAY) "Please check the list above carefully for errors, and manually remove"
+	$(NOECHO) $(SAY) "the appropriate files.  Sorry for the inconvenience."
+];
 
     join('',@m);
 }
@@ -1866,14 +1987,21 @@ $(OBJECT) : $(PERL_INC)vmsish.h, $(PERL_INC)util.h, $(PERL_INC)config.h
 # An out of date config.h is not fatal but complains loudly!
 #$(PERL_INC)config.h : $(PERL_SRC)config.sh
 $(PERL_INC)config.h : $(PERL_VMS)config.vms
-	],$self->{NOECHO},q[Write Sys$Error "Warning: $(PERL_INC)config.h out of date with $(PERL_VMS)config.vms"
+	$(NOECHO) Write Sys$Error "Warning: $(PERL_INC)config.h out of date with $(PERL_VMS)config.vms"
 
 #$(PERL_ARCHLIB)Config.pm : $(PERL_SRC)config.sh
 $(PERL_ARCHLIB)Config.pm : $(PERL_VMS)config.vms $(PERL_VMS)genconfig.pl
-	],$self->{NOECHO},q[Write Sys$Error "$(PERL_ARCHLIB)Config.pm may be out of date with config.vms or genconfig.pl"
+	$(NOECHO) Write Sys$Error "$(PERL_ARCHLIB)Config.pm may be out of date with config.vms or genconfig.pl"
 	olddef = F$Environment("Default")
 	Set Default $(PERL_SRC)
-	$(MMS)],$mmsquals,q[ $(MMS$TARGET)
+	$(MMS)],$mmsquals,);
+	if ($self->{PERL_ARCHLIB} =~ m|\[-| && $self->{PERL_SRC} =~ m|(\[-+)|) {
+	    my($prefix,$target) = ($1,$self->fixpath('$(PERL_ARCHLIB)Config.pm'));
+	    $target =~ s/\Q$prefix/[/;
+	    push(@m," $target");
+	}
+	else { push(@m,' $(MMS$TARGET)'); }
+	push(@m,q[
 	Set Default 'olddef'
 ]);
     }
@@ -1904,13 +2032,13 @@ $(OBJECT) : $(FIRST_MAKEFILE)
 # We take a very conservative approach here, but it\'s worth it.
 # We move $(MAKEFILE) to $(MAKEFILE)_old here to avoid gnu make looping.
 $(MAKEFILE) : Makefile.PL $(CONFIGDEP)
-	],$self->{NOECHO},q[Write Sys$Output "$(MAKEFILE) out-of-date with respect to $(MMS$SOURCE_LIST)"
-	],$self->{NOECHO},q[Write Sys$Output "Cleaning current config before rebuilding $(MAKEFILE) ..."
+	$(NOECHO) $(SAY) "$(MAKEFILE) out-of-date with respect to $(MMS$SOURCE_LIST)"
+	$(NOECHO) $(SAY) "Cleaning current config before rebuilding $(MAKEFILE) ..."
 	- $(MV) $(MAKEFILE) $(MAKEFILE)_old
-	- $(MMS) $(USEMAKEFILE)$(MAKEFILE)_old clean
+	- $(MMS)$(MMSQUALIFIERS) $(USEMAKEFILE)$(MAKEFILE)_old clean
 	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL ],join(' ',map(qq["$_"],@ARGV)),q[
-	],$self->{NOECHO},q[Write Sys$Output "$(MAKEFILE) has been rebuilt."
-	],$self->{NOECHO},q[Write Sys$Output "Please run $(MMS) to build the extension."
+	$(NOECHO) $(SAY) "$(MAKEFILE) has been rebuilt."
+	$(NOECHO) $(SAY) "Please run $(MMS) to build the extension."
 ];
 
     join('',@m);
@@ -1933,25 +2061,25 @@ TEST_FILE = test.pl
 TESTDB_SW = -d
 
 test :: \$(TEST_TYPE)
-	\$(NOOP)
+	\$(NOECHO) \$(NOOP)
 
 testdb :: testdb_\$(LINKTYPE)
-	\$(NOOP)
+	\$(NOECHO) \$(NOOP)
 
 ";
     foreach(@{$self->{DIR}}){
       my($vmsdir) = $self->fixpath($_,1);
       push(@m, '	If F$Search("',$vmsdir,'$(MAKEFILE)").nes."" Then $(PERL) -e "chdir ',"'$vmsdir'",
-           '; print `$(MMS) $(PASTHRU2) test`'."\n");
+           '; print `$(MMS)$(MMSQUALIFIERS) $(PASTHRU2) test`'."\n");
     }
-    push(@m, "\t$self->{NOECHO}Write Sys\$Output \"No tests defined for \$(NAME) extension.\"\n")
+    push(@m, "\t\$(NOECHO) \$(SAY) \"No tests defined for \$(NAME) extension.\"\n")
         unless $tests or -f "test.pl" or @{$self->{DIR}};
     push(@m, "\n");
 
     push(@m, "test_dynamic :: pure_all\n");
     push(@m, $self->test_via_harness('$(FULLPERL)', $tests)) if $tests;
     push(@m, $self->test_via_script('$(FULLPERL)', 'test.pl')) if -f "test.pl";
-    push(@m, "    \$(NOOP)\n") if (!$tests && ! -f "test.pl");
+    push(@m, "\t\$(NOECHO) \$(NOOP)\n") if (!$tests && ! -f "test.pl");
     push(@m, "\n");
 
     push(@m, "testdb_dynamic :: pure_all\n");
@@ -1971,8 +2099,8 @@ testdb :: testdb_\$(LINKTYPE)
 	push(@m, "\n");
     }
     else {
-	push @m, "test_static :: test_dynamic\n\t$self->{NOECHO}\$(NOOP)\n\n";
-	push @m, "testdb_static :: testdb_dynamic\n\t$self->{NOECHO}\$(NOOP)\n";
+	push @m, "test_static :: test_dynamic\n\t\$(NOECHO) \$(NOOP)\n\n";
+	push @m, "testdb_static :: testdb_dynamic\n\t\$(NOECHO) \$(NOOP)\n";
     }
 
     join('',@m);
@@ -2027,14 +2155,14 @@ MAP_TARGET    = $target
     unless ($self->{MAKEAPERL}) {
 	push @m, q{
 $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
-	},$self->{NOECHO},q{Write Sys$Output "Writing ""$(MMS$TARGET)"" for this $(MAP_TARGET)"
-	},$self->{NOECHO},q{$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" \
+	$(NOECHO) $(SAY) "Writing ""$(MMS$TARGET)"" for this $(MAP_TARGET)"
+	$(NOECHO) $(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
 
 $(MAP_TARGET) :: $(MAKE_APERL_FILE)
-	$(MMS)$(USEMAKEFILE)$(MAKE_APERL_FILE) static $(MMS$TARGET)
+	$(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKE_APERL_FILE) static $(MMS$TARGET)
 };
 	push @m, map( " \\\n\t\t$_", @ARGV );
 	push @m, "\n";
@@ -2043,7 +2171,7 @@ $(MAP_TARGET) :: $(MAKE_APERL_FILE)
     }
 
 
-    my($linkcmd,@staticopts,@staticpkgs,$extralist,$target,$targdir,$libperldir);
+    my($linkcmd,@staticopts,@staticpkgs,$extralist,$targdir,$libperldir);
 
     # The front matter of the linkcommand...
     $linkcmd = join ' ', $Config{'ld'},
@@ -2129,7 +2257,7 @@ $(MAP_TARGET) :: $(MAKE_APERL_FILE)
 	}
     }
 
-    $target = "Perl.Exe" unless $target;
+    $target = "Perl$Config{'exe_ext'}" unless $target;
     ($shrtarget,$targdir) = fileparse($target);
     $shrtarget =~ s/^([^.]*)/$1Shr/;
     $shrtarget = $targdir . $shrtarget;
@@ -2179,37 +2307,37 @@ $(MAP_SHRTARGET) : $(MAP_LIBPERL) $(MAP_STATIC) ',"${libperldir}Perlshr_Attr.Opt
 	$(MAP_LINKCMD)/Shareable=$(MMS$TARGET) $(MAP_OPTS), $(MAP_EXTRA), $(MAP_LIBPERL) ',"${libperldir}Perlshr_Attr.Opt",'
 $(MAP_TARGET) : $(MAP_SHRTARGET) ',"${tmp}perlmain\$(OBJ_EXT) ${tmp}PerlShr.Opt",'
 	$(MAP_LINKCMD) ',"${tmp}perlmain\$(OBJ_EXT)",', PerlShr.Opt/Option
-	',$self->{NOECHO},'Write Sys$Output "To install the new ""$(MAP_TARGET)"" binary, say"
-	',$self->{NOECHO},'Write Sys$Output "    $(MMS)$(USEMAKEFILE)$(MAKEFILE) inst_perl $(USEMACROS)MAP_TARGET=$(MAP_TARGET)$(ENDMACRO)"
-	',$self->{NOECHO},'Write Sys$Output "To remove the intermediate files, say
-	',$self->{NOECHO},'Write Sys$Output "    $(MMS)$(USEMAKEFILE)$(MAKEFILE) map_clean"
+	$(NOECHO) $(SAY) "To install the new ""$(MAP_TARGET)"" binary, say"
+	$(NOECHO) $(SAY) "    $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKEFILE) inst_perl $(USEMACROS)MAP_TARGET=$(MAP_TARGET)$(ENDMACRO)"
+	$(NOECHO) $(SAY) "To remove the intermediate files, say
+	$(NOECHO) $(SAY) "    $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKEFILE) map_clean"
 ';
     push @m,'
 ',"${tmp}perlmain.c",' : $(MAKEFILE)
-	',$self->{NOECHO},'$(PERL) $(MAP_PERLINC) -e "use ExtUtils::Miniperl; writemain(qw|',@staticpkgs,'|)" >$(MMS$TARGET)
+	$(NOECHO) $(PERL) $(MAP_PERLINC) -e "use ExtUtils::Miniperl; writemain(qw|',@staticpkgs,'|)" >$(MMS$TARGET)
 ';
 
     push @m, q[
 # More from the 255-char line length limit
 doc_inst_perl :
-	].$self->{NOECHO}.q[$(PERL) -e "print 'Perl binary $(MAP_TARGET)|'" >.MM_tmp
-	].$self->{NOECHO}.q[$(PERL) -e "print 'MAP_STATIC|$(MAP_STATIC)|'" >>.MM_tmp
-	].$self->{NOECHO}.q[$(PERL) -pl040 -e " " ].$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'),q[ >>.MM_tmp
-	].$self->{NOECHO}.q[$(PERL) -e "print 'MAP_LIBPERL|$(MAP_LIBPERL)|'" >>.MM_tmp
+	$(NOECHO) $(PERL) -e "print 'Perl binary $(MAP_TARGET)|'" >.MM_tmp
+	$(NOECHO) $(PERL) -e "print 'MAP_STATIC|$(MAP_STATIC)|'" >>.MM_tmp
+	$(NOECHO) $(PERL) -pl040 -e " " ].$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'),q[ >>.MM_tmp
+	$(NOECHO) $(PERL) -e "print 'MAP_LIBPERL|$(MAP_LIBPERL)|'" >>.MM_tmp
 	$(DOC_INSTALL) <.MM_tmp >>].$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[
-	].$self->{NOECHO}.q[Delete/NoLog/NoConfirm .MM_tmp;
+	$(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;
 ];
 
     push @m, "
 inst_perl : pure_inst_perl doc_inst_perl
-	\$(NOOP)
+	\$(NOECHO) \$(NOOP)
 
 pure_inst_perl : \$(MAP_TARGET)
 	$self->{CP} \$(MAP_SHRTARGET) ",$self->fixpath($Config{'installbin'},1),"
 	$self->{CP} \$(MAP_TARGET) ",$self->fixpath($Config{'installbin'},1),"
 
 clean :: map_clean
-	\$(NOOP)
+	\$(NOECHO) \$(NOOP)
 
 map_clean :
 	\$(RM_F) ${tmp}perlmain\$(OBJ_EXT) ${tmp}perlmain.c \$(MAKEFILE)
@@ -2219,18 +2347,6 @@ map_clean :
     join '', @m;
 }
   
-=item ext (specific)
-
-Stub routine standing in for C<ExtUtils::LibList::ext> until VMS
-support is added to that package.
-
-=cut
-
-sub ext {
-    my($self) = @_;
-    '','','';
-}
-
 # --- Output postprocessing section ---
 
 =item nicetext (override)
@@ -2250,5 +2366,9 @@ sub nicetext {
 
 1;
 
+=back
+
+=cut
+
 __END__
 
diff --git a/lib/ExtUtils/MM_Win32.pm b/lib/ExtUtils/MM_Win32.pm
new file mode 100644
index 0000000000..e3161b5412
--- /dev/null
+++ b/lib/ExtUtils/MM_Win32.pm
@@ -0,0 +1,493 @@
+package ExtUtils::MM_Win32;
+
+=head1 NAME
+
+ExtUtils::MM_Win32 - methods to override UN*X behaviour in ExtUtils::MakeMaker
+
+=head1 SYNOPSIS
+
+ use ExtUtils::MM_Win32; # Done internally by ExtUtils::MakeMaker if needed
+
+=head1 DESCRIPTION
+
+See ExtUtils::MM_Unix for a documentation of the methods provided
+there. This package overrides the implementation of these methods, not
+the semantics.
+
+=over
+
+=cut 
+
+#use Config;
+#use Cwd;
+use File::Basename;
+require Exporter;
+
+Exporter::import('ExtUtils::MakeMaker',
+       qw( $Verbose &neatvalue));
+
+$ENV{EMXSHELL} = 'sh'; # to run `commands`
+unshift @MM::ISA, 'ExtUtils::MM_Win32';
+
+sub dlsyms {
+    my($self,%attribs) = @_;
+
+    my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
+    my($vars)  = $attribs{DL_VARS} || $self->{DL_VARS} || [];
+    my($imports)  = $attribs{IMPORTS} || $self->{IMPORTS} || {};
+    my(@m);
+    (my $boot = $self->{NAME}) =~ s/:/_/g;
+
+    if (not $self->{SKIPHASH}{'dynamic'}) {
+	push(@m,"
+$self->{BASEEXT}.def: Makefile.PL
+",
+     q!	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Mksymlists \\
+     -e "Mksymlists('NAME' => '!, $self->{NAME},
+     q!', 'DLBASE' => '!,$self->{DLBASE},
+     q!', 'DL_FUNCS' => !,neatvalue($funcs),
+     q!, 'IMPORTS' => !,neatvalue($imports),
+     q!, 'DL_VARS' => !, neatvalue($vars), q!);"
+!);
+    }
+    join('',@m);
+}
+
+sub replace_manpage_separator {
+    my($self,$man) = @_;
+    $man =~ s,/+,.,g;
+    $man;
+}
+
+sub maybe_command {
+    my($self,$file) = @_;
+    return "$file.exe" if -e "$file.exe";
+    return;
+}
+
+sub file_name_is_absolute {
+    my($self,$file) = @_;
+    $file =~ m{^([a-z]:)?[\\/]}i ;
+}
+
+sub find_perl {
+    my($self, $ver, $names, $dirs, $trace) = @_;
+    my($name, $dir);
+    if ($trace >= 2){
+	print "Looking for perl $ver by these names:
+@$names
+in these dirs:
+@$dirs
+";
+    }
+    foreach $dir (@$dirs){
+	next unless defined $dir; # $self->{PERL_SRC} may be undefined
+	foreach $name (@$names){
+	    my ($abs, $val);
+	    if ($self->file_name_is_absolute($name)) { # /foo/bar
+		$abs = $name;
+	    } elsif ($self->canonpath($name) eq $self->canonpath(basename($name))) { # foo
+		$abs = $self->catfile($dir, $name);
+	    } else { # foo/bar
+		$abs = $self->canonpath($self->catfile($self->curdir, $name));
+	    }
+	    print "Checking $abs\n" if ($trace >= 2);
+	    next unless $self->maybe_command($abs);
+	    print "Executing $abs\n" if ($trace >= 2);
+	    $val = `$abs -e "require $ver;" 2>&1`;
+	    if ($? == 0) {
+	        print "Using PERL=$abs\n" if $trace;
+	        return $abs;
+	    } elsif ($trace >= 2) {
+		print "Result: `$val'\n";
+	    }
+	}
+    }
+    print STDOUT "Unable to find a perl $ver (by these names: @$names, in these dirs: @$dirs)\n";
+    0; # false and not empty
+}
+
+sub catdir {
+    my $self = shift;
+    my @args = @_;
+    for (@args) {
+	# append a slash to each argument unless it has one there
+	$_ .= "\\" if $_ eq '' or substr($_,-1) ne "\\";
+    }
+    my $result = $self->canonpath(join('', @args));
+    $result;
+}
+
+=item catfile
+
+Concatenate one or more directory names and a filename to form a
+complete path ending with a filename
+
+=cut
+
+sub catfile {
+    my $self = shift @_;
+    my $file = pop @_;
+    return $file unless @_;
+    my $dir = $self->catdir(@_);
+    $dir =~ s/(\\\.)$//;
+    $dir .= "\\" unless substr($dir,length($dir)-1,1) eq "\\";
+    return $dir.$file;
+}
+
+sub init_others
+{
+ my ($self) = @_;
+ &ExtUtils::MM_Unix::init_others;
+ $self->{'TOUCH'}  = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e touch';
+ $self->{'CHMOD'}  = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e chmod'; 
+ $self->{'CP'}     = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e cp';
+ $self->{'RM_F'}   = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e rm_f';
+ $self->{'RM_RF'}  = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e rm_rf';
+ $self->{'MV'}     = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e mv';
+ $self->{'NOOP'}   = 'rem';
+ $self->{'TEST_F'} = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e test_f';
+ $self->{'LD'}     = 'link';
+ $self->{'DEV_NULL'} = '> NUL';
+ # $self->{'NOECHO'} = ''; # till we have it working
+}
+
+sub path {
+    local $^W = 1;
+    my($self) = @_;
+    my $path = $ENV{'PATH'} || $ENV{'Path'} || $ENV{'path'};
+    my @path = split(';',$path);
+    foreach(@path) { $_ = '.' if $_ eq '' }
+    @path;
+}
+
+=item static_lib (o)
+
+Defines how to produce the *.a (or equivalent) files.
+
+=cut
+
+sub static_lib {
+    my($self) = @_;
+# Come to think of it, if there are subdirs with linkcode, we still have no INST_STATIC
+#    return '' unless $self->needs_linking(); #might be because of a subdir
+
+    return '' unless $self->has_link_code;
+
+    my(@m);
+    push(@m, <<'END');
+$(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)/.exists
+	$(RM_RF) $@
+END
+    # If this extension has it's own library (eg SDBM_File)
+    # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
+    push(@m, "\t$self->{CP} \$(MYEXTLIB) \$\@\n") if $self->{MYEXTLIB};
+
+    push @m,
+q{	lib -nologo -out:$@ $(OBJECT)
+	}.$self->{NOECHO}.q{echo "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)/extralibs.ld
+	$(CHMOD) 755 $@
+};
+
+# Old mechanism - still available:
+
+    push @m, "\t$self->{NOECHO}".q{echo "$(EXTRALIBS)" >> $(PERL_SRC)/ext.libs}."\n\n"
+	if $self->{PERL_SRC};
+
+    push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
+    join('', "\n",@m);
+}
+
+
+
+=item dynamic_lib (o)
+
+Defines how to produce the *.so (or equivalent) files.
+
+=cut
+
+sub dynamic_lib {
+    my($self, %attribs) = @_;
+    return '' unless $self->needs_linking(); #might be because of a subdir
+
+    return '' unless $self->has_link_code;
+
+    my($otherldflags) = $attribs{OTHERLDFLAGS} || "";
+    my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
+    my($ldfrom) = '$(LDFROM)';
+    my(@m);
+    push(@m,'
+# This section creates the dynamically loadable $(INST_DYNAMIC)
+# from $(OBJECT) and possibly $(MYEXTLIB).
+OTHERLDFLAGS = '.$otherldflags.'
+INST_DYNAMIC_DEP = '.$inst_dynamic_dep.'
+
+$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
+');
+
+    push(@m,'	$(LD) -out:$@ $(LDDLFLAGS) '.$ldfrom.
+		' $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) -def:$(EXPORT_LIST)');
+    push @m, '
+	$(CHMOD) 755 $@
+';
+
+    push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
+    join('',@m);
+}
+
+sub perl_archive
+{
+ return '$(PERL_INC)\perl$(LIB_EXT)';
+}
+
+sub export_list
+{
+ my ($self) = @_;
+ return "$self->{BASEEXT}.def";
+}
+
+=item canonpath
+
+No physical check on the filesystem, but a logical cleanup of a
+path. On UNIX eliminated successive slashes and successive "/.".
+
+=cut
+
+sub canonpath {
+    my($self,$path) = @_;
+    $path =~ s/^([a-z]:)/\u$1/;
+    $path =~ s|/|\\|g;
+    $path =~ s|\\+|\\|g ;                          # xx////xx  -> xx/xx
+    $path =~ s|(\\\.)+\\|\\|g ;                    # xx/././xx -> xx/xx
+    $path =~ s|^(\.\\)+|| unless $path eq ".\\";   # ./xx      -> xx
+    $path =~ s|\\$|| 
+             unless $path =~ m#^([a-z]:)?\\#;      # xx/       -> xx
+    $path .= '.' if $path =~ m#\\$#;
+    $path;
+}
+
+=item perl_script
+
+Takes one argument, a file name, and returns the file name, if the
+argument is likely to be a perl script. On MM_Unix this is true for
+any ordinary, readable file.
+
+=cut
+
+sub perl_script {
+    my($self,$file) = @_;
+    return "$file.pl" if -r "$file.pl" && -f _;
+    return;
+}
+
+=item pm_to_blib
+
+Defines target that copies all files in the hash PM to their
+destination and autosplits them. See L<ExtUtils::Install/DESCRIPTION>
+
+=cut
+
+sub pm_to_blib {
+    my $self = shift;
+    my($autodir) = $self->catdir('$(INST_LIB)','auto');
+    return q{
+pm_to_blib: $(TO_INST_PM)
+	}.$self->{NOECHO}.q{$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" \
+	"-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Install \
+        -e "pm_to_blib(qw{ <<pmfiles.dat },'}.$autodir.q{')"
+	}.q{
+$(PM_TO_BLIB)
+<<
+	}.$self->{NOECHO}.q{$(TOUCH) $@
+};
+}
+
+=item test_via_harness (o)
+
+Helper method to write the test targets
+
+=cut
+
+sub test_via_harness {
+    my($self, $perl, $tests) = @_;
+    "\t$perl".q! -Mblib -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e "use Test::Harness qw(&runtests $$verbose); $$verbose=$(TEST_VERBOSE); runtests @ARGV;" !."$tests\n";
+}
+
+=item tool_autosplit (override)
+
+Use Win32 quoting on command line.
+
+=cut
+
+sub tool_autosplit{
+    my($self, %attribs) = @_;
+    my($asl) = "";
+    $asl = "\$AutoSplit::Maxlen=$attribs{MAXLEN};" if $attribs{MAXLEN};
+    q{
+# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto
+AUTOSPLITFILE = $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MAutoSplit }.$asl.q{ -e "autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1);"
+};
+}
+
+=item tools_other (o)
+
+Win32 overrides.
+
+Defines SHELL, LD, TOUCH, CP, MV, RM_F, RM_RF, CHMOD, UMASK_NULL in
+the Makefile. Also defines the perl programs MKPATH,
+WARN_IF_OLD_PACKLIST, MOD_INSTALL. DOC_INSTALL, and UNINSTALL.
+
+=cut
+
+sub tools_other {
+    my($self) = shift;
+    my @m;
+    my $bin_sh = $Config{sh} || 'cmd /c';
+    push @m, qq{
+SHELL = $bin_sh
+};
+
+    for (qw/ CHMOD CP LD MV NOOP RM_F RM_RF TEST_F TOUCH UMASK_NULL DEV_NULL/ ) {
+	push @m, "$_ = $self->{$_}\n";
+    }
+
+    push @m, q{
+# The following is a portable way to say mkdir -p
+# To see which directories are created, change the if 0 to if 1
+MKPATH = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e mkpath
+
+# This helps us to minimize the effect of the .exists files A yet
+# better solution would be to have a stable file in the perl
+# distribution with a timestamp of zero. But this solution doesn't
+# need any changes to the core distribution and works with older perls
+EQUALIZE_TIMESTAMP = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e eqtime
+};
+
+
+    return join "", @m if $self->{PARENT};
+
+    push @m, q{
+# Here we warn users that an old packlist file was found somewhere,
+# and that they should call some uninstall routine
+WARN_IF_OLD_PACKLIST = $(PERL) -lwe "exit unless -f $$ARGV[0];" \\
+-e "print 'WARNING: I have found an old package in';" \\
+-e "print '	', $$ARGV[0], '.';" \\
+-e "print 'Please make sure the two installations are not conflicting';"
+
+UNINST=0
+VERBINST=1
+
+MOD_INSTALL = $(PERL) -I$(INST_LIB) -I$(PERL_LIB) -MExtUtils::Install \
+-e "install({@ARGV},'$(VERBINST)',0,'$(UNINST)');"
+
+DOC_INSTALL = $(PERL) -e "$$\=\"\n\n\";" \
+-e "print '=head2 ', scalar(localtime), ': C<', shift, '>', ' L<', shift, '>';" \
+-e "print '=over 4';" \
+-e "while (defined($$key = shift) and defined($$val = shift)){print '=item *';print 'C<', \"$$key: $$val\", '>';}" \
+-e "print '=back';"
+
+UNINSTALL =   $(PERL) -MExtUtils::Install \
+-e "uninstall($$ARGV[0],1,1); print \"\nUninstall is deprecated. Please check the";" \
+-e "print \" packlist above carefully.\n  There may be errors. Remove the\";" \
+-e "print \" appropriate files manually.\n  Sorry for the inconveniences.\n\""
+};
+
+    return join "", @m;
+}
+
+=item manifypods (o)
+
+We don't want manpage process.  XXX add pod2html support later.
+
+=cut
+
+sub manifypods {
+    return "\nmanifypods :\n\t$self->{NOECHO}\$(NOOP)\n";
+}
+
+=item dist_ci (o)
+
+Same as MM_Unix version (changes command-line quoting).
+
+=cut
+
+sub dist_ci {
+    my($self) = shift;
+    my @m;
+    push @m, q{
+ci :
+	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=maniread \\
+		-e "@all = keys %{ maniread() };" \\
+		-e "print(\"Executing $(CI) @all\n\"); system(\"$(CI) @all\");" \\
+		-e "print(\"Executing $(RCS_LABEL) ...\n\"); system(\"$(RCS_LABEL) @all\");"
+};
+    join "", @m;
+}
+
+=item dist_core (o)
+
+Same as MM_Unix version (changes command-line quoting).
+
+=cut
+
+sub dist_core {
+    my($self) = shift;
+    my @m;
+    push @m, q{
+dist : $(DIST_DEFAULT)
+	}.$self->{NOECHO}.q{$(PERL) -le "print \"Warning: Makefile possibly out of date with $$vf\" if " \
+	    -e "-e ($$vf=\"$(VERSION_FROM)\") and -M $$vf < -M \"}.$self->{MAKEFILE}.q{\";"
+
+tardist : $(DISTVNAME).tar$(SUFFIX)
+
+zipdist : $(DISTVNAME).zip
+
+$(DISTVNAME).tar$(SUFFIX) : distdir
+	$(PREOP)
+	$(TO_UNIX)
+	$(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME)
+	$(RM_RF) $(DISTVNAME)
+	$(COMPRESS) $(DISTVNAME).tar
+	$(POSTOP)
+
+$(DISTVNAME).zip : distdir
+	$(PREOP)
+	$(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME)
+	$(RM_RF) $(DISTVNAME)
+	$(POSTOP)
+
+uutardist : $(DISTVNAME).tar$(SUFFIX)
+	uuencode $(DISTVNAME).tar$(SUFFIX) \\
+		$(DISTVNAME).tar$(SUFFIX) > \\
+		$(DISTVNAME).tar$(SUFFIX)_uu
+
+shdist : distdir
+	$(PREOP)
+	$(SHAR) $(DISTVNAME) > $(DISTVNAME).shar
+	$(RM_RF) $(DISTVNAME)
+	$(POSTOP)
+};
+    join "", @m;
+}
+
+=item pasthru (o)
+
+Defines the string that is passed to recursive make calls in
+subdirectories.
+
+=cut
+
+sub pasthru {
+    my($self) = shift;
+    return "PASTHRU = /nologo"
+}
+
+
+
+1;
+__END__
+
+=back
+
+=cut 
+
diff --git a/lib/ExtUtils/MakeMaker.pm b/lib/ExtUtils/MakeMaker.pm
index 827cb72fae..b03ccee7be 100644
--- a/lib/ExtUtils/MakeMaker.pm
+++ b/lib/ExtUtils/MakeMaker.pm
@@ -2,10 +2,10 @@ BEGIN {require 5.002;} # MakeMaker 5.17 was the last MakeMaker that was compatib
 
 package ExtUtils::MakeMaker;
 
-$Version = $VERSION = "5.34";
+$Version = $VERSION = "5.4002";
 $Version_OK = "5.17";	# Makefiles older than $Version_OK will die
 			# (Will be checked from MakeMaker version 4.13 onwards)
-($Revision = substr(q$Revision: 1.202 $, 10)) =~ s/\s+$//;
+($Revision = substr(q$Revision: 1.211 $, 10)) =~ s/\s+$//;
 
 
 
@@ -25,8 +25,9 @@ use vars qw(
 	   );
 # use strict;
 
-eval {require DynaLoader;};	# Get mod2fname, if defined. Will fail
-                                # with miniperl.
+# &DynaLoader::mod2fname should be available to miniperl, thus 
+# should be a pseudo-builtin (cmp. os2.c).
+#eval {require DynaLoader;};
 
 #
 # Set up the inheritance before we pull in the MM_* packages, because they
@@ -65,11 +66,12 @@ package ExtUtils::Liblist;
 
 package ExtUtils::MakeMaker;
 #
-# Now we can can pull in the friends
+# Now we can pull in the friends
 #
-$Is_VMS = $^O eq 'VMS';
-$Is_OS2 = $^O =~ m|^os/?2$|i;
-$Is_Mac = $^O eq 'MacOS';
+$Is_VMS   = $^O eq 'VMS';
+$Is_OS2   = $^O eq 'os2';
+$Is_Mac   = $^O eq 'MacOS';
+$Is_Win32 = $^O eq 'MSWin32';
 
 require ExtUtils::MM_Unix;
 
@@ -83,6 +85,9 @@ if ($Is_OS2) {
 if ($Is_Mac) {
     require ExtUtils::MM_Mac;
 }
+if ($Is_Win32) {
+    require ExtUtils::MM_Win32;
+}
 
 # The SelfLoader would bring a lot of overhead for MakeMaker, because
 # we know for sure we will use most of the autoloaded functions once
@@ -149,10 +154,12 @@ sub ExtUtils::MakeMaker::mksymlists ;
 sub ExtUtils::MakeMaker::neatvalue ;
 sub ExtUtils::MakeMaker::selfdocument ;
 sub ExtUtils::MakeMaker::WriteMakefile ;
-sub ExtUtils::MakeMaker::prompt ;
+sub ExtUtils::MakeMaker::prompt ($;$) ;
 
 1;
-#__DATA__
+
+__DATA__
+
 package ExtUtils::MakeMaker;
 
 sub WriteMakefile {
@@ -228,12 +235,12 @@ sub full_setup {
 
     @Attrib_help = qw/
 
-    C CONFIG CONFIGURE DEFINE DIR DISTNAME DL_FUNCS DL_VARS EXE_FILES
-    EXCLUDE_EXT INCLUDE_EXT NO_VC FIRST_MAKEFILE FULLPERL H INC
-    INSTALLARCHLIB INSTALLBIN INSTALLDIRS INSTALLMAN1DIR
+    C CCFLAGS CONFIG CONFIGURE DEFINE DIR DISTNAME DL_FUNCS DL_VARS
+    EXE_FILES EXCLUDE_EXT INCLUDE_EXT NO_VC FIRST_MAKEFILE FULLPERL H
+    INC INSTALLARCHLIB INSTALLBIN INSTALLDIRS INSTALLMAN1DIR
     INSTALLMAN3DIR INSTALLPRIVLIB INSTALLSCRIPT INSTALLSITEARCH
     INSTALLSITELIB INST_ARCHLIB INST_BIN INST_EXE INST_LIB
-    INST_MAN1DIR INST_MAN3DIR INST_SCRIPT LDFROM LIBPERL_A LIBS
+    INST_MAN1DIR INST_MAN3DIR INST_SCRIPT LDFROM LIBPERL_A LIB LIBS
     LINKTYPE MAKEAPERL MAKEFILE MAN1PODS MAN3PODS MAP_TARGET MYEXTLIB
     NAME NEEDS_LINKING NOECHO NORECURS OBJECT OPTIMIZE PERL PERLMAINCC
     PERL_ARCHLIB PERL_LIB PERL_SRC PL_FILES PM PMLIBDIRS PREFIX
@@ -241,10 +248,13 @@ sub full_setup {
     XS_VERSION clean depend dist dynamic_lib linkext macro realclean
     tool_autosplit
 
-    installpm
+    IMPORTS
 
+    installpm
 	/;
 
+    # IMPORTS is used under OS/2
+
     # ^^^ installpm is deprecated, will go about Summer 96
 
     # @Overridable is close to @MM_Sections but not identical.  The
@@ -297,7 +307,7 @@ sub full_setup {
     @Get_from_Config = 
 	qw(
 	   ar cc cccdlflags ccdlflags dlext dlsrc ld lddlflags ldflags libc
-	   lib_ext obj_ext ranlib sitelibexp sitearchexp so
+	   lib_ext obj_ext ranlib sitelibexp sitearchexp so exe_ext
 	  );
 
     my $item;
@@ -405,20 +415,17 @@ sub ExtUtils::MakeMaker::new {
 
     # This is for old Makefiles written pre 5.00, will go away
     if ( Carp::longmess("") =~ /runsubdirpl/s ){
-	#$self->{Correct_relativ_directories}++;
 	Carp::carp("WARNING: Please rerun 'perl Makefile.PL' to regenerate your Makefiles\n");
-    } else {
-	$self->{Correct_relativ_directories}=0;
     }
 
-    my $class = ++$PACKNAME;
+    my $newclass = ++$PACKNAME;
     {
 #	no strict;
-	print "Blessing Object into class [$class]\n" if $Verbose>=2;
-	mv_all_methods("MY",$class);
-	bless $self, $class;
+	print "Blessing Object into class [$newclass]\n" if $Verbose>=2;
+	mv_all_methods("MY",$newclass);
+	bless $self, $newclass;
 	push @Parent, $self;
-	@{"$class\:\:ISA"} = 'MM';
+	@{"$newclass\:\:ISA"} = 'MM';
     }
 
     if (defined $Parent[-2]){
@@ -427,10 +434,14 @@ sub ExtUtils::MakeMaker::new {
 	for $key (keys %Prepend_dot_dot) {
 	    next unless defined $self->{PARENT}{$key};
 	    $self->{$key} = $self->{PARENT}{$key};
+		# PERL and FULLPERL may be command verbs instead of full
+		# file specifications under VMS.  If so, don't turn them
+		# into a filespec.
 	    $self->{$key} = $self->catdir("..",$self->{$key})
-		unless $self->file_name_is_absolute($self->{$key});
+		unless $self->file_name_is_absolute($self->{$key})
+		|| ($^O eq 'VMS' and ($key =~ /PERL$/ && $self->{$key} =~ /^[\w\-\$]+$/));
 	}
-	$self->{PARENT}->{CHILDREN}->{$class} = $self if $self->{PARENT};
+	$self->{PARENT}->{CHILDREN}->{$newclass} = $self if $self->{PARENT};
     } else {
 	parse_args($self,@ARGV);
     }
@@ -442,9 +453,10 @@ sub ExtUtils::MakeMaker::new {
     $self->init_main();
 
     if (! $self->{PERL_SRC} ) {
-	my($pthinks) = $INC{'Config.pm'};
+	my($pthinks) = $self->canonpath($INC{'Config.pm'});
 	$pthinks = VMS::Filespec::vmsify($pthinks) if $Is_VMS;
 	if ($pthinks ne $self->catfile($Config{archlibexp},'Config.pm')){
+            print "Have $pthinks expected ",$self->catfile($Config{archlibexp},'Config.pm'),"\n";
 	    $pthinks =~ s!/Config\.pm$!!;
 	    $pthinks =~ s!.*/!!;
 	    print STDOUT <<END;
@@ -550,15 +562,8 @@ sub parse_args{
 		 (getpwuid($>))[7]
 		 ]ex;
 	}
-	# This may go away, in mid 1996
-	if ($self->{Correct_relativ_directories}){
-	    $value = $self->catdir("..",$value)
-		if $Prepend_dot_dot{$name} && ! $self->file_name_is_absolute($value);
-	}
 	$self->{uc($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'
     if (defined $self->{potential_libs}){
@@ -855,18 +860,26 @@ Makefiles with a single invocation of WriteMakefile().
 
 =head2 How To Write A Makefile.PL
 
-The short answer is: Don't. Run h2xs(1) before you start thinking
-about writing a module. For so called pm-only modules that consist of
-C<*.pm> files only, h2xs has the very useful C<-X> switch. This will
-generate dummy files of all kinds that are useful for the module
-developer.
+The short answer is: Don't.
+
+        Always begin with h2xs.
+        Always begin with h2xs!
+        ALWAYS BEGIN WITH H2XS!
+
+even if you're not building around a header file, and even if you
+don't have an XS component.
+
+Run h2xs(1) before you start thinking about writing a module. For so
+called pm-only modules that consist of C<*.pm> files only, h2xs has
+the C<-X> switch. This will generate dummy files of all kinds that are
+useful for the module developer.
 
 The medium answer is:
 
     use ExtUtils::MakeMaker;
     WriteMakefile( NAME => "Foo::Bar" );
 
-The long answer is below.
+The long answer is the rest of the manpage :-)
 
 =head2 Default Makefile Behaviour
 
@@ -892,7 +905,7 @@ Other interesting targets in the generated Makefile are
 
 =head2 make test
 
-MakeMaker checks for the existence of a file named "test.pl" in the
+MakeMaker checks for the existence of a file named F<test.pl> in the
 current directory and if it exists it adds commands to the test target
 of the generated Makefile that will execute the script with the proper
 set of perl C<-I> options.
@@ -902,6 +915,22 @@ add commands to the test target of the generated Makefile that execute
 all matching files via the L<Test::Harness> module with the C<-I>
 switches set correctly.
 
+=head2 make testdb
+
+A useful variation of the above is the target C<testdb>. It runs the
+test under the Perl debugger (see L<perldebug>). If the file
+F<test.pl> exists in the current directory, it is used for the test.
+
+If you want to debug some other testfile, set C<TEST_FILE> variable
+thusly:
+
+  make testdb TEST_FILE=t/mytest.t
+
+By default the debugger is called using C<-d> option to perl. If you
+want to specify some other option, set C<TESTDB_SW> variable:
+
+  make testdb TESTDB_SW=-Dx
+
 =head2 make install
 
 make alone puts all relevant files into directories that are named by
@@ -909,7 +938,7 @@ the macros INST_LIB, INST_ARCHLIB, INST_SCRIPT, INST_MAN1DIR, and
 INST_MAN3DIR. All these default to 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_SCRIPT is not defined.
+ ../../lib, and INST_SCRIPT is not defined.
 
 The I<install> target of the generated Makefile copies the files found
 below each of the INST_* directories to their INSTALL*
@@ -931,9 +960,7 @@ The INSTALL... macros in turn default to their %Config
 
 You can check the values of these variables on your system with
 
-    perl -MConfig -le 'print join $/, map 
-        sprintf("%20s: %s", $_, $Config{$_}),
-        grep /^install/, keys %Config'
+    perl '-V:install.*'
 
 And to check the sequence in which the library directories are
 searched by perl, run
@@ -941,18 +968,29 @@ searched by perl, run
     perl -le 'print join $/, @INC'
 
 
-=head2 PREFIX attribute
+=head2 PREFIX and LIB attribute
 
-The PREFIX attribute can be used to set the INSTALL* attributes in one
-go. The quickest way to install a module in a non-standard place
+PREFIX and LIB can be used to set several INSTALL* attributes in one
+go. The quickest way to install a module in a non-standard place might
+be
+
+    perl Makefile.PL LIB=~/lib
+
+This will install the module's architecture-independent files into
+~/lib, the architecture-dependent files into ~/lib/$archname/auto.
+
+Another way to specify many INSTALL directories with a single
+parameter is PREFIX.
 
     perl Makefile.PL PREFIX=~
 
 This will replace the string specified by $Config{prefix} in all
 $Config{install*} values.
 
-Note, that the tilde expansion is done by MakeMaker, not by perl by
-default, nor by make.
+Note, that in both cases the tilde expansion is done by MakeMaker, not
+by perl by default, nor by make. Conflicts between parmeters LIB,
+PREFIX and the various INSTALL* arguments are resolved so that 
+XXX
 
 If the user has superuser privileges, and is not working on AFS
 (Andrew File System) or relatives, then the defaults for
@@ -1137,7 +1175,7 @@ so
 =item CONFIGURE
 
 CODE reference. The subroutine should return a hash reference. The
-hash may contain further attributes, e.g. {LIBS => ...}, that have to
+hash may contain further attributes, e.g. {LIBS =E<gt> ...}, that have to
 be determined by some evaluation method.
 
 =item DEFINE
@@ -1323,6 +1361,11 @@ specify ld flags)
 The filename of the perllibrary that will be used together with this
 extension. Defaults to libperl.a.
 
+=item LIB
+
+LIB can only be set at C<perl Makefile.PL> time. It has the effect of
+setting both INSTALLPRIVLIB and INSTALLSITELIB to that value regardless any
+
 =item LIBS
 
 An anonymous array of alternative library
@@ -1515,14 +1558,14 @@ routine requires that the file named by VERSION_FROM contains one
 single line to compute the version number. The first line in the file
 that contains the regular expression
 
-    /(\$[\w:]*\bVERSION)\b.*=/
+    /\$(([\w\:\']*)\bVERSION)\b.*\=/
 
 will be evaluated with eval() and the value of the named variable
 B<after> the eval() will be assigned to the VERSION attribute of the
 MakeMaker object. The following lines will be parsed o.k.:
 
     $VERSION = '1.00';
-    ( $VERSION ) = '$Revision: 1.201 $ ' =~ /\$Revision:\s+([^\s]+)/;
+    ( $VERSION ) = '$Revision: 1.211 $ ' =~ /\$Revision:\s+([^\s]+)/;
     $FOO::VERSION = '1.10';
 
 but these will fail:
@@ -1644,7 +1687,8 @@ either say:
 or you can edit the default by saying something like:
 
 	sub MY::c_o {
-            my($inherited) = shift->SUPER::c_o(@_);
+	    package MY;	# so that "SUPER" works right
+	    my $inherited = shift->SUPER::c_o(@_);
 	    $inherited =~ s/old text/new text/;
 	    $inherited;
 	}
@@ -1797,11 +1841,10 @@ ExtUtils::Install, ExtUtils::embed
 
 =head1 AUTHORS
 
-Andy Dougherty F<E<lt>doughera@lafcol.lafayette.eduE<gt>>, Andreas
-KE<ouml>nig F<E<lt>A.Koenig@franz.ww.TU-Berlin.DEE<gt>>, Tim Bunce
-F<E<lt>Tim.Bunce@ig.co.ukE<gt>>.  VMS support by Charles Bailey
-F<E<lt>bailey@genetics.upenn.eduE<gt>>. OS/2 support by Ilya
-Zakharevich F<E<lt>ilya@math.ohio-state.eduE<gt>>. Contact the
+Andy Dougherty <F<doughera@lafcol.lafayette.edu>>, Andreas KE<ouml>nig
+<F<A.Koenig@franz.ww.TU-Berlin.DE>>, Tim Bunce <F<Tim.Bunce@ig.co.uk>>.
+VMS support by Charles Bailey <F<bailey@genetics.upenn.edu>>.  OS/2
+support by Ilya Zakharevich <F<ilya@math.ohio-state.edu>>.  Contact the
 makemaker mailing list C<mailto:makemaker@franz.ww.tu-berlin.de>, if
 you have any questions.
 
diff --git a/lib/ExtUtils/Manifest.pm b/lib/ExtUtils/Manifest.pm
index 14d0f6e1be..0959a2fd73 100644
--- a/lib/ExtUtils/Manifest.pm
+++ b/lib/ExtUtils/Manifest.pm
@@ -1,24 +1,26 @@
 package ExtUtils::Manifest;
 
-
 require Exporter;
-@ISA=('Exporter');
-@EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck', 
-	      'skipcheck', 'maniread', 'manicopy');
-
 use Config;
 use File::Find;
 use File::Copy 'copy';
 use Carp;
+use strict;
 
-$Debug = 0;
-$Verbose = 1;
-$Is_VMS = $^O eq 'VMS';
+use vars qw($VERSION @ISA @EXPORT_OK
+	    $Is_VMS $Debug $Verbose $Quiet $MANIFEST $found);
 
-$VERSION = $VERSION = substr(q$Revision: 1.24 $,10,4);
+$VERSION = substr(q$Revision: 1.33 $, 10);
+@ISA=('Exporter');
+@EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck', 
+	      'skipcheck', 'maniread', 'manicopy');
 
-$Quiet = 0;
+$Is_VMS = $^O eq 'VMS';
+if ($Is_VMS) { require File::Basename }
 
+$Debug = 0;
+$Verbose = 1;
+$Quiet = 0;
 $MANIFEST = 'MANIFEST';
 
 # Really cool fix from Ilya :)
@@ -83,10 +85,10 @@ sub skipcheck {
 sub _manicheck {
     my($arg) = @_;
     my $read = maniread();
+    my $found = manifind();
     my $file;
     my(@missfile,@missentry);
     if ($arg & 1){
-	my $found = manifind();
 	foreach $file (sort keys %$read){
 	    warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug;
 	    unless ( exists $found->{$file} ) {
@@ -98,7 +100,6 @@ sub _manicheck {
     if ($arg & 2){
 	$read ||= {};
 	my $matches = _maniskip();
-	my $found = manifind();
 	my $skipwarn = $arg & 4;
 	foreach $file (sort keys %$found){
 	    if (&$matches($file)){
@@ -117,7 +118,7 @@ sub _manicheck {
 
 sub maniread {
     my ($mfile) = @_;
-    $mfile = $MANIFEST unless defined $mfile;
+    $mfile ||= $MANIFEST;
     my $read = {};
     local *M;
     unless (open M, $mfile){
@@ -126,8 +127,20 @@ sub maniread {
     }
     while (<M>){
 	chomp;
-	if ($Is_VMS) { /^(\S+)/ and $read->{"\L$1"}=$_; }
-	else         { /^(\S+)\s*(.*)/ and $read->{$1}=$2; }
+	next if /^#/;
+	if ($Is_VMS) {
+	    my($file)= /^(\S+)/;
+	    next unless $file;
+	    my($base,$dir) = File::Basename::fileparse($file);
+	    # Resolve illegal file specifications in the same way as tar
+	    $dir =~ tr/./_/;
+	    my(@pieces) = split(/\./,$base);
+	    if (@pieces > 2) { $base = shift(@pieces) . '.' . join('_',@pieces); }
+	    my $okfile = "$dir$base";
+	    warn "Debug: Illegal name $file changed to $okfile\n" if $Debug;
+	    $read->{"\L$okfile"}=$_;
+	}
+	else { /^(\S+)\s*(.*)/ and $read->{$1}=$2; }
     }
     close M;
     $read;
@@ -138,12 +151,13 @@ sub _maniskip {
     my ($mfile) = @_;
     my $matches = sub {0};
     my @skip ;
-    $mfile = "$MANIFEST.SKIP" unless defined $mfile;
+    $mfile ||= "$MANIFEST.SKIP";
     local *M;
     return $matches unless -f $mfile;
     open M, $mfile or return $matches;
     while (<M>){
 	chomp;
+	next if /^#/;
 	next if /^\s*$/;
 	push @skip, $_;
     }
@@ -161,7 +175,7 @@ sub _maniskip {
 sub manicopy {
     my($read,$target,$how)=@_;
     croak "manicopy() called without target argument" unless defined $target;
-    $how = 'cp' unless defined $how && $how;
+    $how ||= 'cp';
     require File::Path;
     require File::Basename;
     my(%dirs,$file);
@@ -175,14 +189,13 @@ sub manicopy {
 	    $dir = VMS::Filespec::unixify($dir) if $Is_VMS;
 	    File::Path::mkpath(["$target/$dir"],1,$Is_VMS ? undef : 0755);
 	}
-	if ($Is_VMS) { vms_cp_if_diff($file,"$target/$file"); }
-	else         { cp_if_diff($file, "$target/$file", $how); }
+	cp_if_diff($file, "$target/$file", $how);
     }
 }
 
 sub cp_if_diff {
-    my($from,$to, $how)=@_;
-    -f $from || carp "$0: $from not found";
+    my($from, $to, $how)=@_;
+    -f $from or carp "$0: $from not found";
     my($diff) = 0;
     local(*F,*T);
     open(F,$from) or croak "Can't read $from: $!\n";
@@ -197,26 +210,14 @@ sub cp_if_diff {
 	if (-e $to) {
 	    unlink($to) or confess "unlink $to: $!";
 	}
-	&$how($from, $to);
-    }
-}
-
-# Do the comparisons here rather than spawning off another process
-sub vms_cp_if_diff {
-    my($from,$to) = @_;
-    my($diff) = 0;
-    local(*F,*T);
-    open(F,$from) or croak "Can't read $from: $!\n";
-    if (open(T,$to)) {
-	while (<F>) { $diff++,last if $_ ne <T>; }
-	$diff++ unless eof(T);
-	close T;
-    }
-    else { $diff++; }
-    close F;
-    if ($diff) {
-	system('copy',VMS::Filespec::vmsify($from),VMS::Filespec::vmsify($to)) & 1
-	    or confess "Copy failed: $!";
+      STRICT_SWITCH: {
+	    best($from,$to), last STRICT_SWITCH if $how eq 'best';
+	    cp($from,$to), last STRICT_SWITCH if $how eq 'cp';
+	    ln($from,$to), last STRICT_SWITCH if $how eq 'ln';
+	    croak("ExtUtils::Manifest::cp_if_diff " .
+		  "called with illegal how argument [$how]. " .
+		  "Legal values are 'best', 'cp', and 'ln'.");
+	}
     }
 }
 
@@ -224,13 +225,14 @@ sub cp {
     my ($srcFile, $dstFile) = @_;
     my ($perm,$access,$mod) = (stat $srcFile)[2,8,9];
     copy($srcFile,$dstFile);
-    utime $access, $mod, $dstFile;
+    utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile;
     # chmod a+rX-w,go-w
     chmod(  0444 | ( $perm & 0111 ? 0111 : 0 ),  $dstFile );
 }
 
 sub ln {
     my ($srcFile, $dstFile) = @_;
+    return &cp if $Is_VMS;
     link($srcFile, $dstFile);
     local($_) = $dstFile; # chmod a+r,go-w+X (except "X" only applies to u=x)
     my $mode= 0444 | (stat)[2] & 0700;
@@ -242,7 +244,7 @@ sub best {
     if (-l $srcFile) {
 	cp($srcFile, $dstFile);
     } else {
-	ln($srcFile, $dstFile);
+	ln($srcFile, $dstFile) or cp($srcFile, $dstFile);
     }
 }
 
@@ -311,6 +313,8 @@ 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.
+Blank lines and lines which start with C<#> in the C<MANIFEST> file
+are discarded.
 
 I<Manicopy($read,$target,$how)> copies the files that are the keys in
 the HASH I<%$read> to the named target directory. The HASH reference
@@ -326,7 +330,9 @@ make a tree without any symbolic link. Best is the default.
 
 The file MANIFEST.SKIP may contain regular expressions of files that
 should be ignored by mkmanifest() and filecheck(). The regular
-expressions should appear one on each line. A typical example:
+expressions should appear one on each line. Blank lines and lines
+which start with C<#> are skipped.  Use C<\#> if you need a regular
+expression to start with a sharp character. A typical example:
 
     \bRCS\b
     ^MANIFEST\.
@@ -350,7 +356,7 @@ C<MANIFEST.SKIP> file. This is useful if you want to maintain
 different distributions for different audiences (say a user version
 and a developer version including RCS).
 
-<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value,
+C<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value,
 all functions act silently.
 
 =head1 DIAGNOSTICS
@@ -387,6 +393,6 @@ L<ExtUtils::MakeMaker> which has handy targets for most of the functionality.
 
 =head1 AUTHOR
 
-Andreas Koenig F<E<lt>koenig@franz.ww.TU-Berlin.DEE<gt>>
+Andreas Koenig <F<koenig@franz.ww.TU-Berlin.DE>>
 
 =cut
diff --git a/lib/ExtUtils/Mkbootstrap.pm b/lib/ExtUtils/Mkbootstrap.pm
index 06c001553b..35d5236072 100644
--- a/lib/ExtUtils/Mkbootstrap.pm
+++ b/lib/ExtUtils/Mkbootstrap.pm
@@ -1,47 +1,15 @@
 package ExtUtils::Mkbootstrap;
+
+$VERSION = substr q$Revision: 1.13 $, 10;
+# $Date: 1996/09/03 17:04:43 $
+
 use Config;
 use Exporter;
 @ISA=('Exporter');
 @EXPORT='&Mkbootstrap';
-$Version=2.0; # just to start somewhere
 
 sub Mkbootstrap {
-
-=head1 NAME
-
-ExtUtils::Mkbootstrap - make a bootstrap file for use by DynaLoader
-
-=head1 SYNOPSIS
-
-C<mkbootstrap>
-
-=head1 DESCRIPTION
-
-Mkbootstrap typically gets called from an extension Makefile.
-
-There is no C<*.bs> file supplied with the extension. Instead a
-C<*_BS> file which has code for the special cases, like posix for
-berkeley db on the NeXT.
-
-This file will get parsed, and produce a maybe empty
-C<@DynaLoader::dl_resolve_using> array for the current architecture.
-That will be extended by $BSLOADLIBS, which was computed by
-ExtUtils::Liblist::ext(). If this array still is empty, we do nothing,
-else we write a .bs file with an C<@DynaLoader::dl_resolve_using>
-array.
-
-The C<*_BS> file can put some code into the generated C<*.bs> file by
-placing it in C<$bscode>. This is a handy 'escape' mechanism that may
-prove useful in complex situations.
-
-If @DynaLoader::dl_resolve_using contains C<-L*> or C<-l*> entries then
-Mkbootstrap will automatically add a dl_findfile() call to the
-generated C<*.bs> file.
-
-=cut
-
     my($baseext, @bsloadlibs)=@_;
-
     @bsloadlibs = grep($_, @bsloadlibs); # strip empty libs
 
     print STDOUT "	bsloadlibs=@bsloadlibs\n" if $Verbose;
@@ -58,6 +26,8 @@ generated C<*.bs> file.
     if (-f "${baseext}_BS"){
 	$_ = "${baseext}_BS";
 	package DynaLoader; # execute code as if in DynaLoader
+	local($osname, $dlsrc) = (); # avoid warnings
+	($osname, $dlsrc) = @Config::Config{qw(osname dlsrc)};
 	$bscode = "";
 	unshift @INC, ".";
 	require $_;
@@ -95,3 +65,39 @@ generated C<*.bs> file.
     }
 }
 
+1;
+
+__END__
+
+=head1 NAME
+
+ExtUtils::Mkbootstrap - make a bootstrap file for use by DynaLoader
+
+=head1 SYNOPSIS
+
+C<mkbootstrap>
+
+=head1 DESCRIPTION
+
+Mkbootstrap typically gets called from an extension Makefile.
+
+There is no C<*.bs> file supplied with the extension. Instead a
+C<*_BS> file which has code for the special cases, like posix for
+berkeley db on the NeXT.
+
+This file will get parsed, and produce a maybe empty
+C<@DynaLoader::dl_resolve_using> array for the current architecture.
+That will be extended by $BSLOADLIBS, which was computed by
+ExtUtils::Liblist::ext(). If this array still is empty, we do nothing,
+else we write a .bs file with an C<@DynaLoader::dl_resolve_using>
+array.
+
+The C<*_BS> file can put some code into the generated C<*.bs> file by
+placing it in C<$bscode>. This is a handy 'escape' mechanism that may
+prove useful in complex situations.
+
+If @DynaLoader::dl_resolve_using contains C<-L*> or C<-l*> entries then
+Mkbootstrap will automatically add a dl_findfile() call to the
+generated C<*.bs> file.
+
+=cut
diff --git a/lib/ExtUtils/Mksymlists.pm b/lib/ExtUtils/Mksymlists.pm
index 5c0173a508..fd609152c3 100644
--- a/lib/ExtUtils/Mksymlists.pm
+++ b/lib/ExtUtils/Mksymlists.pm
@@ -7,7 +7,7 @@ use Exporter;
 use vars qw( @ISA @EXPORT $VERSION );
 @ISA = 'Exporter';
 @EXPORT = '&Mksymlists';
-$VERSION = '1.03';
+$VERSION = substr q$Revision: 1.13 $, 10;
 
 sub Mksymlists {
     my(%spec) = @_;
@@ -40,6 +40,7 @@ sub Mksymlists {
     }
 
 #    We'll need this if we ever add any OS which uses mod2fname
+#    not as pseudo-builtin.
 #    require DynaLoader;
     if (defined &DynaLoader::mod2fname and not $spec{DLBASE}) {
         $spec{DLBASE} = DynaLoader::mod2fname([ split(/::/,$spec{NAME}) ]);
@@ -47,7 +48,8 @@ sub Mksymlists {
 
     if    ($osname eq 'aix') { _write_aix(\%spec); }
     elsif ($osname eq 'VMS') { _write_vms(\%spec) }
-    elsif ($osname =~ m|^os/?2$|i) { _write_os2(\%spec) }
+    elsif ($osname eq 'os2') { _write_os2(\%spec) }
+    elsif ($osname eq 'MSWin32') { _write_win32(\%spec) }
     else { croak("Don't know how to create linker option file for $osname\n"); }
 }
 
@@ -92,13 +94,42 @@ while (($name, $exp)= each %{$data->{IMPORTS}}) {
     close DEF;
 }
 
+sub _write_win32 {
+    my($data) = @_;
+
+    if (not $data->{DLBASE}) {
+        ($data->{DLBASE} = $data->{NAME}) =~ s/.*:://;
+        $data->{DLBASE} = substr($data->{DLBASE},0,7) . '_';
+    }
+    rename "$data->{FILE}.def", "$data->{FILE}_def.old";
+
+    open(DEF,">$data->{FILE}.def")
+        or croak("Can't create $data->{FILE}.def: $!\n");
+    print DEF "LIBRARY $data->{DLBASE}\n";
+    print DEF "CODE LOADONCALL\n";
+    print DEF "DATA LOADONCALL NONSHARED MULTIPLE\n";
+    print DEF "EXPORTS\n  ";
+    print DEF join("\n  ",@{$data->{DL_VARS}}, "\n") if @{$data->{DL_VARS}};
+    print DEF join("\n  ",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}};
+    if (%{$data->{IMPORTS}}) {
+        print DEF "IMPORTS\n";
+        my ($name, $exp);
+        while (($name, $exp)= each %{$data->{IMPORTS}}) {
+            print DEF "  $name=$exp\n";
+        }
+    }
+    close DEF;
+}
+
 
 sub _write_vms {
     my($data) = @_;
 
     require Config; # a reminder for once we do $^O
+    require ExtUtils::XSSymSet;
 
     my($isvax) = $Config::Config{'arch'} =~ /VAX/i;
+    my($set) = new ExtUtils::XSSymSet;
     my($sym);
 
     rename "$data->{FILE}.opt", "$data->{FILE}.opt_old";
@@ -114,13 +145,15 @@ sub _write_vms {
     # the GSMATCH criteria for a dynamic extension
 
     foreach $sym (@{$data->{FUNCLIST}}) {
-        if ($isvax) { print OPT "UNIVERSAL=$sym\n" }
-        else        { print OPT "SYMBOL_VECTOR=($sym=PROCEDURE)\n"; }
+        my $safe = $set->addsym($sym);
+        if ($isvax) { print OPT "UNIVERSAL=$safe\n" }
+        else        { print OPT "SYMBOL_VECTOR=($safe=PROCEDURE)\n"; }
     }
     foreach $sym (@{$data->{DL_VARS}}) {
+        my $safe = $set->addsym($sym);
         print OPT "PSECT_ATTR=${sym},PIC,OVR,RD,NOEXE,WRT,NOSHR\n";
-        if ($isvax) { print OPT "UNIVERSAL=$sym\n" }
-        else        { print OPT "SYMBOL_VECTOR=($sym=DATA)\n"; }
+        if ($isvax) { print OPT "UNIVERSAL=$safe\n" }
+        else        { print OPT "SYMBOL_VECTOR=($safe=DATA)\n"; }
     }
     close OPT;
 
@@ -152,13 +185,15 @@ ExtUtils::Mksymlists - write linker options files for dynamic extension
 =head1 DESCRIPTION
 
 C<ExtUtils::Mksymlists> produces files used by the linker under some OSs
-during the creation of shared libraries for synamic extensions.  It is
+during the creation of shared libraries for dynamic extensions.  It is
 normally called from a MakeMaker-generated Makefile when the extension
 is built.  The linker option file is generated by calling the function
 C<Mksymlists>, which is exported by default from C<ExtUtils::Mksymlists>.
 It takes one argument, a list of key-value pairs, in which the following
 keys are recognized:
 
+=over
+
 =item NAME
 
 This gives the name of the extension (I<e.g.> Tk::Canvas) for which
@@ -212,6 +247,8 @@ extension itself (for instance, some linkers add an '_' to the
 name of the extension).  If it is not specified, it is derived
 from the NAME attribute.  It is presently used only by OS2.
 
+=back
+
 When calling C<Mksymlists>, one should always specify the NAME
 attribute.  In most cases, this is all that's necessary.  In
 the case of unusual extensions, however, the other attributes
diff --git a/lib/ExtUtils/testlib.pm b/lib/ExtUtils/testlib.pm
index d5596047fb..d80f2a296b 100644
--- a/lib/ExtUtils/testlib.pm
+++ b/lib/ExtUtils/testlib.pm
@@ -1,4 +1,7 @@
 package ExtUtils::testlib;
+$VERSION = substr q$Revision: 1.11 $, 10;
+# $Id: testlib.pm,v 1.11 1996/05/31 08:27:07 k Exp $
+
 use lib qw(blib/arch blib/lib);
 1;
 __END__
diff --git a/lib/ExtUtils/typemap b/lib/ExtUtils/typemap
index a9733d0f49..20cc96f0b5 100644
--- a/lib/ExtUtils/typemap
+++ b/lib/ExtUtils/typemap
@@ -45,6 +45,7 @@ FileHandle		T_PTROBJ
 InputStream		T_IN
 InOutStream		T_INOUT
 OutputStream		T_OUT
+bool			T_BOOL
 
 #############################################################################
 INPUT
@@ -78,6 +79,8 @@ T_INT
 	$var = (int)SvIV($arg)
 T_ENUM
 	$var = ($type)SvIV($arg)
+T_BOOL
+	$var = (int)SvIV($arg)
 T_U_INT
 	$var = (unsigned int)SvIV($arg)
 T_SHORT
@@ -124,7 +127,7 @@ T_REF_IV_PTR
 	else
 	    croak(\"$var is not of type ${ntype}\")
 T_PTROBJ
-	if (sv_isa($arg, \"${ntype}\")) {
+	if (sv_derived_from($arg, \"${ntype}\")) {
 	    IV tmp = SvIV((SV*)SvRV($arg));
 	    $var = ($type) tmp;
 	}
@@ -199,6 +202,8 @@ T_SYSRET
 	}
 T_ENUM
 	sv_setiv($arg, (IV)$var);
+T_BOOL
+	$arg = boolSV($var);
 T_U_INT
 	sv_setiv($arg, (IV)$var);
 T_SHORT
diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp
index 742e6d385d..d7448a166e 100755
--- a/lib/ExtUtils/xsubpp
+++ b/lib/ExtUtils/xsubpp
@@ -71,17 +71,29 @@ See the file F<changes.pod>.
 
 =head1 SEE ALSO
 
-perl(1), perlxs(1), perlxstut(1), perlapi(1)
+perl(1), perlxs(1), perlxstut(1)
 
 =cut
 
-# Global Constants
-$XSUBPP_version = "1.935";
 require 5.002;
+use Cwd;
 use vars '$cplusplus';
 
 sub Q ;
 
+# Global Constants
+
+$XSUBPP_version = "1.9402";
+
+my ($Is_VMS, $SymSet);
+if ($^O eq 'VMS') {
+    $Is_VMS = 1;
+    # Establish set of global symbols with max length 28, since xsubpp
+    # will later add the 'XS_' prefix.
+    require ExtUtils::XSSymSet;
+    $SymSet = new ExtUtils::XSSymSet 28;
+}
+
 $FH = 'File0000' ;
 
 $usage = "Usage: xsubpp [-v] [-C++] [-except] [-prototypes] [-noversioncheck] [-s pattern] [-typemap typemap]... file.xs\n";
@@ -95,7 +107,7 @@ $ProtoUsed = 0 ;
 SWITCH: while (@ARGV and $ARGV[0] =~ /^-./) {
     $flag = shift @ARGV;
     $flag =~ s/^-// ;
-    $spat = shift,	next SWITCH	if $flag eq 's';
+    $spat = quotemeta shift,	next SWITCH	if $flag eq 's';
     $cplusplus = 1,	next SWITCH	if $flag eq 'C++';
     $WantPrototypes = 0, next SWITCH	if $flag eq 'noprototypes';
     $WantPrototypes = 1, next SWITCH	if $flag eq 'prototypes';
@@ -118,16 +130,14 @@ else
 	or ($dir, $filename) = $ARGV[0] =~ m#(.*[>\]])(.*)#
 	or ($dir, $filename) = ('.', $ARGV[0]);
 chdir($dir);
-# Check for VMS; Config.pm may not be installed yet, but this routine
-# is built into VMS perl
-if (defined(&VMS::Filespec::vmsify)) { $Is_VMS = 1; $pwd = $ENV{DEFAULT}; }
-else                                 { $Is_VMS = 0; chomp($pwd = `pwd`);   }
+$pwd = cwd();
 
 ++ $IncludedFiles{$ARGV[0]} ;
 
 my(@XSStack) = ({type => 'none'});	# Stack of conditionals and INCLUDEs
 my($XSS_work_idx, $cpp_next_tmp) = (0, "XSubPPtmpAAAA");
 
+
 sub TrimWhitespace
 {
     $_[0] =~ s/^\s+|\s+$//go ;
@@ -169,6 +179,7 @@ foreach $typemap (@tm) {
     $current = \$junk;
     while (<TYPEMAP>) {
 	next if /^\s*#/;
+        my $line_no = $. + 1; 
 	if (/^INPUT\s*$/)   { $mode = 'Input';   $current = \$junk;  next; }
 	if (/^OUTPUT\s*$/)  { $mode = 'Output';  $current = \$junk;  next; }
 	if (/^TYPEMAP\s*$/) { $mode = 'Typemap'; $current = \$junk;  next; }
@@ -183,7 +194,7 @@ foreach $typemap (@tm) {
             $type = TidyType($type) ;
 	    $type_kind{$type} = $kind ;
             # prototype defaults to '$'
-            $proto = '$' unless $proto ;
+            $proto = "\$" unless $proto ;
             warn("Warning: File '$typemap' Line $. '$line' Invalid prototype '$proto'\n") 
                 unless ValidProtoString($proto) ;
             $proto_letter{$type} = C_string($proto) ;
@@ -215,6 +226,7 @@ $END = "!End!\n\n";		# "impossible" keyword (multiple newline)
 $BLOCK_re= '\s*(' . join('|', qw(
 	REQUIRE BOOT CASE PREINIT INPUT INIT CODE PPCODE OUTPUT 
 	CLEANUP ALIAS PROTOTYPES PROTOTYPE VERSIONCHECK INCLUDE
+	SCOPE
 	)) . "|$END)\\s*:";
 
 # Input:  ($_, @line) == unparsed input.
@@ -227,8 +239,10 @@ sub check_keyword {
 
 
 sub print_section {
+    my $count = 0;
     $_ = shift(@line) while !/\S/ && @line;
     for (;  defined($_) && !/^$BLOCK_re/o;  $_ = shift(@line)) {
+        print line_directive() unless ($count++);
 	print "$_\n";
     }
 }
@@ -240,6 +254,7 @@ sub process_keyword($)
 
     &{"${kwd}_handler"}() 
         while $kwd = check_keyword($pattern) ;
+    print line_directive();
 }
 
 sub CASE_handler {
@@ -316,6 +331,7 @@ sub OUTPUT_handler {
 	    unless defined($args_match{$outarg});
 	blurt("Error: No input definition for OUTPUT argument '$outarg' - ignored"), next
 	    unless defined $var_types{$outarg} ;
+	print line_directive();
 	if ($outcode) {
 	    print "\t$outcode\n";
 	} else {
@@ -440,6 +456,24 @@ sub PROTOTYPE_handler ()
 
 }
 
+sub SCOPE_handler ()
+{
+    death("Error: Only 1 SCOPE declaration allowed per xsub") 
+        if $scope_in_this_xsub ++ ;
+
+    for (;  !/^$BLOCK_re/o;  $_ = shift(@line)) {
+		next unless /\S/;
+		TrimWhitespace($_) ;
+        if ($_ =~ /^DISABLE/i) {
+		   $ScopeThisXSUB = 0 
+        }
+        elsif ($_ =~ /^ENABLE/i) {
+		   $ScopeThisXSUB = 1 
+        }
+    }
+
+}
+
 sub PROTOTYPES_handler ()
 {
     # the rest of the current line should contain either ENABLE or
@@ -570,7 +604,7 @@ sub ProtoString ($)
 {
     my ($type) = @_ ;
 
-    $proto_letter{$type} or '$' ;
+    $proto_letter{$type} or "\$" ;
 }
 
 sub check_cpp {
@@ -608,14 +642,14 @@ open($FH, $filename) or die "cannot open $filename: $!\n";
 print <<EOM ;
 /*
  * This file was generated automatically by xsubpp version $XSUBPP_version from the 
- * contents of $filename. Don't edit this file, edit $filename instead.
+ * contents of $filename. Do not edit this file, edit $filename instead.
  *
  *	ANY CHANGES MADE HERE WILL BE LOST! 
  *
  */
 
 EOM
- 
+print "#line 1 \"$filename\"\n"; 
 
 while (<$FH>) {
     last if ($Module, $Package, $Prefix) =
@@ -627,7 +661,6 @@ while (<$FH>) {
 $lastline    = $_;
 $lastline_no = $.;
 
-
 # Read next xsub into @line from ($lastline, <$FH>).
 sub fetch_para {
     # parse paragraph
@@ -642,6 +675,7 @@ sub fetch_para {
 	$Module = $1;
 	$Package = defined($2) ? $2 : '';	# keep -w happy
 	$Prefix  = defined($3) ? $3 : '';	# keep -w happy
+	$Prefix = quotemeta $Prefix ;
 	($Module_cname = $Module) =~ s/\W/_/g;
 	($Packid = $Package) =~ tr/:/_/;
 	$Packprefix = $Package;
@@ -722,7 +756,9 @@ while (fetch_para()) {
 	$XSStack[$XSS_work_idx]{varname} = $cpp_next_tmp++;
     }
 
-    death ("Code is not inside a function")
+    death ("Code is not inside a function"
+	   ." (maybe last function was ended by a blank line "
+	   ." followed by a a statement on column one?)")
 	if $line[0] =~ /^\s/;
 
     # initialize info arrays
@@ -737,7 +773,9 @@ while (fetch_para()) {
     undef(%arg_list) ;
     undef(@proto_arg) ;
     undef($proto_in_this_xsub) ;
+    undef($scope_in_this_xsub) ;
     $ProtoThisXSUB = $WantPrototypes ;
+    $ScopeThisXSUB = 0;
 
     $_ = shift(@line);
     while ($kwd = check_keyword("REQUIRE|PROTOTYPES|VERSIONCHECK|INCLUDE")) {
@@ -748,7 +786,7 @@ while (fetch_para()) {
 
     if (check_keyword("BOOT")) {
 	&check_cpp;
-        push (@BootCode, $_, @line, "") ;
+        push (@BootCode, $_, line_directive(), @line, "") ;
         next PARAGRAPH ;
     }
 
@@ -767,14 +805,15 @@ while (fetch_para()) {
 	unless $func_header =~ /^(?:([\w:]*)::)?(\w+)\s*\(\s*(.*?)\s*\)\s*$/s;
 
     ($class, $func_name, $orig_args) =  ($1, $2, $3) ;
-    ($fname = $func_name) =~ s/^($Prefix)?//;
-    $pname = $Packprefix . $fname;
-    $Full_func_name = "${Packid}_$fname";
+    ($pname = $func_name) =~ s/^($Prefix)?/$Packprefix/;
+    ($clean_func_name = $func_name) =~ s/^$Prefix//;
+    $Full_func_name = "${Packid}_$clean_func_name";
+    if ($Is_VMS) { $Full_func_name = $SymSet->addsym($Full_func_name); }
 
     # Check for duplicate function definition
     for $tmp (@XSStack) {
 	next unless defined $tmp->{functions}{$Full_func_name};
-	Warn("Warning: duplicate function definition '$func_name' detected");
+	Warn("Warning: duplicate function definition '$clean_func_name' detected");
 	last;
     }
     $XSStack[$XSS_work_idx]{functions}{$Full_func_name} ++ ;
@@ -782,7 +821,8 @@ while (fetch_para()) {
 
     @args = split(/\s*,\s*/, $orig_args);
     if (defined($class)) {
-	my $arg0 = ((defined($static) or $func_name =~ /^new/) ? "CLASS" : "THIS");
+	my $arg0 = ((defined($static) or $func_name eq 'new')
+		    ? "CLASS" : "THIS");
 	unshift(@args, $arg0);
 	($orig_args = "$arg0, $orig_args") =~ s/^$arg0, $/$arg0/;
     }
@@ -803,7 +843,7 @@ while (fetch_para()) {
 		    $defaults{$args[$i]} = $2;
 		    $defaults{$args[$i]} =~ s/"/\\"/g;
 	    }
-	    $proto_arg[$i+1] = '$' ;
+	    $proto_arg[$i+1] = "\$" ;
     }
     if (defined($class)) {
 	    $func_args = join(", ", @args[1..$#args]);
@@ -813,11 +853,16 @@ while (fetch_para()) {
     @args_match{@args} = 1..@args;
 
     $PPCODE = grep(/^\s*PPCODE\s*:/, @line);
+    $CODE = grep(/^\s*CODE\s*:/, @line);
+    # Detect CODE: blocks which use ST(n)= or XST_m*(n,v)
+    #   to set explicit return values.
+    $EXPLICIT_RETURN = ($CODE &&
+		("@line" =~ /(\bST\s*\([^;]*=) | (\bXST_m\w+\s*\()/x ));
     $ALIAS  = grep(/^\s*ALIAS\s*:/,  @line);
 
     # print function header
     print Q<<"EOF";
-#XS(XS_$Full_func_name)
+#XS(XS_${Full_func_name})
 #[[
 #    dXSARGS;
 EOF
@@ -876,10 +921,15 @@ EOF
         $gotRETVAL = 0;
 
 	INPUT_handler() ;
-	process_keyword("INPUT|PREINIT|ALIAS|PROTOTYPE") ;
+	process_keyword("INPUT|PREINIT|ALIAS|PROTOTYPE|SCOPE") ;
 
+	print Q<<"EOF" if $ScopeThisXSUB;
+#   ENTER;
+#   [[
+EOF
+	
 	if (!$thisdone && defined($class)) {
-	    if (defined($static) or $func_name =~ /^new/) {
+	    if (defined($static) or $func_name eq 'new') {
 		print "\tchar *";
 		$var_types{"CLASS"} = "char *";
 		&generate_init("char *", 1, "CLASS");
@@ -902,12 +952,15 @@ EOF
 			$args_match{"RETVAL"} = 0;
 			$var_types{"RETVAL"} = $ret_type;
 		}
+
 		print $deferred;
-                process_keyword("INIT|ALIAS|PROTOTYPE") ;
+
+        process_keyword("INIT|ALIAS|PROTOTYPE") ;
 
 		if (check_keyword("PPCODE")) {
 			print_section();
 			death ("PPCODE must be last thing") if @line;
+			print "\tLEAVE;\n" if $ScopeThisXSUB;
 			print "\tPUTBACK;\n\treturn;\n";
 		} elsif (check_keyword("CODE")) {
 			print_section() ;
@@ -921,13 +974,13 @@ EOF
 				$wantRETVAL = 1;
 			}
 			if (defined($static)) {
-			    if ($func_name =~ /^new/) {
+			    if ($func_name eq 'new') {
 				$func_name = "$class";
 			    } else {
 				print "${class}::";
 			    }
 			} elsif (defined($class)) {
-			    if ($func_name =~ /^new/) {
+			    if ($func_name eq 'new') {
 				$func_name .= " $class";
 			    } else {
 				print "THIS->";
@@ -951,10 +1004,18 @@ EOF
 	} elsif ($gotRETVAL || $wantRETVAL) {
 	    &generate_output($ret_type, 0, 'RETVAL');
 	}
+	print line_directive();
 
 	# do cleanup
 	process_keyword("CLEANUP|ALIAS|PROTOTYPE") ;
 
+	print Q<<"EOF" if $ScopeThisXSUB;
+#   ]]
+EOF
+	print Q<<"EOF" if $ScopeThisXSUB and not $PPCODE;
+#   LEAVE;
+EOF
+
 	# print function trailer
 	print Q<<EOF;
 #    ]]
@@ -980,9 +1041,15 @@ EOF
 #	croak(errbuf);
 EOF
 
-    print Q<<EOF unless $PPCODE;
+    if ($ret_type ne "void" or $EXPLICIT_RETURN) {
+        print Q<<EOF unless $PPCODE;
 #    XSRETURN(1);
 EOF
+    } else {
+        print Q<<EOF unless $PPCODE;
+#    XSRETURN_EMPTY;
+EOF
+    }
 
     print Q<<EOF;
 #]]
@@ -1090,6 +1157,15 @@ sub output_init {
     eval qq/print " $init\\\n"/;
 }
 
+sub line_directive
+{
+    # work out the line number
+    my $line_no = $line_no[@line_no - @line -1] ;
+ 
+    return "#line $line_no \"$filename\"\n" ;
+
+}
+
 sub Warn
 {
     # work out the line number
@@ -1138,16 +1214,19 @@ sub generate_init {
 	$subexpr =~ s/ntype/subtype/g;
 	$subexpr =~ s/\$arg/ST(ix_$var)/g;
 	$subexpr =~ s/\n\t/\n\t\t/g;
-	$subexpr =~ s/is not of (.*")/[arg %d] is not of $1, ix_$var + 1/g;
+	$subexpr =~ s/is not of (.*\")/[arg %d] is not of $1, ix_$var + 1/g;
 	$subexpr =~ s/\$var/${var}[ix_$var - $argoff]/;
 	$expr =~ s/DO_ARRAY_ELEM/$subexpr/;
     }
+    if ($expr =~ m#/\*.*scope.*\*/#i) { # "scope" in C comments
+    	$ScopeThisXSUB = 1;
+    }
     if (defined($defaults{$var})) {
 	    $expr =~ s/(\t+)/$1    /g;
 	    $expr =~ s/        /\t/g;
 	    eval qq/print "\\t$var;\\n"/;
 	    $deferred .= eval qq/"\\n\\tif (items < $num)\\n\\t    $var = $defaults{$var};\\n\\telse {\\n$expr;\\n\\t}\\n"/;
-    } elsif ($expr !~ /^\t\$var =/) {
+    } elsif ($ScopeThisXSUB or $expr !~ /^\t\$var =/) {
 	    eval qq/print "\\t$var;\\n"/;
 	    $deferred .= eval qq/"\\n$expr;\\n"/;
     } else {
@@ -1187,11 +1266,27 @@ sub generate_output {
 		eval "print qq\a$expr\a";
 	    }
 	    elsif ($var eq 'RETVAL') {
-		if ($expr =~ /^\t\$arg = /) {
+		if ($expr =~ /^\t\$arg = new/) {
+		    # We expect that $arg has refcnt 1, so we need to
+		    # mortalize it.
 		    eval "print qq\a$expr\a";
 		    print "\tsv_2mortal(ST(0));\n";
 		}
+		elsif ($expr =~ /^\s*\$arg\s*=/) {
+		    # We expect that $arg has refcnt >=1, so we need
+		    # to mortalize it. However, the extension may have
+		    # returned the built-in perl value, which is
+		    # read-only, thus not mortalizable. However, it is
+		    # safe to leave it as it is, since it would be
+		    # ignored by REFCNT_dec. Builtin values have REFCNT==0.
+		    eval "print qq\a$expr\a";
+		    print "\tif (SvREFCNT(ST(0))) sv_2mortal(ST(0));\n";
+		}
 		else {
+		    # Just hope that the entry would safely write it
+		    # over an already mortalized value. By
+		    # coincidence, something like $arg = &sv_undef
+		    # works too.
 		    print "\tST(0) = sv_newmortal();\n";
 		    eval "print qq\a$expr\a";
 		}
@@ -1215,5 +1310,6 @@ sub Exit {
 # If this is VMS, the exit status has meaning to the shell, so we
 # use a predictable value (SS$_Normal or SS$_Abort) rather than an
 # arbitrary number.
-    exit ($Is_VMS ? ($errors ? 44 : 1) : $errors) ;
+#    exit ($Is_VMS ? ($errors ? 44 : 1) : $errors) ;
+    exit ($errors ? 1 : 0);
 }
diff --git a/lib/File/Basename.pm b/lib/File/Basename.pm
index daff148a63..e4863f8911 100644
--- a/lib/File/Basename.pm
+++ b/lib/File/Basename.pm
@@ -2,8 +2,6 @@ package File::Basename;
 
 =head1 NAME
 
-Basename - parse file specifications
-
 fileparse - split a pathname into pieces
 
 basename - extract just the filename from a path
@@ -34,16 +32,23 @@ pieces using the syntax of different operating systems.
 =item fileparse_set_fstype
 
 You select the syntax via the routine fileparse_set_fstype().
+
 If the argument passed to it contains one of the substrings
-"VMS", "MSDOS", or "MacOS", the file specification syntax of that
-operating system is used in future calls to fileparse(),
-basename(), and dirname().  If it contains none of these
-substrings, UNIX syntax is used.  This pattern matching is
+"VMS", "MSDOS", "MacOS", "AmigaOS" or "MSWin32", the file specification 
+syntax of that operating system is used in future calls to 
+fileparse(), basename(), and dirname().  If it contains none of
+these substrings, UNIX syntax is used.  This pattern matching is
 case-insensitive.  If you've selected VMS syntax, and the file
 specification you pass to one of these routines contains a "/",
 they assume you are using UNIX emulation and apply the UNIX syntax
 rules instead, for that function call only.
 
+If the argument passed to it contains one of the substrings "VMS",
+"MSDOS", "MacOS", "AmigaOS", "os2", "MSWin32" or "RISCOS", then the pattern
+matching for suffix removal is performed without regard for case,
+since those systems are not case-sensitive when opening existing files
+(though some of them preserve case on file creation).
+
 If you haven't called fileparse_set_fstype(), the syntax is chosen
 by examining the builtin variable C<$^O> according to these rules.
 
@@ -61,8 +66,8 @@ B<name> is removed and prepended to B<suffix>.  By proper use of
 C<@suffixlist>, you can remove file types or versions for examination.
 
 You are guaranteed that if you concatenate B<path>, B<name>, and
-B<suffix> together in that order, the result will be identical to the
-input file specification.
+B<suffix> together in that order, the result will denote the same
+file as the input file specification.
 
 =back
 
@@ -70,14 +75,14 @@ input file specification.
 
 Using UNIX file syntax:
 
-    ($base,$path,$type) = fileparse('/virgil/aeneid/draft.book7', 
+    ($base,$path,$type) = fileparse('/virgil/aeneid/draft.book7',
 				    '\.book\d+');
 
 would yield
 
     $base eq 'draft'
-    $path eq '/virgil/aeneid',
-    $tail eq '.book7'
+    $path eq '/virgil/aeneid/',
+    $type eq '.book7'
 
 Similarly, using VMS syntax:
 
@@ -90,120 +95,100 @@ would yield
     $dir  eq 'Doc_Root:[Help]'
     $type eq '.Rnh'
 
+=over
+
 =item C<basename>
 
 The basename() routine returns the first element of the list produced
-by calling fileparse() with the same arguments.  It is provided for
-compatibility with the UNIX shell command basename(1).
+by calling fileparse() with the same arguments, except that it always
+quotes metacharacters in the given suffixes.  It is provided for
+programmer compatibility with the UNIX shell command basename(1).
 
 =item C<dirname>
 
 The dirname() routine returns the directory portion of the input file
 specification.  When using VMS or MacOS syntax, this is identical to the
 second element of the list produced by calling fileparse() with the same
-input file specification.  When using UNIX or MSDOS syntax, the return
+input file specification.  (Under VMS, if there is no directory information
+in the input file specification, then the current default device and
+directory are returned.)  When using UNIX or MSDOS syntax, the return
 value conforms to the behavior of the UNIX shell command dirname(1).  This
 is usually the same as the behavior of fileparse(), but differs in some
 cases.  For example, for the input file specification F<lib/>, fileparse()
 considers the directory name to be F<lib/>, while dirname() considers the
 directory name to be F<.>).
 
+=back
+
 =cut
 
 require 5.002;
 require Exporter;
 @ISA = qw(Exporter);
 @EXPORT = qw(fileparse fileparse_set_fstype basename dirname);
+#use strict;
+#use vars qw($VERSION $Fileparse_fstype $Fileparse_igncase);
+$VERSION = "2.5";
+
 
 #   fileparse_set_fstype() - specify OS-based rules used in future
 #                            calls to routines in this package
 #
-#   Currently recognized values: VMS, MSDOS, MacOS
-#       Any other name uses Unix-style rules
+#   Currently recognized values: VMS, MSDOS, MacOS, AmigaOS, os2, RISCOS
+#       Any other name uses Unix-style rules and is case-sensitive
 
 sub fileparse_set_fstype {
-  my($old) = $Fileparse_fstype;
-  $Fileparse_fstype = $_[0] if $_[0];
-  $old;
+  my @old = ($Fileparse_fstype, $Fileparse_igncase);
+  if (@_) {
+    $Fileparse_fstype = $_[0];
+    $Fileparse_igncase = ($_[0] =~ /^(?:MacOS|VMS|AmigaOS|os2|RISCOS|MSWin32)/i);
+  }
+  wantarray ? @old : $old[0];
 }
 
 #   fileparse() - parse file specification
 #
-#   calling sequence:
-#     ($filename,$prefix,$tail) = &basename_pat($filespec,@excludelist);
-#     where  $filespec    is the file specification to be parsed, and
-#            @excludelist is a list of patterns which should be removed
-#                         from the end of $filename.
-#            $filename    is the part of $filespec after $prefix (i.e. the
-#                         name of the file).  The elements of @excludelist
-#                         are compared to $filename, and if an  
-#            $prefix     is the path portion $filespec, up to and including
-#                        the end of the last directory name
-#            $tail        any characters removed from $filename because they
-#                         matched an element of @excludelist.
-#
-#   fileparse() first removes the directory specification from $filespec,
-#   according to the syntax of the OS (code is provided below to handle
-#   VMS, Unix, MSDOS and MacOS; you can pick the one you want using
-#   fileparse_set_fstype(), or you can accept the default, which is
-#   based on the information in the builtin variable $^O).  It then compares
-#   each element of @excludelist to $filename, and if that element is a
-#   suffix of $filename, it is removed from $filename and prepended to
-#   $tail.  By specifying the elements of @excludelist in the right order,
-#   you can 'nibble back' $filename to extract the portion of interest
-#   to you.
-#
-#   For example, on a system running Unix,
-#   ($base,$path,$type) = fileparse('/virgil/aeneid/draft.book7',
-#                                       '\.book\d+');
-#   would yield $base == 'draft',
-#               $path == '/virgil/aeneid/'  (note trailing slash)
-#               $tail == '.book7'.
-#   Similarly, on a system running VMS,
-#   ($name,$dir,$type) = fileparse('Doc_Root:[Help]Rhetoric.Rnh','\..*');
-#   would yield $name == 'Rhetoric';
-#               $dir == 'Doc_Root:[Help]', and
-#               $type == '.Rnh'.
-#
-#   Version 2.2  13-Oct-1994  Charles Bailey  bailey@genetics.upenn.edu 
+#   Version 2.4  27-Sep-1996  Charles Bailey  bailey@genetics.upenn.edu
 
 
 sub fileparse {
   my($fullname,@suffices) = @_;
-  my($fstype) = $Fileparse_fstype;
-  my($dirpath,$tail,$suffix);
+  my($fstype,$igncase) = ($Fileparse_fstype, $Fileparse_igncase);
+  my($dirpath,$tail,$suffix,$basename);
 
   if ($fstype =~ /^VMS/i) {
     if ($fullname =~ m#/#) { $fstype = '' }  # We're doing Unix emulation
     else {
-      ($dirpath,$basename) = ($fullname =~ /(.*[:>\]])?(.*)/);
-      $dirpath = $ENV{'DEFAULT'} unless $dirpath;
+      ($dirpath,$basename) = ($fullname =~ /^(.*[:>\]])?(.*)/);
     }
   }
-  if ($fstype =~ /^MSDOS/i) {
-    ($dirpath,$basename) = ($fullname =~ /(.*\\)?(.*)/);
-    $dirpath = '.\\' unless $dirpath;
+  if ($fstype =~ /^MS(DOS|Win32)/i) {
+    ($dirpath,$basename) = ($fullname =~ /^((?:.*[:\\\/])?)(.*)/);
+    $dirpath .= '.\\' unless $dirpath =~ /[\\\/]$/;
   }
-  elsif ($fstype =~ /^MAC/i) {
-    ($dirpath,$basename) = ($fullname =~ /(.*:)?(.*)/);
+  elsif ($fstype =~ /^MacOS/i) {
+    ($dirpath,$basename) = ($fullname =~ /^(.*:)?(.*)/);
+  }
+  elsif ($fstype =~ /^AmigaOS/i) {
+    ($dirpath,$basename) = ($fullname =~ /(.*[:\/])?(.*)/);
+    $dirpath = './' unless $dirpath;
   }
   elsif ($fstype !~ /^VMS/i) {  # default to Unix
-    ($dirpath,$basename) = ($fullname =~ m#(.*/)?(.*)#);
+    ($dirpath,$basename) = ($fullname =~ m#^(.*/)?(.*)#);
     $dirpath = './' unless $dirpath;
   }
 
   if (@suffices) {
     $tail = '';
     foreach $suffix (@suffices) {
-      if ($basename =~ /($suffix)$/) {
+      my $pat = ($igncase ? '(?i)' : '') . "($suffix)\$";
+      if ($basename =~ s/$pat//) {
         $tail = $1 . $tail;
-        $basename = $`;
       }
     }
   }
 
   wantarray ? ($basename,$dirpath,$tail) : $basename;
-
 }
 
 
@@ -213,7 +198,7 @@ sub basename {
   my($name) = shift;
   (fileparse($name, map("\Q$_\E",@_)))[0];
 }
-  
+
 
 #    dirname() - returns device and directory portion of file specification
 #        Behavior matches that of Unix dirname(1) exactly for Unix and MSDOS
@@ -228,25 +213,40 @@ sub dirname {
 
     if ($fstype =~ /VMS/i) { 
         if ($_[0] =~ m#/#) { $fstype = '' }
-        else { return $dirname }
+        else { return $dirname || $ENV{DEFAULT} }
     }
     if ($fstype =~ /MacOS/i) { return $dirname }
     elsif ($fstype =~ /MSDOS/i) { 
-        if ( $dirname =~ /:\\$/) { return $dirname }
+        $dirname =~ s/([^:])[\\\/]*$/$1/;
+        unless( length($basename) ) {
+	    ($basename,$dirname) = fileparse $dirname;
+	    $dirname =~ s/([^:])[\\\/]*$/$1/;
+	}
+    }
+    elsif ($fstype =~ /MSWin32/i) { 
+        $dirname =~ s/([^:])[\\\/]*$/$1/;
+        unless( length($basename) ) {
+	    ($basename,$dirname) = fileparse $dirname;
+	    $dirname =~ s/([^:])[\\\/]*$/$1/;
+	}
+    }
+    elsif ($fstype =~ /AmigaOS/i) {
+        if ( $dirname =~ /:$/) { return $dirname }
         chop $dirname;
-        $dirname =~ s:[^\\]+$:: unless $basename;
-        $dirname = '.' unless $dirname;
+        $dirname =~ s#[^:/]+$## unless length($basename);
     }
     else { 
-        if ( $dirname eq '/') { return $dirname }
-        chop $dirname;
-        $dirname =~ s:[^/]+$:: unless $basename;
-        $dirname = '.' unless $dirname;
+        $dirname =~ s:(.)/*$:$1:;
+        unless( length($basename) ) {
+	    local($File::Basename::Fileparse_fstype) = $fstype;
+	    ($basename,$dirname) = fileparse $dirname;
+	    $dirname =~ s:(.)/*$:$1:;
+	}
     }
 
     $dirname;
 }
 
-$Fileparse_fstype = $^O;
+fileparse_set_fstype $^O;
 
 1;
diff --git a/lib/File/Compare.pm b/lib/File/Compare.pm
new file mode 100644
index 0000000000..a76eb1ff59
--- /dev/null
+++ b/lib/File/Compare.pm
@@ -0,0 +1,142 @@
+package File::Compare;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $Too_Big *FROM *TO);
+
+require Exporter;
+use Carp;
+use UNIVERSAL qw(isa);
+
+$VERSION = '1.1001';
+@ISA = qw(Exporter);
+@EXPORT = qw(compare);
+@EXPORT_OK = qw(cmp);
+
+$Too_Big = 1024 * 1024 * 2;
+
+sub VERSION {
+    # Version of File::Compare
+    return $File::Compare::VERSION;
+}
+
+sub compare {
+    croak("Usage: compare( file1, file2 [, buffersize]) ")
+      unless(@_ == 2 || @_ == 3);
+
+    my $from = shift;
+    my $to = shift;
+    my $closefrom=0;
+    my $closeto=0;
+    my ($size, $fromsize, $status, $fr, $tr, $fbuf, $tbuf);
+    local(*FROM, *TO);
+    local($\) = '';
+
+    croak("from undefined") unless (defined $from);
+    croak("to undefined") unless (defined $to);
+
+    if (ref($from) && (isa($from,'GLOB') || isa($from,'IO::Handle'))) {
+	*FROM = *$from;
+    } elsif (ref(\$from) eq 'GLOB') {
+	*FROM = $from;
+    } else {
+	open(FROM,"<$from") or goto fail_open1;
+	binmode FROM;
+	$closefrom = 1;
+	$fromsize = -s FROM;
+    }
+
+    if (ref($to) && (isa($to,'GLOB') || isa($to,'IO::Handle'))) {
+	*TO = *$to;
+    } elsif (ref(\$to) eq 'GLOB') {
+	*TO = $to;
+    } else {
+	open(TO,"<$to") or goto fail_open2;
+	binmode TO;
+	$closeto = 1;
+    }
+
+    if ($closefrom && $closeto) {
+	# If both are opened files we know they differ if their size differ
+	goto fail_inner if $fromsize != -s TO;
+    }
+
+    if (@_) {
+	$size = shift(@_) + 0;
+	croak("Bad buffer size for compare: $size\n") unless ($size > 0);
+    } else {
+	$size = $fromsize;
+	$size = 1024 if ($size < 512);
+	$size = $Too_Big if ($size > $Too_Big);
+    }
+
+    $fbuf = '';
+    $tbuf = '';
+    while(defined($fr = read(FROM,$fbuf,$size)) && $fr > 0) {
+	unless (defined($tr = read(TO,$tbuf,$fr)) and $tbuf eq $fbuf) {
+            goto fail_inner;
+	}
+    }
+    goto fail_inner if (defined($tr = read(TO,$tbuf,$size)) && $tr > 0);
+
+    close(TO) || goto fail_open2 if $closeto;
+    close(FROM) || goto fail_open1 if $closefrom;
+
+    return 0;
+    
+  # All of these contortions try to preserve error messages...
+  fail_inner:
+    close(TO) || goto fail_open2 if $closeto;
+    close(FROM) || goto fail_open1 if $closefrom;
+
+    return 1;
+
+  fail_open2:
+    if ($closefrom) {
+	$status = $!;
+	$! = 0;
+	close FROM;
+	$! = $status unless $!;
+    }
+  fail_open1:
+    return -1;
+}
+
+*cmp = \&compare;
+
+1;
+
+__END__
+
+=head1 NAME
+
+File::Compare - Compare files or filehandles
+
+=head1 SYNOPSIS
+
+  	use File::Compare;
+
+	if (compare("file1","file2") == 0) {
+	    print "They're equal\n";
+	}
+
+=head1 DESCRIPTION
+
+The File::Compare::compare function compares the contents of two
+sources, each of which can be a file or a file handle.  It is exported
+from File::Compare by default.
+
+File::Compare::cmp is a synonym for File::Compare::compare.  It is
+exported from File::Compare only by request.
+
+=head1 RETURN
+
+File::Compare::compare return 0 if the files are equal, 1 if the
+files are unequal, or -1 if an error was encountered.
+
+=head1 AUTHOR
+
+File::Compare was written by Nick Ing-Simmons.
+Its original documentation was written by Chip Salzenberg.
+
+=cut
+
diff --git a/lib/File/Copy.pm b/lib/File/Copy.pm
index 6846013010..b1baa207b3 100644
--- a/lib/File/Copy.pm
+++ b/lib/File/Copy.pm
@@ -2,66 +2,93 @@
 # source code has been placed in the public domain by the author.
 # Please be kind and preserve the documentation.
 #
+# Additions copyright 1996 by Charles Bailey.  Permission is granted
+# to distribute the revised code under the same terms as Perl itself.
 
 package File::Copy;
 
-require Exporter;
+use strict;
 use Carp;
+use UNIVERSAL qw(isa);
+use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION $Too_Big
+	    &copy &syscopy &cp &mv);
+
+# Note that this module implements only *part* of the API defined by
+# the File/Copy.pm module of the File-Tools-2.0 package.  However, that
+# package has not yet been updated to work with Perl 5.004, and so it
+# would be a Bad Thing for the CPAN module to grab it and replace this
+# module.  Therefore, we set this module's version higher than 2.0.
+$VERSION = '2.02';
 
-@ISA=qw(Exporter);
-@EXPORT=qw(copy);
-@EXPORT_OK=qw(copy cp);
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(copy move);
+@EXPORT_OK = qw(cp mv);
 
-$File::Copy::VERSION = '1.5';
-$File::Copy::Too_Big = 1024 * 1024 * 2;
+$Too_Big = 1024 * 1024 * 2;
 
-sub VERSION {
-    # Version of File::Copy
-    return $File::Copy::VERSION;
+sub _catname { #  Will be replaced by File::Spec when it arrives
+    my($from, $to) = @_;
+    if (not defined &basename) {
+	require File::Basename;
+	import  File::Basename 'basename';
+    }
+    if ($^O eq 'VMS')  { $to = VMS::Filespec::vmspath($to) . basename($from); }
+    elsif ($^O eq 'MacOS') { $to .= ':' . basename($from); }
+    elsif ($to =~ m|\\|)   { $to .= '\\' . basename($from); }
+    else                   { $to .= '/' . basename($from); }
 }
 
 sub copy {
-    croak("Usage: copy( file1, file2 [, buffersize]) ")
+    croak("Usage: copy(FROM, TO [, BUFFERSIZE]) ")
       unless(@_ == 2 || @_ == 3);
 
-    if (($^O eq 'VMS' or $^O eq 'os2') && ref(\$to) ne 'GLOB' &&
-        !(defined ref $to and (ref($to) eq 'GLOB' ||
-          ref($to) eq 'FileHandle' || ref($to) eq 'VMS::Stdio')))
-        { return File::Copy::syscopy($_[0],$_[1]) }
-
     my $from = shift;
     my $to = shift;
-    my $recsep = $\;
-    my $closefrom=0;
-    my $closeto=0;
-    my ($size, $status, $r, $buf);
-    local(*FROM, *TO);
 
-    $\ = '';
+    my $from_a_handle = (ref($from)
+			 ? (ref($from) eq 'GLOB'
+			    || isa($from, 'GLOB') || isa($from, 'IO::Handle'))
+			 : (ref(\$from) eq 'GLOB'));
+    my $to_a_handle =   (ref($to)
+			 ? (ref($to) eq 'GLOB'
+			    || isa($to, 'GLOB') || isa($to, 'IO::Handle'))
+			 : (ref(\$to) eq 'GLOB'));
+
+    if (!$from_a_handle && !$to_a_handle && -d $to && ! -d $from) {
+	$to = _catname($from, $to);
+    }
 
-    if (ref(\$from) eq 'GLOB') {
-	*FROM = $from;
-    } elsif (defined ref $from and
-	     (ref($from) eq 'GLOB' || ref($from) eq 'FileHandle' ||
-	      ref($from) eq 'VMS::Stdio')) {
-	*FROM = *$from;
-    } else {
-	open(FROM,"<$from")||goto(fail_open1);
-	binmode FROM;
-	$closefrom = 1;
+    if (defined &syscopy && \&syscopy != \&copy
+	&& !$to_a_handle
+	&& !($from_a_handle && $^O eq 'os2'))	# OS/2 cannot handle handles
+    {
+	return syscopy($from, $to);
     }
 
-    if (ref(\$to) eq 'GLOB') {
-	*TO = $to;
-    } elsif (defined ref $to and
-	     (ref($to) eq 'GLOB' || ref($to) eq 'FileHandle' ||
-	      ref($to) eq 'VMS::Stdio')) {
-	*TO = *$to;
+    my $closefrom = 0;
+    my $closeto = 0;
+    my ($size, $status, $r, $buf);
+    local(*FROM, *TO);
+    local($\) = '';
+
+    if ($from_a_handle) {
+	*FROM = *$from{FILEHANDLE};
     } else {
-	open(TO,">$to")||goto(fail_open2);
-	binmode TO;
-	$closeto=1;
-    }
+	$from = "./$from" if $from =~ /^\s/;
+	open(FROM, "< $from\0") or goto fail_open1;
+	binmode FROM or die "($!,$^E)";
+	$closefrom = 1;
+    } 
+ 
+    if ($to_a_handle) {
+	*TO = *$to{FILEHANDLE};
+    } else {        
+	$to = "./$to" if $to =~ /^\s/;
+	open(TO,"> $to\0") or goto fail_open2;
+	binmode TO or die "($!,$^E)";
+	$closeto = 1;
+    }  
 
     if (@_) {
 	$size = shift(@_) + 0;
@@ -69,19 +96,25 @@ sub copy {
     } else {
 	$size = -s FROM;
 	$size = 1024 if ($size < 512);
-	$size = $File::Copy::Too_Big if ($size > $File::Copy::Too_Big);
+	$size = $Too_Big if ($size > $Too_Big);
     }
 
-    $buf = '';
-    while(defined($r = read(FROM,$buf,$size)) && $r > 0) {
-	if (syswrite (TO,$buf,$r) != $r) {
-	    goto fail_inner;    
+    $! = 0;
+    for (;;) {
+	my ($r, $w, $t);
+	defined($r = sysread(FROM, $buf, $size))
+	    or goto fail_inner;
+	last unless $r;
+	for ($w = 0; $w < $r; $w += $t) {
+	    $t = syswrite(TO, $buf, $r - $w, $w)
+		or goto fail_inner;
 	}
     }
-    goto fail_inner unless(defined($r));
+
     close(TO) || goto fail_open2 if $closeto;
     close(FROM) || goto fail_open1 if $closefrom;
-    $\ = $recsep;
+
+    # Use this idiom to avoid uninitialized value warning.
     return 1;
     
     # All of these contortions try to preserve error messages...
@@ -100,14 +133,47 @@ sub copy {
 	$! = $status unless $!;
     }
   fail_open1:
-    $\ = $recsep;
     return 0;
 }
 
+sub move {
+    my($from,$to) = @_;
+    my($copied,$fromsz,$tosz1,$tomt1,$tosz2,$tomt2,$sts,$ossts);
+
+    if (-d $to && ! -d $from) {
+	$to = _catname($from, $to);
+    }
+
+    ($tosz1,$tomt1) = (stat($to))[7,9];
+    $fromsz = -s $from;
+    if ($^O eq 'os2' and defined $tosz1 and defined $fromsz) {
+      # will not rename with overwrite
+      unlink $to;
+    }
+    return 1 if rename $from, $to;
+
+    ($sts,$ossts) = ($! + 0, $^E + 0);
+    # Did rename return an error even though it succeeded, because $to
+    # is on a remote NFS file system, and NFS lost the server's ack?
+    return 1 if defined($fromsz) && !-e $from &&           # $from disappeared
+                (($tosz2,$tomt2) = (stat($to))[7,9]) &&    # $to's there
+                ($tosz1 != $tosz2 or $tomt1 != $tomt2) &&  #   and changed
+                $tosz2 == $fromsz;                         # it's all there
+ 
+    ($tosz1,$tomt1) = (stat($to))[7,9];  # just in case rename did something
+    return 1 if ($copied = copy($from,$to)) && unlink($from);
+  
+    ($tosz2,$tomt2) = ((stat($to))[7,9],0,0) if defined $tomt1;
+    unlink($to) if !defined($tomt1) or $tomt1 != $tomt2 or $tosz1 != $tosz2;
+    ($!,$^E) = ($sts,$ossts);
+    return 0;
+}
 
 *cp = \&copy;
+*mv = \&move;
+
 # &syscopy is an XSUB under OS/2
-*syscopy = ($^O eq 'VMS' ? \&rmscopy : \&copy) unless $^O eq 'os2';
+*syscopy = ($^O eq 'VMS' ? \&rmscopy : \&copy) unless defined &syscopy;
 
 1;
 
@@ -123,6 +189,7 @@ File::Copy - Copy files or filehandles
 
 	copy("file1","file2");
   	copy("Copy.pm",\*STDOUT);'
+	move("/dev1/fileA","/dev2/fileB");
 
   	use POSIX;
 	use File::Copy cp;
@@ -132,16 +199,28 @@ File::Copy - Copy files or filehandles
 
 =head1 DESCRIPTION
 
-The File::Copy module provides a basic function C<copy> which takes two
+The File::Copy module provides two basic functions, C<copy> and
+C<move>, which are useful for getting the contents of a file from
+one place to another.
+
+=over 4
+
+=item *
+
+The C<copy> function takes two
 parameters: a file to copy from and a file to copy to. Either
 argument may be a string, a FileHandle reference or a FileHandle
 glob. Obviously, if the first argument is a filehandle of some
 sort, it will be read from, and if it is a file I<name> it will
 be opened for reading. Likewise, the second argument will be
-written to (and created if need be).  Note that passing in
+written to (and created if need be).
+
+B<Note that passing in
 files as handles instead of names may lead to loss of information
 on some operating systems; it is recommended that you use file
-names whenever possible.
+names whenever possible.>  Files are opened in binary mode where
+applicable.  To get a consistent behavour when copying from a
+filehandle to a file, use C<binmode> on the filehandle.
 
 An optional third parameter can be used to specify the buffer
 size used for copying. This is the number of bytes from the
@@ -153,6 +232,24 @@ upon the file, but will generally be the whole file (up to 2Mb), or
 You may use the syntax C<use File::Copy "cp"> to get at the
 "cp" alias for this function. The syntax is I<exactly> the same.
 
+=item *
+
+The C<move> function also takes two parameters: the current name
+and the intended name of the file to be moved.  If the destination
+already exists and is a directory, and the source is not a
+directory, then the source file will be renamed into the directory
+specified by the destination.
+
+If possible, move() will simply rename the file.  Otherwise, it copies
+the file to the new location and deletes the original.  If an error occurs
+during this copy-and-delete process, you may be left with a (possibly partial)
+copy of the file under the destination name.
+
+You may use the "mv" alias for this function in the same way that
+you may use the "cp" alias for C<copy>.
+
+=back
+
 File::Copy also provides the C<syscopy> routine, which copies the
 file specified in the first parameter to the file specified in the
 second parameter, preserving OS-specific attributes and file
@@ -161,25 +258,28 @@ C<copy> routine.  For VMS systems, this calls the C<rmscopy>
 routine (see below).  For OS/2 systems, this calls the C<syscopy>
 XSUB directly.
 
-=head2 Special behavior under VMS
+=head2 Special behavior if C<syscopy> is defined (VMS and OS/2)
 
-If the second argument to C<copy> is not a file handle for an
-already opened file, then C<copy> will perform an RMS copy of
+If both arguments to C<copy> are not file handles,
+then C<copy> will perform a "system copy" of
 the input file to a new output file, in order to preserve file
 attributes, indexed file structure, I<etc.>  The buffer size
-parameter is ignored.  If the second argument to C<copy> is a
-Perl handle to an opened file, then data is copied using Perl
+parameter is ignored.  If either argument to C<copy> is a
+handle to an opened file, then data is copied using Perl
 operators, and no effort is made to preserve file attributes
 or record structure.
 
-The RMS copy routine may also be called directly under VMS
-as C<File::Copy::rmscopy> (or C<File::Copy::syscopy>, which
-is just an alias for this routine).
+The system copy routine may also be called directly under VMS and OS/2
+as C<File::Copy::syscopy> (or under VMS as C<File::Copy::rmscopy>, which
+is the routine that does the actual work for syscopy).
+
+=over 4
 
 =item rmscopy($from,$to[,$date_flag])
 
-The first and second arguments may be strings, typeglobs, or
-typeglob references; they are used in all cases to obtain the
+The first and second arguments may be strings, typeglobs, typeglob
+references, or objects inheriting from IO::Handle;
+they are used in all cases to obtain the
 I<filespec> of the input and output files, respectively.  The
 name and type of the input file are used as defaults for the
 output file, if necessary.
@@ -195,8 +295,8 @@ associated with an old version of that file after C<rmscopy>
 returns, not the newly created version.)
 
 The third parameter is an integer flag, which tells C<rmscopy>
-how to handle timestamps.  If it is < 0, none of the input file's
-timestamps are propagated to the output file.  If it is > 0, then
+how to handle timestamps.  If it is E<lt> 0, none of the input file's
+timestamps are propagated to the output file.  If it is E<gt> 0, then
 it is interpreted as a bitmask: if bit 0 (the LSB) is set, then
 timestamps other than the revision date are propagated; if bit 1
 is set, the revision date is propagated.  If the third parameter
@@ -210,15 +310,17 @@ it defaults to 0.
 Like C<copy>, C<rmscopy> returns 1 on success.  If an error occurs,
 it sets C<$!>, deletes the output file, and returns 0.
 
+=back
+
 =head1 RETURN
 
-Returns 1 on success, 0 on failure. $! will be set if an error was
-encountered.
+All functions return 1 on success, 0 on failure.
+$! will be set if an error was encountered.
 
 =head1 AUTHOR
 
-File::Copy was written by Aaron Sherman I<E<lt>ajs@ajs.comE<gt>> in 1995.
-The VMS-specific code was added by Charles Bailey
-I<E<lt>bailey@genetics.upenn.eduE<gt>> in March 1996.
+File::Copy was written by Aaron Sherman I<E<lt>ajs@ajs.comE<gt>> in 1995,
+and updated by Charles Bailey I<E<lt>bailey@genetics.upenn.eduE<gt>> in 1996.
 
 =cut
+
diff --git a/lib/File/Find.pm b/lib/File/Find.pm
index 02bacd8fc2..1faea50158 100644
--- a/lib/File/Find.pm
+++ b/lib/File/Find.pm
@@ -31,6 +31,9 @@ C<"$File::Find::dir/$_">.  You are chdir()'d to $File::Find::dir when
 the function is called.  The function may set $File::Find::prune to
 prune the tree.
 
+File::Find assumes that you don't alter the $_ variable.  If you do then
+make sure you return it to its original value before exiting your function.
+
 This library is primarily for the C<find2perl> tool, which when fed, 
 
     find2perl / -name .nfs\* -mtime +7 \
@@ -70,8 +73,10 @@ that don't resolve:
 
 sub find {
     my $wanted = shift;
-    my $cwd = Cwd::fastcwd();
-    my ($topdir,$topdev,$topino,$topmode,$topnlink);
+    my $cwd = Cwd::cwd();
+    # Localize these rather than lexicalizing them for backwards
+    # compatibility.
+    local($topdir,$topdev,$topino,$topmode,$topnlink);
     foreach $topdir (@_) {
 	(($topdev,$topino,$topmode,$topnlink) = stat($topdir))
 	  || (warn("Can't stat $topdir: $!\n"), next);
@@ -82,7 +87,8 @@ sub find {
 		&$wanted;
 		my $fixtopdir = $topdir;
 	        $fixtopdir =~ s,/$,, ;
-		$fixtopdir =~ s/\.dir$// if $Is_VMS; ;
+		$fixtopdir =~ s/\.dir$// if $Is_VMS;
+		$fixtopdir =~ s/\\dir$// if $Is_NT;
 		&finddir($wanted,$fixtopdir,$topnlink);
 	    }
 	    else {
@@ -90,7 +96,7 @@ sub find {
 	    }
 	}
 	else {
-	    unless (($dir,$_) = File::Basename::fileparse($topdir)) {
+	    unless (($_,$dir) = File::Basename::fileparse($topdir)) {
 		($dir,$_) = ('.', $topdir);
 	    }
 	    $name = $topdir;
@@ -142,6 +148,7 @@ sub finddir {
 
 		    if (!$prune && chdir $_) {
 			$name =~ s/\.dir$// if $Is_VMS;
+			$name =~ s/\\dir$// if $Is_NT;
 			&finddir($wanted,$name,$nlink);
 			chdir '..';
 		    }
@@ -158,7 +165,9 @@ sub finddepth {
 
     $cwd = Cwd::fastcwd();;
 
-    my($topdir, $topdev, $topino, $topmode, $topnlink);
+    # Localize these rather than lexicalizing them for backwards
+    # compatibility.
+    local($topdir, $topdev, $topino, $topmode, $topnlink);
     foreach $topdir (@_) {
 	(($topdev,$topino,$topmode,$topnlink) = stat($topdir))
 	  || (warn("Can't stat $topdir: $!\n"), next);
@@ -167,6 +176,7 @@ sub finddepth {
 		my $fixtopdir = $topdir;
 		$fixtopdir =~ s,/$,, ;
 		$fixtopdir =~ s/\.dir$// if $Is_VMS;
+		$fixtopdir =~ s/\\dir$// if $Is_NT;
 		&finddepthdir($wanted,$fixtopdir,$topnlink);
 		($dir,$_) = ($fixtopdir,'.');
 		$name = $fixtopdir;
@@ -177,7 +187,7 @@ sub finddepth {
 	    }
 	}
 	else {
-	    unless (($dir,$_) = File::Basename::fileparse($topdir)) {
+	    unless (($_,$dir) = File::Basename::fileparse($topdir)) {
 		($dir,$_) = ('.', $topdir);
 	    }
 	    chdir $dir && &$wanted;
@@ -225,6 +235,7 @@ sub finddepthdir {
 
 		    if (chdir $_) {
 			$name =~ s/\.dir$// if $Is_VMS;
+			$name =~ s/\\dir$// if $Is_NT;
 			&finddepthdir($wanted,$name,$nlink);
 			chdir '..';
 		    }
@@ -247,9 +258,13 @@ if ($^O eq 'VMS') {
   $Is_VMS = 1;
   $dont_use_nlink = 1;
 }
+if ($^O =~ m:^mswin32:i) {
+  $Is_NT = 1;
+  $dont_use_nlink = 1;
+}
 
-$dont_use_nlink = 1 if $^O eq 'os2';
-$dont_use_nlink = 1 if $^O =~ m:^mswin32$:i ;
+$dont_use_nlink = 1
+    if $^O eq 'os2' || $^O eq 'msdos' || $^O eq 'amigaos';
 
 1;
 
diff --git a/lib/File/Path.pm b/lib/File/Path.pm
index 97cb66855d..fe56ae5365 100644
--- a/lib/File/Path.pm
+++ b/lib/File/Path.pm
@@ -14,9 +14,9 @@ C<rmtree(['foo/bar/baz', 'blurfl/quux'], 1, 1);>
 
 =head1 DESCRIPTION
 
-The C<mkpath> function provides a convenient way to create directories, even if
-your C<mkdir> kernel call won't create more than one level of directory at a
-time.  C<mkpath> takes three arguments:
+The C<mkpath> function provides a convenient way to create directories, even
+if your C<mkdir> kernel call won't create more than one level of directory at
+a time.  C<mkpath> takes three arguments:
 
 =over 4
 
@@ -38,8 +38,8 @@ the numeric mode to use when creating the directories
 
 =back
 
-It returns a list of all directories (including intermediates, determined using
-the Unix '/' separator) created.
+It returns a list of all directories (including intermediates, determined
+using the Unix '/' separator) created.
 
 Similarly, the C<rmtree> function provides a convenient way to delete a
 subtree from the directory structure, much like the Unix command C<rm -r>.
@@ -69,34 +69,50 @@ skip any files to which you do not have delete access
 (if running under VMS) or write access (if running
 under another OS).  This will change in the future when
 a criterion for 'delete permission' under OSs other
-than VMS is settled. (defaults to FALSE)
+than VMS is settled.  (defaults to FALSE)
 
 =back
 
-It returns the number of files successfully deleted. Symlinks are
+It returns the number of files successfully deleted.  Symlinks are
 treated as ordinary files.
 
+B<NOTE:> If the third parameter is not TRUE, C<rmtree> is B<unsecure>
+in the face of failure or interruption.  Files and directories which
+were not deleted may be left with permissions reset to allow world
+read and write access.  Note also that the occurrence of errors in
+rmtree can be determined I<only> by trapping diagnostic messages
+using C<$SIG{__WARN__}>; it is not apparent from the return value.
+Therefore, you must be extremely careful about using C<rmtree($foo,$bar,0>
+in situations where security is an issue.
+
 =head1 AUTHORS
 
-Tim Bunce <Tim.Bunce@ig.co.uk>
-Charles Bailey <bailey@genetics.upenn.edu>
+Tim Bunce <F<Tim.Bunce@ig.co.uk>> and
+Charles Bailey <F<bailey@genetics.upenn.edu>>
 
 =head1 REVISION
 
-This module was last revised 14-Feb-1996, for perl 5.002. $VERSION is
-1.01.
+Current $VERSION is 1.04.
 
 =cut
 
-$VERSION = "1.01"; # That's my hobby-horse, A.K.
-
-require 5.000;
 use Carp;
-require Exporter;
+use File::Basename ();
+use DirHandle ();
+use Exporter ();
+use strict;
+
+use vars qw( $VERSION @ISA @EXPORT );
+$VERSION = "1.04";
 @ISA = qw( Exporter );
 @EXPORT = qw( mkpath rmtree );
 
-$Is_VMS = $^O eq 'VMS';
+my $Is_VMS = $^O eq 'VMS';
+
+# These OSes complain if you want to remove a file that you have no
+# write permission to:
+my $force_writeable = ($^O eq 'os2' || $^O eq 'msdos' || $^O eq 'MSWin32'
+		       || $^O eq 'amigaos');
 
 sub mkpath {
     my($paths, $verbose, $mode) = @_;
@@ -106,17 +122,16 @@ sub mkpath {
     local($")="/";
     $mode = 0777 unless defined($mode);
     $paths = [$paths] unless ref $paths;
-    my(@created);
-    foreach $path (@$paths){
-        next if -d $path;
-        my(@p);
-        foreach(split(/\//, $path)){
-            push(@p, $_);
-            next if -d "@p/";
-            print "mkdir @p\n" if $verbose;
-	    mkdir("@p",$mode) || croak "mkdir @p: $!";
-            push(@created, "@p");
-        }
+    my(@created,$path);
+    foreach $path (@$paths) {
+	next if -d $path;
+	# Logic wants Unix paths, so go with the flow.
+	$path = VMS::Filespec::unixify($path) if $Is_VMS;
+	my $parent = File::Basename::dirname($path);
+	push(@created,mkpath($parent, $verbose, $mode)) unless (-d $parent);
+	print "mkdir $path\n" if $verbose;
+	mkdir($path,$mode) || croak "mkdir $path: $!";
+	push(@created, $path);
     }
     @created;
 }
@@ -126,40 +141,81 @@ sub rmtree {
     my(@files);
     my($count) = 0;
     $roots = [$roots] unless ref $roots;
+    $verbose ||= 0;
+    $safe ||= 0;
 
+    my($root);
     foreach $root (@{$roots}) {
-       $root =~ s#/$##;
-       if (not -l $root and -d _) { 
-           opendir(D,$root);
-           ($root = VMS::Filespec::unixify($root)) =~ s#\.dir$## if $Is_VMS;
-           @files = map("$root/$_", grep $_!~/^\.{1,2}$/, readdir(D));
-           closedir(D);
-           $count += rmtree(\@files,$verbose,$safe);
-           if ($safe &&
-               ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
-               print "skipped $root\n" if $verbose;
-               next;
-           }
-           print "rmdir $root\n" if $verbose;
-           (rmdir $root && ++$count) or carp "Can't remove directory $root: $!";
-        }
-        else { 
-           if ($safe &&
-               ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
-               print "skipped $root\n" if $verbose;
-               next;
-           }
-           print "unlink $root\n" if $verbose;
-           while (-e $root || -l $root) { # delete all versions under VMS
-               (unlink($root) && ++$count)
-                   or carp "Can't unlink file $root: $!";
-           }
-        }
+	$root =~ s#/$##;
+	(undef, undef, my $rp) = lstat $root or next;
+	$rp &= 07777;	# don't forget setuid, setgid, sticky bits
+	if ( -d _ ) {
+	    # notabene: 0777 is for making readable in the first place,
+	    # it's also intended to change it to writable in case we have
+	    # to recurse in which case we are better than rm -rf for 
+	    # subtrees with strange permissions
+	    chmod(0777, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
+	      or carp "Can't make directory $root read+writeable: $!"
+		unless $safe;
+
+	    my $d = DirHandle->new($root)
+	      or carp "Can't read $root: $!";
+	    @files = $d->read;
+	    $d->close;
+
+	    # Deleting large numbers of files from VMS Files-11 filesystems
+	    # is faster if done in reverse ASCIIbetical order 
+	    @files = reverse @files if $Is_VMS;
+	    ($root = VMS::Filespec::unixify($root)) =~ s#\.dir$## if $Is_VMS;
+	    @files = map("$root/$_", grep $_!~/^\.{1,2}$/,@files);
+	    $count += rmtree(\@files,$verbose,$safe);
+	    if ($safe &&
+		($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
+		print "skipped $root\n" if $verbose;
+		next;
+	    }
+	    chmod 0777, $root
+	      or carp "Can't make directory $root writeable: $!"
+		if $force_writeable;
+	    print "rmdir $root\n" if $verbose;
+	    if (rmdir $root) {
+		++$count;
+	    }
+	    else {
+		carp "Can't remove directory $root: $!";
+		chmod($rp, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
+		    or carp("and can't restore permissions to "
+		            . sprintf("0%o",$rp) . "\n");
+	    }
+	}
+	else { 
+	    if ($safe &&
+		($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
+		print "skipped $root\n" if $verbose;
+		next;
+	    }
+	    chmod 0666, $root
+	      or carp "Can't make file $root writeable: $!"
+		if $force_writeable;
+	    print "unlink $root\n" if $verbose;
+	    # delete all versions under VMS
+	    while (-e $root || -l $root) {
+		if (unlink $root) {
+		    ++$count;
+		}
+		else {
+		    carp "Can't unlink file $root: $!";
+		    if ($force_writeable) {
+			chmod $rp, $root
+			    or carp("and can't restore permissions to "
+			            . sprintf("0%o",$rp) . "\n");
+		    }
+		}
+	    }
+	}
     }
 
     $count;
 }
 
 1;
-
-__END__
diff --git a/lib/File/stat.pm b/lib/File/stat.pm
new file mode 100644
index 0000000000..f5d17f7da4
--- /dev/null
+++ b/lib/File/stat.pm
@@ -0,0 +1,113 @@
+package File::stat;
+use strict;
+
+BEGIN { 
+    use Exporter   ();
+    use vars       qw(@EXPORT @EXPORT_OK %EXPORT_TAGS);
+    @EXPORT      = qw(stat lstat);
+    @EXPORT_OK   = qw( $st_dev	   $st_ino    $st_mode 
+		       $st_nlink   $st_uid    $st_gid 
+		       $st_rdev    $st_size 
+		       $st_atime   $st_mtime  $st_ctime 
+		       $st_blksize $st_blocks
+		    );
+    %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
+}
+use vars      @EXPORT_OK;
+
+# Class::Struct forbids use of @ISA
+sub import { goto &Exporter::import }
+
+use Class::Struct qw(struct);
+struct 'File::stat' => [
+     map { $_ => '$' } qw{
+	 dev ino mode nlink uid gid rdev size
+	 atime mtime ctime blksize blocks
+     }
+];
+
+sub populate (@) {
+    return unless @_;
+    my $stob = new();
+    @$stob = (
+	$st_dev, $st_ino, $st_mode, $st_nlink, $st_uid, $st_gid, $st_rdev,
+        $st_size, $st_atime, $st_mtime, $st_ctime, $st_blksize, $st_blocks ) 
+	    = @_;
+    return $stob;
+} 
+
+sub lstat ($)  { populate(CORE::lstat(shift)) }
+
+sub stat ($) {
+    my $arg = shift;
+    my $st = populate(CORE::stat $arg);
+    return $st if $st;
+    no strict 'refs';
+    require Symbol;
+    return populate(CORE::stat \*{Symbol::qualify($arg)});
+}
+
+1;
+__END__
+
+=head1 NAME
+
+File::stat - by-name interface to Perl's built-in stat() functions
+
+=head1 SYNOPSIS
+
+ use File::stat;
+ $st = stat($file) or die "No $file: $!";
+ if ( ($st->mode & 0111) && $st->nlink > 1) ) {
+     print "$file is executable with lotsa links\n";
+ } 
+
+ use File::stat qw(:FIELDS);
+ stat($file) or die "No $file: $!";
+ if ( ($st_mode & 0111) && $st_nlink > 1) ) {
+     print "$file is executable with lotsa links\n";
+ } 
+
+=head1 DESCRIPTION
+
+This module's default exports override the core stat() 
+and lstat() functions, replacing them with versions that return 
+"File::stat" objects.  This object has methods that
+return the similarly named structure field name from the
+stat(2) function; namely,
+dev,
+ino,
+mode,
+nlink,
+uid,
+gid,
+rdev,
+size,
+atime,
+mtime,
+ctime,
+blksize,
+and
+blocks.  
+
+You may also import all the structure fields directly into your namespace
+as regular variables using the :FIELDS import tag.  (Note that this still
+overrides your stat() and lstat() functions.)  Access these fields as
+variables named with a preceding C<st_> in front their method names.
+Thus, C<$stat_obj-E<gt>dev()> corresponds to $st_dev if you import
+the fields.
+
+To access this functionality without the core overrides,
+pass the C<use> an empty import list, and then access
+function functions with their full qualified names.
+On the other hand, the built-ins are still available
+via the C<CORE::> pseudo-package.
+
+=head1 NOTE
+
+While this class is currently implemented using the Class::Struct
+module to build a struct-like class, you shouldn't rely upon this.
+
+=head1 AUTHOR
+
+Tom Christiansen
diff --git a/lib/FileCache.pm b/lib/FileCache.pm
index 3d01371b3b..4fd63315f9 100644
--- a/lib/FileCache.pm
+++ b/lib/FileCache.pm
@@ -53,7 +53,7 @@ sub cacheout {
     ($file) = @_;
     unless (defined $cacheout_maxopen) {
 	if (open(PARAM,'/usr/include/sys/param.h')) {
-	    local $.;
+	    local ($_, $.);
 	    while (<PARAM>) {
 		$cacheout_maxopen = $1 - 4
 		    if /^\s*#\s*define\s+NOFILE\s+(\d+)/;
diff --git a/lib/FileHandle.pm b/lib/FileHandle.pm
new file mode 100644
index 0000000000..0b5d9edcb4
--- /dev/null
+++ b/lib/FileHandle.pm
@@ -0,0 +1,252 @@
+package FileHandle;
+
+use 5.003_11;
+use strict;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+
+$VERSION = "2.00";
+
+require IO::File;
+@ISA = qw(IO::File);
+
+@EXPORT = qw(_IOFBF _IOLBF _IONBF);
+
+@EXPORT_OK = qw(
+    pipe
+
+    autoflush
+    output_field_separator
+    output_record_separator
+    input_record_separator
+    input_line_number
+    format_page_number
+    format_lines_per_page
+    format_lines_left
+    format_name
+    format_top_name
+    format_line_break_characters
+    format_formfeed
+
+    print
+    printf
+    getline
+    getlines
+);
+
+#
+# Everything we're willing to export, we must first import.
+#
+import IO::Handle grep { !defined(&$_) } @EXPORT, @EXPORT_OK;
+
+#
+# Some people call "FileHandle::function", so all the functions
+# that were in the old FileHandle class must be imported, too.
+#
+{
+    no strict 'refs';
+
+    my %import = (
+	'IO::Handle' =>
+	    [qw(DESTROY new_from_fd fdopen close fileno getc ungetc gets
+		eof flush error clearerr setbuf setvbuf _open_mode_string)],
+	'IO::Seekable' =>
+	    [qw(seek tell getpos setpos)],
+	'IO::File' =>
+	    [qw(new new_tmpfile open)]
+    );
+    for my $pkg (keys %import) {
+	for my $func (@{$import{$pkg}}) {
+	    my $c = *{"${pkg}::$func"}{CODE}
+		or die "${pkg}::$func missing";
+	    *$func = $c;
+	}
+    }
+}
+
+#
+# Specialized importer for Fcntl magic.
+#
+sub import {
+    my $pkg = shift;
+    my $callpkg = caller;
+    Exporter::export $pkg, $callpkg, @_;
+
+    #
+    # If the Fcntl extension is available,
+    #  export its constants.
+    #
+    eval {
+	require Fcntl;
+	Exporter::export 'Fcntl', $callpkg;
+    };
+}
+
+################################################
+# This is the only exported function we define;
+# the rest come from other classes.
+#
+
+sub pipe {
+    my $r = new IO::Handle;
+    my $w = new IO::Handle;
+    CORE::pipe($r, $w) or return undef;
+    ($r, $w);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+FileHandle - supply object methods for filehandles
+
+=head1 SYNOPSIS
+
+    use FileHandle;
+
+    $fh = new FileHandle;
+    if ($fh->open "< file") {
+        print <$fh>;
+        $fh->close;
+    }
+
+    $fh = new FileHandle "> FOO";
+    if (defined $fh) {
+        print $fh "bar\n";
+        $fh->close;
+    }
+
+    $fh = new FileHandle "file", "r";
+    if (defined $fh) {
+        print <$fh>;
+        undef $fh;       # automatically closes the file
+    }
+
+    $fh = new FileHandle "file", O_WRONLY|O_APPEND;
+    if (defined $fh) {
+        print $fh "corge\n";
+        undef $fh;       # automatically closes the file
+    }
+
+    $pos = $fh->getpos;
+    $fh->setpos($pos);
+
+    $fh->setvbuf($buffer_var, _IOLBF, 1024);
+
+    ($readfh, $writefh) = FileHandle::pipe;
+
+    autoflush STDOUT 1;
+
+=head1 DESCRIPTION
+
+NOTE: This class is now a front-end to the IO::* classes.
+
+C<FileHandle::new> creates a C<FileHandle>, which is a reference to a
+newly created symbol (see the C<Symbol> package).  If it receives any
+parameters, they are passed to C<FileHandle::open>; if the open fails,
+the C<FileHandle> object is destroyed.  Otherwise, it is returned to
+the caller.
+
+C<FileHandle::new_from_fd> creates a C<FileHandle> like C<new> does.
+It requires two parameters, which are passed to C<FileHandle::fdopen>;
+if the fdopen fails, the C<FileHandle> object is destroyed.
+Otherwise, it is returned to the caller.
+
+C<FileHandle::open> accepts one parameter or two.  With one parameter,
+it is just a front end for the built-in C<open> function.  With two
+parameters, the first parameter is a filename that may include
+whitespace or other special characters, and the second parameter is
+the open mode, optionally followed by a file permission value.
+
+If C<FileHandle::open> receives a Perl mode string (">", "+<", etc.)
+or a POSIX fopen() mode string ("w", "r+", etc.), it uses the basic
+Perl C<open> operator.
+
+If C<FileHandle::open> is given a numeric mode, it passes that mode
+and the optional permissions value to the Perl C<sysopen> operator.
+For convenience, C<FileHandle::import> tries to import the O_XXX
+constants from the Fcntl module.  If dynamic loading is not available,
+this may fail, but the rest of FileHandle will still work.
+
+C<FileHandle::fdopen> is like C<open> except that its first parameter
+is not a filename but rather a file handle name, a FileHandle object,
+or a file descriptor number.
+
+If the C functions fgetpos() and fsetpos() are available, then
+C<FileHandle::getpos> returns an opaque value that represents the
+current position of the FileHandle, and C<FileHandle::setpos> uses
+that value to return to a previously visited position.
+
+If the C function setvbuf() is available, then C<FileHandle::setvbuf>
+sets the buffering policy for the FileHandle.  The calling sequence
+for the Perl function is the same as its C counterpart, including the
+macros C<_IOFBF>, C<_IOLBF>, and C<_IONBF>, except that the buffer
+parameter specifies a scalar variable to use as a buffer.  WARNING: A
+variable used as a buffer by C<FileHandle::setvbuf> must not be
+modified in any way until the FileHandle is closed or until
+C<FileHandle::setvbuf> is called again, or memory corruption may
+result!
+
+See L<perlfunc> for complete descriptions of each of the following
+supported C<FileHandle> methods, which are just front ends for the
+corresponding built-in functions:
+
+    close
+    fileno
+    getc
+    gets
+    eof
+    clearerr
+    seek
+    tell
+
+See L<perlvar> for complete descriptions of each of the following
+supported C<FileHandle> methods:
+
+    autoflush
+    output_field_separator
+    output_record_separator
+    input_record_separator
+    input_line_number
+    format_page_number
+    format_lines_per_page
+    format_lines_left
+    format_name
+    format_top_name
+    format_line_break_characters
+    format_formfeed
+
+Furthermore, for doing normal I/O you might need these:
+
+=over 
+
+=item $fh->print
+
+See L<perlfunc/print>.
+
+=item $fh->printf
+
+See L<perlfunc/printf>.
+
+=item $fh->getline
+
+This works like <$fh> described in L<perlop/"I/O Operators">
+except that it's more readable and can be safely called in an
+array context but still returns just one line.
+
+=item $fh->getlines
+
+This works like <$fh> when called in an array context to
+read all the remaining lines in a file, except that it's more readable.
+It will also croak() if accidentally called in a scalar context.
+
+=back
+
+=head1 SEE ALSO
+
+The B<IO> extension,
+L<perlfunc>, 
+L<perlop/"I/O Operators">.
+
+=cut
diff --git a/lib/FindBin.pm b/lib/FindBin.pm
new file mode 100644
index 0000000000..918775cda7
--- /dev/null
+++ b/lib/FindBin.pm
@@ -0,0 +1,188 @@
+# FindBin.pm
+#
+# Copyright (c) 1995 Graham Barr & Nick Ing-Simmons. All rights reserved.
+# This program is free software; you can redistribute it and/or modify it
+# under the same terms as Perl itself.
+
+=head1 NAME
+
+FindBin - Locate directory of original perl script
+
+=head1 SYNOPSIS
+
+ use FindBin;
+ use lib "$FindBin::Bin/../lib";
+
+ or
+
+ use FindBin qw($Bin);
+ use lib "$Bin/../lib";
+
+=head1 DESCRIPTION
+
+Locates the full path to the script bin directory to allow the use
+of paths relative to the bin directory.
+
+This allows a user to setup a directory tree for some software with
+directories E<lt>rootE<gt>/bin and E<lt>rootE<gt>/lib and then the above example will allow
+the use of modules in the lib directory without knowing where the software
+tree is installed.
+
+If perl is invoked using the B<-e> option or the perl script is read from
+C<STDIN> then FindBin sets both C<$Bin> and C<$RealBin> to the current
+directory.
+
+=head1 EXPORTABLE VARIABLES
+
+ $Bin         - path to bin directory from where script was invoked
+ $Script      - basename of script from which perl was invoked
+ $RealBin     - $Bin with all links resolved
+ $RealScript  - $Script with all links resolved
+
+=head1 KNOWN BUGS
+
+if perl is invoked as
+
+   perl filename
+
+and I<filename> does not have executable rights and a program called I<filename>
+exists in the users C<$ENV{PATH}> which satisfies both B<-x> and B<-T> then FindBin
+assumes that it was invoked via the C<$ENV{PATH}>.
+
+Workaround is to invoke perl as
+
+ perl ./filename
+
+=head1 AUTHORS
+
+Graham Barr E<lt>F<bodg@tiuk.ti.com>E<gt>
+Nick Ing-Simmons E<lt>F<nik@tiuk.ti.com>E<gt>
+
+=head1 COPYRIGHT
+
+Copyright (c) 1995 Graham Barr & Nick Ing-Simmons. All rights reserved.
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=head1 REVISION
+
+$Revision: 1.4 $
+
+=cut
+
+package FindBin;
+use Carp;
+require 5.000;
+require Exporter;
+use Cwd qw(getcwd abs_path);
+use Config;
+use File::Basename;
+
+@EXPORT_OK = qw($Bin $Script $RealBin $RealScript $Dir $RealDir);
+%EXPORT_TAGS = (ALL => [qw($Bin $Script $RealBin $RealScript $Dir $RealDir)]);
+@ISA = qw(Exporter);
+
+$VERSION = $VERSION = sprintf("%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/);
+
+sub is_abs_path
+{
+ local $_ = shift if (@_);
+ if ($^O eq 'MSWin32')
+  {
+   return m#^[a-z]:[\\/]#i;
+  }
+ elsif ($^O eq 'VMS')
+  {
+    # If it's a logical name, expand it.
+    $_ = $ENV{$_} while /^[\w\$\-]+$/ and $ENV{$_};
+    return m!^/! or m![<\[][^.\-\]>]! or /:[^<\[]/;
+  }
+ else
+  {
+   return m#^/#;
+  }
+}
+
+BEGIN
+{
+ *Dir = \$Bin;
+ *RealDir = \$RealBin;
+
+ if($0 eq '-e' || $0 eq '-')
+  {
+   # perl invoked with -e or script is on C<STDIN>
+
+   $Script = $RealScript = $0;
+   $Bin    = $RealBin    = getcwd();
+  }
+ else
+  {
+   my $script = $0;
+
+   if ($^O eq 'VMS')
+    {
+     ($Bin,$Script) = VMS::Filespec::rmsexpand($0) =~ /(.*\])(.*)/;
+     ($RealBin,$RealScript) = ($Bin,$Script);
+    }
+   else
+    {
+     my $IsWin32 = $^O eq 'MSWin32';
+     unless(($script =~ m#/# || ($IsWin32 && $script =~ m#\\#))
+            && -f $script)
+      {
+       my $dir;
+       my $pathvar = ($IsWin32) ? 'Path' : 'PATH';
+
+       foreach $dir (split(/$Config{'path_sep'}/,$ENV{$pathvar}))
+	{
+	if(-r "$dir/$script" && (!$IsWin32 || -x _))
+         {
+          $script = "$dir/$script";
+
+	  if (-f $0)
+           {
+	    # $script has been found via PATH but perl could have
+	    # been invoked as 'perl file'. Do a dumb check to see
+	    # if $script is a perl program, if not then $script = $0
+            #
+            # well we actually only check that it is an ASCII file
+            # we know its executable so it is probably a script
+            # of some sort.
+
+            $script = $0 unless(-T $script);
+           }
+          last;
+         }
+       }
+     }
+
+     croak("Cannot find current script '$0'") unless(-f $script);
+
+     # Ensure $script contains the complete path incase we C<chdir>
+
+     $script = getcwd() . "/" . $script unless is_abs_path($script);
+
+     ($Script,$Bin) = fileparse($script);
+
+     # Resolve $script if it is a link
+     while(1)
+      {
+       my $linktext = readlink($script);
+
+       ($RealScript,$RealBin) = fileparse($script);
+       last unless defined $linktext;
+
+       $script = (is_abs_path($linktext))
+                  ? $linktext
+                  : $RealBin . "/" . $linktext;
+      }
+
+     # Get absolute paths to directories
+     $Bin     = abs_path($Bin)     if($Bin);
+     $RealBin = abs_path($RealBin) if($RealBin);
+    }
+  }
+}
+
+1; # Keep require happy
+
diff --git a/lib/Getopt/Long.pm b/lib/Getopt/Long.pm
index 5dd5d16b25..b0bcf6b810 100644
--- a/lib/Getopt/Long.pm
+++ b/lib/Getopt/Long.pm
@@ -1,22 +1,15 @@
-# GetOpt::Long.pm -- POSIX compatible options parsing
+# GetOpt::Long.pm -- Universal options parsing
 
-# RCS Status      : $Id: GetoptLong.pm,v 2.1 1996/02/02 20:24:35 jv Exp $
+package Getopt::Long;
+
+# RCS Status      : $Id: GetoptLong.pm,v 2.10 1997-04-18 22:21:10+02 jv Exp $
 # Author          : Johan Vromans
 # Created On      : Tue Sep 11 15:00:12 1990
 # Last Modified By: Johan Vromans
-# Last Modified On: Fri Feb  2 21:24:32 1996
-# Update Count    : 347
+# Last Modified On: Wed Apr 16 16:27:33 1997
+# Update Count    : 597
 # Status          : Released
 
-package Getopt::Long;
-require 5.000;
-require Exporter;
-
-@ISA = qw(Exporter);
-@EXPORT = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
-$VERSION = sprintf("%d.%02d", q$Revision: 2.1 $ =~ /(\d+)\.(\d+)/);
-use strict;
-
 =head1 NAME
 
 GetOptions - extended processing of command line options
@@ -32,9 +25,10 @@ The Getopt::Long module implements an extended getopt function called
 GetOptions(). This function adheres to the POSIX syntax for command
 line options, with GNU extensions. In general, this means that options
 have long names instead of single letters, and are introduced with a
-double dash "--". There is no bundling of command line options, as was
-the case with the more traditional single-letter approach. For
-example, the UNIX "ps" command can be given the command line "option" 
+double dash "--". Support for bundling of command line options, as was
+the case with the more traditional single-letter approach, is provided
+but not enabled by default. For example, the UNIX "ps" command can be
+given the command line "option"
 
   -vax
 
@@ -55,7 +49,7 @@ the value it can take. The option linkage is usually a reference to a
 variable that will be set when the option is used. For example, the
 following call to GetOptions:
 
-  &GetOptions("size=i" => \$offset);
+  GetOptions("size=i" => \$offset);
 
 will accept a command line option "size" that must have an integer
 value. With a command line of "--size 24" this will cause the variable
@@ -66,7 +60,7 @@ a HASH describing the linkage for the options. The following call is
 equivalent to the example above:
 
   %optctl = ("size" => \$offset);
-  &GetOptions(\%optctl, "size=i");
+  GetOptions(\%optctl, "size=i");
 
 Linkage may be specified using either of the above methods, or both.
 Linkage specified in the argument list takes precedence over the
@@ -81,7 +75,7 @@ followed by an argument specifier. Values for argument specifiers are:
 
 =over 8
 
-=item <none>
+=item E<lt>noneE<gt>
 
 Option does not take an argument. 
 The option variable will be set to 1.
@@ -150,7 +144,7 @@ specified but a ref HASH is passed, GetOptions will place the value in
 the HASH. For example:
 
   %optctl = ();
-  &GetOptions (\%optctl, "size=i");
+  GetOptions (\%optctl, "size=i");
 
 will perform the equivalent of the assignment
 
@@ -159,13 +153,24 @@ will perform the equivalent of the assignment
 For array options, a reference to an array is used, e.g.:
 
   %optctl = ();
-  &GetOptions (\%optctl, "sizes=i@");
+  GetOptions (\%optctl, "sizes=i@");
 
 with command line "-sizes 24 -sizes 48" will perform the equivalent of
 the assignment
 
   $optctl{"sizes"} = [24, 48];
 
+For hash options (an option whose argument looks like "name=value"),
+a reference to a hash is used, e.g.:
+
+  %optctl = ();
+  GetOptions (\%optctl, "define=s%");
+
+with command line "--define foo=hello --define bar=world" will perform the
+equivalent of the assignment
+
+  $optctl{"define"} = {foo=>'hello', bar=>'world')
+
 If no linkage is explicitly specified and no ref HASH is passed,
 GetOptions will put the value in a global variable named after the
 option, prefixed by "opt_". To yield a usable Perl variable,
@@ -175,7 +180,7 @@ the variable $opt_fpp_struct_return. Note that this variable resides
 in the namespace of the calling program, not necessarily B<main>.
 For example:
 
-  &GetOptions ("size=i", "sizes=i@");
+  GetOptions ("size=i", "sizes=i@");
 
 with command line "-size 10 -sizes 24 -sizes 48" will perform the
 equivalent of the assignments
@@ -187,7 +192,7 @@ A lone dash B<-> is considered an option, the corresponding Perl
 identifier is $opt_ .
 
 The linkage specifier can be a reference to a scalar, a reference to
-an array or a reference to a subroutine.
+an array, a reference to a hash or a reference to a subroutine.
 
 If a REF SCALAR is supplied, the new value is stored in the referenced
 variable. If the option occurs more than once, the previous value is
@@ -196,6 +201,11 @@ overwritten.
 If a REF ARRAY is supplied, the new value is appended (pushed) to the
 referenced array. 
 
+If a REF HASH is supplied, the option value should look like "key" or
+"key=value" (if the "=value" is omitted then a value of 1 is implied).
+In this case, the element of the referenced hash with the key "key"
+is assigned "value". 
+
 If a REF CODE is supplied, the referenced subroutine is called with
 two arguments: the option name and the option value.
 The option name is always the true name, not an abbreviation or alias.
@@ -204,19 +214,21 @@ The option name is always the true name, not an abbreviation or alias.
 
 The option name may actually be a list of option names, separated by
 "|"s, e.g. "foo|bar|blech=s". In this example, "foo" is the true name
-op this option. If no linkage is specified, options "foo", "bar" and
+of this option. If no linkage is specified, options "foo", "bar" and
 "blech" all will set $opt_foo.
 
 Option names may be abbreviated to uniqueness, depending on
-configuration variable $Getopt::Long::autoabbrev.
+configuration option B<auto_abbrev>.
 
 =head2 Non-option call-back routine
 
-A special option specifier, <>, can be used to designate a subroutine
+A special option specifier, E<lt>E<gt>, can be used to designate a subroutine
 to handle non-option arguments. GetOptions will immediately call this
 subroutine for every non-option it encounters in the options list.
 This subroutine gets the name of the non-option passed.
-This feature requires $Getopt::Long::order to have the value $PERMUTE.
+This feature requires configuration option B<permute>, see section
+CONFIGURATION OPTIONS.
+
 See also the examples.
 
 =head2 Option starters
@@ -242,13 +254,20 @@ In fact, the Perl 5 version of newgetopt.pl is just a wrapper around
 the module.
 
 If an "@" sign is appended to the argument specifier, the option is
-treated as an array.  Value(s) are not set, but pushed into array
-@opt_name. This only applies if no linkage is supplied.
+treated as an array. Value(s) are not set, but pushed into array
+@opt_name. If explicit linkage is supplied, this must be a reference
+to an ARRAY.
 
-If configuration variable $Getopt::Long::getopt_compat is set to a
-non-zero value, options that start with "+" may also include their
-arguments, e.g. "+foo=bar". This is for compatiblity with older
-implementations of the GNU "getopt" routine.
+If an "%" sign is appended to the argument specifier, the option is
+treated as a hash. Value(s) of the form "name=value" are set by
+setting the element of the hash %opt_name with key "name" to "value"
+(if the "=value" portion is omitted it defaults to 1). If explicit
+linkage is supplied, this must be a reference to a HASH.
+
+If configuration option B<getopt_compat> is set (see section
+CONFIGURATION OPTIONS), options that start with "+" or "-" may also
+include their arguments, e.g. "+foo=bar". This is for compatiblity
+with older implementations of the GNU "getopt" routine.
 
 If the first argument to GetOptions is a string consisting of only
 non-alphanumeric characters, it is taken to specify the option starter
@@ -281,64 +300,90 @@ In GNU or POSIX format, option names and values can be combined:
    --bar=		-> $opt_bar = ''
    --bar=--		-> $opt_bar = '--'
 
-Example of using variabel references:
+Example of using variable references:
 
-   $ret = &GetOptions ('foo=s', \$foo, 'bar=i', 'ar=s', \@ar);
+   $ret = GetOptions ('foo=s', \$foo, 'bar=i', 'ar=s', \@ar);
 
 With command line options "-foo blech -bar 24 -ar xx -ar yy" 
 this will result in:
 
-   $bar = 'blech'
+   $foo = 'blech'
    $opt_bar = 24
    @ar = ('xx','yy')
 
-Example of using the <> option specifier:
+Example of using the E<lt>E<gt> option specifier:
 
    @ARGV = qw(-foo 1 bar -foo 2 blech);
-   &GetOptions("foo=i", \$myfoo, "<>", \&mysub);
+   GetOptions("foo=i", \$myfoo, "<>", \&mysub);
 
 Results:
 
-   &mysub("bar") will be called (with $myfoo being 1)
-   &mysub("blech") will be called (with $myfoo being 2)
+   mysub("bar") will be called (with $myfoo being 1)
+   mysub("blech") will be called (with $myfoo being 2)
 
 Compare this with:
 
    @ARGV = qw(-foo 1 bar -foo 2 blech);
-   &GetOptions("foo=i", \$myfoo);
+   GetOptions("foo=i", \$myfoo);
 
 This will leave the non-options in @ARGV:
 
    $myfoo -> 2
    @ARGV -> qw(bar blech)
 
-=head1 CONFIGURATION VARIABLES
+=head1 CONFIGURATION OPTIONS
+
+B<GetOptions> can be configured by calling subroutine
+B<Getopt::Long::config>. This subroutine takes a list of quoted
+strings, each specifying a configuration option to be set, e.g.
+B<ignore_case>. Options can be reset by prefixing with B<no_>, e.g.
+B<no_ignore_case>. Case does not matter. Multiple calls to B<config>
+are possible.
+
+Previous versions of Getopt::Long used variables for the purpose of
+configuring. Although manipulating these variables still work, it
+is strongly encouraged to use the new B<config> routine. Besides, it
+is much easier.
 
-The following variables can be set to change the default behaviour of
-GetOptions():
+The following options are available:
 
 =over 12
 
-=item $Getopt::Long::autoabbrev      
+=item default
+
+This option causes all configuration options to be reset to their
+default values.
+
+=item auto_abbrev
 
 Allow option names to be abbreviated to uniqueness.
-Default is 1 unless environment variable
-POSIXLY_CORRECT has been set.
+Default is set unless environment variable
+POSIXLY_CORRECT has been set, in which case B<auto_abbrev> is reset.
 
-=item $Getopt::Long::getopt_compat   
+=item getopt_compat   
 
 Allow '+' to start options.
-Default is 1 unless environment variable
-POSIXLY_CORRECT has been set.
+Default is set unless environment variable
+POSIXLY_CORRECT has been set, in which case B<getopt_compat> is reset.
+
+=item require_order
 
-=item $Getopt::Long::order           
+Whether non-options are allowed to be mixed with
+options.
+Default is set unless environment variable
+POSIXLY_CORRECT has been set, in which case b<require_order> is reset.
+
+See also B<permute>, which is the opposite of B<require_order>.
+
+=item permute
 
 Whether non-options are allowed to be mixed with
 options.
-Default is $REQUIRE_ORDER if environment variable
-POSIXLY_CORRECT has been set, $PERMUTE otherwise.
+Default is set unless environment variable
+POSIXLY_CORRECT has been set, in which case B<permute> is reset.
+Note that B<permute> is the opposite of B<require_order>.
 
-$PERMUTE means that 
+If B<permute> is set, this means that 
 
     -foo arg1 -bar arg2 arg3
 
@@ -355,7 +400,7 @@ processed, except when B<--> is used:
 will call the call-back routine for arg1 and arg2, and terminate
 leaving arg2 in @ARGV.
 
-If $Getopt::Long::order is $REQUIRE_ORDER, options processing
+If B<require_order> is set, options processing
 terminates when the first non-option is encountered.
 
     -foo arg1 -bar arg2 arg3
@@ -364,11 +409,76 @@ is equivalent to
 
     -foo -- arg1 -bar arg2 arg3
 
-$RETURN_IN_ORDER is not supported by GetOptions().
+=item bundling (default: reset)
+
+Setting this variable to a non-zero value will allow single-character
+options to be bundled. To distinguish bundles from long option names,
+long options must be introduced with B<--> and single-character
+options (and bundles) with B<->. For example,
+
+    ps -vax --vax
+
+would be equivalent to
+
+    ps -v -a -x --vax
+
+provided "vax", "v", "a" and "x" have been defined to be valid
+options. 
+
+Bundled options can also include a value in the bundle; this value has
+to be the last part of the bundle, e.g.
+
+    scale -h24 -w80
+
+is equivalent to
+
+    scale -h 24 -w 80
+
+Note: resetting B<bundling> also resets B<bundling_override>.
+
+=item bundling_override (default: reset)
+
+If B<bundling_override> is set, bundling is enabled as with
+B<bundling> but now long option names override option bundles. In the
+above example, B<-vax> would be interpreted as the option "vax", not
+the bundle "v", "a", "x".
+
+Note: resetting B<bundling_override> also resets B<bundling>.
+
+B<Note:> Using option bundling can easily lead to unexpected results,
+especially when mixing long options and bundles. Caveat emptor.
+
+=item ignore_case  (default: set)
+
+If set, case is ignored when matching options.
+
+Note: resetting B<ignore_case> also resets B<ignore_case_always>.
+
+=item ignore_case_always (default: reset)
+
+When bundling is in effect, case is ignored on single-character
+options also. 
+
+Note: resetting B<ignore_case_always> also resets B<ignore_case>.
+
+=item pass_through (default: reset)
+
+Unknown options are passed through in @ARGV instead of being flagged
+as errors. This makes it possible to write wrapper scripts that
+process only part of the user supplied options, and passes the
+remaining options to some other program.
+
+This can be very confusing, especially when B<permute> is also set.
+
+=item debug (default: reset)
+
+Enable copious debugging output.
+
+=back
 
-=item $Getopt::Long::ignorecase      
+=head1 OTHER USEFUL VARIABLES
 
-Ignore case when matching options. Default is 1.
+=over 12
 
 =item $Getopt::Long::VERSION
 
@@ -376,7 +486,7 @@ The version number of this Getopt::Long implementation in the format
 C<major>.C<minor>. This can be used to have Exporter check the
 version, e.g.
 
-    use Getopt::Long 2.00;
+    use Getopt::Long 3.00;
 
 You can inspect $Getopt::Long::major_version and
 $Getopt::Long::minor_version for the individual components.
@@ -386,22 +496,13 @@ $Getopt::Long::minor_version for the individual components.
 Internal error flag. May be incremented from a call-back routine to
 cause options parsing to fail.
 
-=item $Getopt::Long::debug           
-
-Enable copious debugging output. Default is 0.
-
 =back
 
 =cut
 
-################ Introduction ################
-#
-# This package implements an extended getopt function. This function
-# adheres to the new syntax (long option names, no bundling). It tries
-# to implement the better functionality of traditional, GNU and POSIX
-# getopt functions.
-# 
-# This program is Copyright 1990,1996 by Johan Vromans.
+################ Copyright ################
+
+# This program is Copyright 1990,1997 by Johan Vromans.
 # This program is free software; you can redistribute it and/or
 # modify it under the terms of the GNU General Public License
 # as published by the Free Software Foundation; either version 2
@@ -416,77 +517,76 @@ Enable copious debugging output. Default is 0.
 # the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, 
 # MA 02139, USA.
 
-################ History ################
-# 
-# 13-Jan-1996		Johan Vromans
-#    Generalized the linkage interface.
-#    Eliminated the linkage argument.
-#    Add code references as a possible value for the option linkage.
-#    Add option specifier <> to have a call-back for non-options.
-#
-# 26-Dec-1995		Johan Vromans
-#    Import from netgetopt.pl.
-#    Turned into a decent module.
-#    Added linkage argument.
-
-################ Configuration Section ################
+################ Module Preamble ################
 
-# Values for $order. See GNU getopt.c for details.
-($Getopt::Long::REQUIRE_ORDER,
- $Getopt::Long::PERMUTE, 
- $Getopt::Long::RETURN_IN_ORDER) = (0..2);
+use strict;
 
-my $gen_prefix;			# generic prefix (option starters)
+BEGIN {
+    require 5.003;
+    use Exporter ();
+    use vars   qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+    $VERSION   = sprintf("%d.%02d", q$Revision: 2.10 $ =~ /(\d+)\.(\d+)/);
 
-# Handle POSIX compliancy.
-if ( defined $ENV{"POSIXLY_CORRECT"} ) {
-    $gen_prefix = "(--|-)";
-    $Getopt::Long::autoabbrev = 0;	# no automatic abbrev of options
-    $Getopt::Long::getopt_compat = 0;	# disallow '+' to start options
-    $Getopt::Long::order = $Getopt::Long::REQUIRE_ORDER;
-}
-else {
-    $gen_prefix = "(--|-|\\+)";
-    $Getopt::Long::autoabbrev = 1;	# automatic abbrev of options
-    $Getopt::Long::getopt_compat = 1;	# allow '+' to start options
-    $Getopt::Long::order = $Getopt::Long::PERMUTE;
+    @ISA       = qw(Exporter);
+    @EXPORT    = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
+    %EXPORT_TAGS = ();
+    @EXPORT_OK = qw();
 }
 
-# Other configurable settings.
-$Getopt::Long::debug = 0;		# for debugging
-$Getopt::Long::error = 0;		# error tally
-$Getopt::Long::ignorecase = 1;		# ignore case when matching options
-($Getopt::Long::version,
- $Getopt::Long::major_version, 
- $Getopt::Long::minor_version) = '$Revision: 2.1 $ ' =~ /: ((\d+)\.(\d+))/;
-$Getopt::Long::version .= '*' if length('$Locker:  $ ') > 12;
+use vars @EXPORT, @EXPORT_OK;
+# User visible variables.
+use vars qw($error $debug $major_version $minor_version);
+# Deprecated visible variables.
+use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order
+	    $passthrough);
+
+################ Local Variables ################
+
+my $gen_prefix;			# generic prefix (option starters)
+my $argend;			# option list terminator
+my %opctl;			# table of arg.specs (long and abbrevs)
+my %bopctl;			# table of arg.specs (bundles)
+my @opctl;			# the possible long option names
+my $pkg;			# current context. Needed if no linkage.
+my %aliases;			# alias table
+my $genprefix;			# so we can call the same module more 
+my $opt;			# current option
+my $arg;			# current option value, if any
+my $array;			# current option is array typed
+my $hash;			# current option is hash typed
+my $key;			# hash key for a hash option
+				# than once in differing environments
+my $config_defaults;		# set config defaults
+my $find_option;		# helper routine
 
 ################ Subroutines ################
 
 sub GetOptions {
 
     my @optionlist = @_;	# local copy of the option descriptions
-    my $argend = '--';		# option list terminator
-    my %opctl;			# table of arg.specs
-    my $pkg = (caller)[0];	# current context
+    $argend = '--';		# option list terminator
+    %opctl = ();		# table of arg.specs (long and abbrevs)
+    %bopctl = ();		# table of arg.specs (bundles)
+    $pkg = (caller)[0];		# current context
 				# Needed if linkage is omitted.
-    my %aliases;		# alias table
+    %aliases= ();		# alias table
     my @ret = ();		# accum for non-options
     my %linkage;		# linkage
     my $userlinkage;		# user supplied HASH
-    my $debug = $Getopt::Long::debug;	# convenience
-    my $genprefix = $gen_prefix; # so we can call the same module more 
-				# than once in differing environments
-    $Getopt::Long::error = 0;
+    $genprefix = $gen_prefix;	# so we can call the same module many times
+    $error = 0;
 
-    print STDERR ("GetOptions $Getopt::Long::version",
-		  " [GetOpt::Long $Getopt::Long::VERSION] -- ",
+    print STDERR ('GetOptions $Revision: 2.10 $ ',
+		  "[GetOpt::Long $Getopt::Long::VERSION] -- ",
 		  "called from package \"$pkg\".\n",
-		  "  autoabbrev=$Getopt::Long::autoabbrev".
-		  ",getopt_compat=$Getopt::Long::getopt_compat",
+		  "  (@ARGV)\n",
+		  "  autoabbrev=$autoabbrev".
+		  ",bundling=$bundling",
+		  ",getopt_compat=$getopt_compat",
+		  ",order=$order",
+		  ",\n  ignorecase=$ignorecase",
+		  ",passthrough=$passthrough",
 		  ",genprefix=\"$genprefix\"",
-		  ",order=$Getopt::Long::order",
-		  ",ignorecase=$Getopt::Long::ignorecase",
 		  ".\n")
 	if $debug;
 
@@ -507,10 +607,11 @@ sub GetOptions {
 
     # Verify correctness of optionlist.
     %opctl = ();
+    %bopctl = ();
     while ( @optionlist > 0 ) {
 	my $opt = shift (@optionlist);
 
-	# Strip leading prefix so people can specify "-foo=i" if they like.
+	# Strip leading prefix so people can specify "--foo=i" if they like.
 	$opt = $' if $opt =~ /^($genprefix)+/;
 
 	if ( $opt eq '<>' ) {
@@ -523,35 +624,54 @@ sub GetOptions {
 	    unless ( @optionlist > 0 
 		    && ref($optionlist[0]) && ref($optionlist[0]) eq 'CODE' ) {
 		warn ("Option spec <> requires a reference to a subroutine\n");
-		$Getopt::Long::error++;
+		$error++;
 		next;
 	    }
 	    $linkage{'<>'} = shift (@optionlist);
 	    next;
 	}
 
-	$opt =~ tr/A-Z/a-z/ if $Getopt::Long::ignorecase;
-	if ( $opt !~ /^(\w+[-\w|]*)?(!|[=:][infse]@?)?$/ ) {
+	if ( $opt !~ /^(\w+[-\w|]*)?(!|[=:][infse][@%]?)?$/ ) {
 	    warn ("Error in option spec: \"", $opt, "\"\n");
-	    $Getopt::Long::error++;
+	    $error++;
 	    next;
 	}
 	my ($o, $c, $a) = ($1, $2);
+	$c = '' unless defined $c;
 
 	if ( ! defined $o ) {
 	    # empty -> '-' option
-	    $opctl{$o = ''} = defined $c ? $c : '';
+	    $opctl{$o = ''} = $c;
 	}
 	else {
 	    # Handle alias names
 	    my @o =  split (/\|/, $o);
-	    $o = $o[0];
+	    my $linko = $o = $o[0];
+	    # Force an alias if the option name is not locase.
+	    $a = $o unless $o eq lc($o);
+	    $o = lc ($o)
+		if $ignorecase > 1 
+		    || ($ignorecase
+			&& ($bundling ? length($o) > 1  : 1));
+
 	    foreach ( @o ) {
-		if ( defined $c && $c eq '!' ) {
-		    $opctl{"no$_"} = $c;
-		    $c = '';
+		if ( $bundling && length($_) == 1 ) {
+		    $_ = lc ($_) if $ignorecase > 1;
+		    if ( $c eq '!' ) {
+			$opctl{"no$_"} = $c;
+			warn ("Ignoring '!' modifier for short option $_\n");
+			$c = '';
+		    }
+		    $opctl{$_} = $bopctl{$_} = $c;
+		}
+		else {
+		    $_ = lc ($_) if $ignorecase;
+		    if ( $c eq '!' ) {
+			$opctl{"no$_"} = $c;
+			$c = '';
+		    }
+		    $opctl{$_} = $c;
 		}
-		$opctl{$_} = defined $c ? $c : '';
 		if ( defined $a ) {
 		    # Note alias.
 		    $aliases{$_} = $a;
@@ -561,6 +681,7 @@ sub GetOptions {
 		    $a = $_;
 		}
 	    }
+	    $o = $linko;
 	}
 
 	# If no linkage is supplied in the @optionlist, copy it from
@@ -584,14 +705,26 @@ sub GetOptions {
 	if ( @optionlist > 0 && ref($optionlist[0]) ) {
 	    print STDERR ("=> link \"$o\" to $optionlist[0]\n")
 		if $debug;
-	    if ( ref($optionlist[0]) eq 'SCALAR'
-		|| ref($optionlist[0]) eq 'ARRAY'
-		|| ref($optionlist[0]) eq 'CODE' ) {
+	    if ( ref($optionlist[0]) =~ /^(SCALAR|CODE)$/ ) {
 		$linkage{$o} = shift (@optionlist);
 	    }
+	    elsif ( ref($optionlist[0]) =~ /^(ARRAY)$/ ) {
+		$linkage{$o} = shift (@optionlist);
+		$opctl{$o} .= '@'
+		  if $opctl{$o} ne '' and $opctl{$o} !~ /\@$/;
+		$bopctl{$o} .= '@'
+		  if $bundling and $bopctl{$o} ne '' and $bopctl{$o} !~ /\@$/;
+	    }
+	    elsif ( ref($optionlist[0]) =~ /^(HASH)$/ ) {
+		$linkage{$o} = shift (@optionlist);
+		$opctl{$o} .= '%'
+		  if $opctl{$o} ne '' and $opctl{$o} !~ /\%$/;
+		$bopctl{$o} .= '%'
+		  if $bundling and $bopctl{$o} ne '' and $bopctl{$o} !~ /\%$/;
+	    }
 	    else {
 		warn ("Invalid option linkage for \"", $opt, "\"\n");
-		$Getopt::Long::error++;
+		$error++;
 	    }
 	}
 	else {
@@ -599,11 +732,16 @@ sub GetOptions {
 	    # Make sure a valid perl identifier results.
 	    my $ov = $o;
 	    $ov =~ s/\W/_/g;
-	    if ( $c && $c =~ /@/ ) {
+	    if ( $c =~ /@/ ) {
 		print STDERR ("=> link \"$o\" to \@$pkg","::opt_$ov\n")
 		    if $debug;
 		eval ("\$linkage{\$o} = \\\@".$pkg."::opt_$ov;");
 	    }
+	    elsif ( $c =~ /%/ ) {
+		print STDERR ("=> link \"$o\" to \%$pkg","::opt_$ov\n")
+		    if $debug;
+		eval ("\$linkage{\$o} = \\\%".$pkg."::opt_$ov;");
+	    }
 	    else {
 		print STDERR ("=> link \"$o\" to \$$pkg","::opt_$ov\n")
 		    if $debug;
@@ -613,12 +751,12 @@ sub GetOptions {
     }
 
     # Bail out if errors found.
-    return 0 if $Getopt::Long::error;
+    return 0 if $error;
 
-    # Sort the possible option names.
-    my @opctl = sort(keys (%opctl)) if $Getopt::Long::autoabbrev;
+    # Sort the possible long option names.
+    @opctl = sort(keys (%opctl)) if $autoabbrev;
 
-    # Show if debugging.
+    # Show the options tables if debugging.
     if ( $debug ) {
 	my ($arrow, $k, $v);
 	$arrow = "=> ";
@@ -626,23 +764,21 @@ sub GetOptions {
 	    print STDERR ($arrow, "\$opctl{\"$k\"} = \"$v\"\n");
 	    $arrow = "   ";
 	}
+	$arrow = "=> ";
+	while ( ($k,$v) = each(%bopctl) ) {
+	    print STDERR ($arrow, "\$bopctl{\"$k\"} = \"$v\"\n");
+	    $arrow = "   ";
+	}
     }
 
-    my $opt;			# current option
-    my $arg;			# current option value
-    my $array;			# current option is array typed
-
     # Process argument list
     while ( @ARGV > 0 ) {
 
-	# >>> See also the continue block <<<
-
 	#### Get next argument ####
 
 	$opt = shift (@ARGV);
 	$arg = undef;
-	my $optarg = undef;
-	$array = 0;
+	$array = $hash = 0;
 	print STDERR ("=> option \"", $opt, "\"\n") if $debug;
 
 	#### Determine what we have ####
@@ -651,33 +787,93 @@ sub GetOptions {
 	if ( $opt eq $argend ) {
 	    # Finish. Push back accumulated arguments and return.
 	    unshift (@ARGV, @ret) 
-		if $Getopt::Long::order == $Getopt::Long::PERMUTE;
-	    return ($Getopt::Long::error == 0);
-	}
-
-	if ( $opt =~ /^$genprefix/ ) {
-	    # Looks like an option.
-	    $opt = $';		# option name (w/o prefix)
-	    # If it is a long opt, it may include the value.
-	    if (($& eq "--" || ($Getopt::Long::getopt_compat && $& eq "+"))
-		&& $opt =~ /^([^=]+)=/ ) {
-		$opt = $1;
-		$optarg = $';
-		print STDERR ("=> option \"", $opt, 
-			      "\", optarg = \"$optarg\"\n") if $debug;
-	    }
+		if $order == $PERMUTE;
+	    return ($error == 0);
+	}
 
+	my $tryopt = $opt;
+
+	# find_option operates on the GLOBAL $opt and $arg!
+	if ( &$find_option () ) {
+	    
+	    # find_option undefines $opt in case of errors.
+	    next unless defined $opt;
+
+	    if ( defined $arg ) {
+		$opt = $aliases{$opt} if defined $aliases{$opt};
+
+		if ( defined $linkage{$opt} ) {
+		    print STDERR ("=> ref(\$L{$opt}) -> ",
+				  ref($linkage{$opt}), "\n") if $debug;
+
+		    if ( ref($linkage{$opt}) eq 'SCALAR' ) {
+			print STDERR ("=> \$\$L{$opt} = \"$arg\"\n") if $debug;
+			${$linkage{$opt}} = $arg;
+		    }
+		    elsif ( ref($linkage{$opt}) eq 'ARRAY' ) {
+			print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")
+			    if $debug;
+			push (@{$linkage{$opt}}, $arg);
+		    }
+		    elsif ( ref($linkage{$opt}) eq 'HASH' ) {
+			print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")
+			    if $debug;
+			$linkage{$opt}->{$key} = $arg;
+		    }
+		    elsif ( ref($linkage{$opt}) eq 'CODE' ) {
+			print STDERR ("=> &L{$opt}(\"$opt\", \"$arg\")\n")
+			    if $debug;
+			&{$linkage{$opt}}($opt, $arg);
+		    }
+		    else {
+			print STDERR ("Invalid REF type \"", ref($linkage{$opt}),
+				      "\" in linkage\n");
+			die ("Getopt::Long -- internal error!\n");
+		    }
+		}
+		# No entry in linkage means entry in userlinkage.
+		elsif ( $array ) {
+		    if ( defined $userlinkage->{$opt} ) {
+			print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n")
+			    if $debug;
+			push (@{$userlinkage->{$opt}}, $arg);
+		    }
+		    else {
+			print STDERR ("=>\$L{$opt} = [\"$arg\"]\n")
+			    if $debug;
+			$userlinkage->{$opt} = [$arg];
+		    }
+		}
+		elsif ( $hash ) {
+		    if ( defined $userlinkage->{$opt} ) {
+			print STDERR ("=> \$L{$opt}->{$key} = \"$arg\"\n")
+			    if $debug;
+			$userlinkage->{$opt}->{$key} = $arg;
+		    }
+		    else {
+			print STDERR ("=>\$L{$opt} = {$key => \"$arg\"}\n")
+			    if $debug;
+			$userlinkage->{$opt} = {$key => $arg};
+		    }
+		}
+		else {
+		    print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug;
+		    $userlinkage->{$opt} = $arg;
+		}
+	    }
 	}
 
 	# Not an option. Save it if we $PERMUTE and don't have a <>.
-	elsif ( $Getopt::Long::order == $Getopt::Long::PERMUTE ) {
+	elsif ( $order == $PERMUTE ) {
 	    # Try non-options call-back.
 	    my $cb;
 	    if ( (defined ($cb = $linkage{'<>'})) ) {
-		&$cb($opt);
+		&$cb($tryopt);
 	    }
 	    else {
-		push (@ret, $opt);
+		print STDERR ("=> saving \"$tryopt\" ",
+			      "(not an option, may permute)\n") if $debug;
+		push (@ret, $tryopt);
 	    }
 	    next;
 	}
@@ -685,207 +881,345 @@ sub GetOptions {
 	# ...otherwise, terminate.
 	else {
 	    # Push this one back and exit.
-	    unshift (@ARGV, $opt);
-	    return ($Getopt::Long::error == 0);
+	    unshift (@ARGV, $tryopt);
+	    return ($error == 0);
 	}
 
-	#### Look it up ###
+    }
 
-	$opt =~ tr/A-Z/a-z/ if $Getopt::Long::ignorecase;
+    # Finish.
+    if ( $order == $PERMUTE ) {
+	#  Push back accumulated arguments
+	print STDERR ("=> restoring \"", join('" "', @ret), "\"\n")
+	    if $debug && @ret > 0;
+	unshift (@ARGV, @ret) if @ret > 0;
+    }
 
-	my $tryopt = $opt;
-	if ( $Getopt::Long::autoabbrev ) {
-	    my $pat;
-
-	    # Turn option name into pattern.
-	    ($pat = $opt) =~ s/(\W)/\\$1/g;
-	    # Look up in option names.
-	    my @hits = grep (/^$pat/, @opctl);
-	    print STDERR ("=> ", 0+@hits, " hits (@hits) with \"$pat\" ",
-			  "out of ", 0+@opctl, "\n") if $debug;
-
-	    # Check for ambiguous results.
-	    unless ( (@hits <= 1) || (grep ($_ eq $opt, @hits) == 1) ) {
-		print STDERR ("Option ", $opt, " is ambiguous (",
-			      join(", ", @hits), ")\n");
-		$Getopt::Long::error++;
-		next;
-	    }
+    return ($error == 0);
+}
 
-	    # Complete the option name, if appropriate.
-	    if ( @hits == 1 && $hits[0] ne $opt ) {
-		$tryopt = $hits[0];
-		print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n")
-		    if $debug;
-	    }
+sub config (@) {
+    my (@options) = @_;
+    my $opt;
+    foreach $opt ( @options ) {
+	my $try = lc ($opt);
+	my $action = 1;
+	if ( $try =~ /^no_?/ ) {
+	    $action = 0;
+	    $try = $';
 	}
-
-	my $type;
-	unless  ( defined ( $type = $opctl{$tryopt} ) ) {
-	    print STDERR ("Unknown option: ", $opt, "\n");
-	    $Getopt::Long::error++;
-	    next;
+	if ( $try eq 'default' or $try eq 'defaults' ) {
+	    &$config_defaults () if $action;
 	}
-	$opt = $tryopt;
-	print STDERR ("=> found \"$type\" for ", $opt, "\n") if $debug;
-
-	#### Determine argument status ####
-
-	# If it is an option w/o argument, we're almost finished with it.
-	if ( $type eq '' || $type eq '!' ) {
-	    if ( defined $optarg ) {
-		print STDERR ("Option ", $opt, " does not take an argument\n");
-		$Getopt::Long::error++;
-	    }
-	    elsif ( $type eq '' ) {
-		$arg = 1;		# supply explicit value
-	    }
-	    else {
-		substr ($opt, 0, 2) = ''; # strip NO prefix
-		$arg = 0;		# supply explicit value
-	    }
-	    next;
+	elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) {
+	    $autoabbrev = $action;
+	}
+	elsif ( $try eq 'getopt_compat' ) {
+	    $getopt_compat = $action;
 	}
+	elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
+	    $ignorecase = $action;
+	}
+	elsif ( $try eq 'ignore_case_always' ) {
+	    $ignorecase = $action ? 2 : 0;
+	}
+	elsif ( $try eq 'bundling' ) {
+	    $bundling = $action;
+	}
+	elsif ( $try eq 'bundling_override' ) {
+	    $bundling = $action ? 2 : 0;
+	}
+	elsif ( $try eq 'require_order' ) {
+	    $order = $action ? $REQUIRE_ORDER : $PERMUTE;
+	}
+	elsif ( $try eq 'permute' ) {
+	    $order = $action ? $PERMUTE : $REQUIRE_ORDER;
+	}
+	elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) {
+	    $passthrough = $action;
+	}
+	elsif ( $try eq 'debug' ) {
+	    $debug = $action;
+	}
+	else {
+	    $Carp::CarpLevel = 1;
+	    Carp::croak("Getopt::Long: unknown config parameter \"$opt\"")
+	}
+    }
+}
 
-	# Get mandatory status and type info.
-	my $mand;
-	($mand, $type, $array) = $type =~ /^(.)(.)(@?)$/;
+# Modified from Exporter. This one handles 2.001 and 2.01 etc just like 2.1.
+sub require_version {
+    no strict;
+    my ($self, $wanted) = @_;
+    my $pkg = ref $self || $self;
+    my $version = $ {"${pkg}::VERSION"} || "(undef)";
+
+    $wanted .= '.0' unless $wanted =~ /\./;
+    $wanted = $1 * 1000 + $2 if $wanted =~ /^(\d+)\.(\d+)$/;
+    $version = $1 * 1000 + $2 if $version =~ /^(\d+)\.(\d+)$/;
+    if ( $version < $wanted ) {
+	$version =~ s/^(\d+)(\d\d\d)$/$1.'.'.(0+$2)/e;
+	$wanted =~ s/^(\d+)(\d\d\d)$/$1.'.'.(0+$2)/e;
+	$Carp::CarpLevel = 1;
+	Carp::croak("$pkg $wanted required--this is only version $version")
+    }
+    $version;
+}
 
-	# Check if there is an option argument available.
-	if ( defined $optarg ? ($optarg eq '') : (@ARGV <= 0) ) {
+################ Private Subroutines ################
 
-	    # Complain if this option needs an argument.
-	    if ( $mand eq "=" ) {
-		print STDERR ("Option ", $opt, " requires an argument\n");
-		$Getopt::Long::error++;
-	    }
-	    if ( $mand eq ":" ) {
-		$arg = $type eq "s" ? '' : 0;
-	    }
-	    next;
-	}
+$find_option = sub {
 
-	# Get (possibly optional) argument.
-	$arg = defined $optarg ? $optarg : shift (@ARGV);
+    return 0 unless $opt =~ /^$genprefix/;
 
-	#### Check if the argument is valid for this option ####
+    $opt = $';
+    my ($starter) = $&;
 
-	if ( $type eq "s" ) {	# string
-	    # A mandatory string takes anything. 
-	    next if $mand eq "=";
+    my $optarg = undef;	# value supplied with --opt=value
+    my $rest = undef;	# remainder from unbundling
 
-	    # An optional string takes almost anything. 
-	    next if defined $optarg;
-	    next if $arg eq "-";
+    # If it is a long option, it may include the value.
+    if (($starter eq "--" || $getopt_compat)
+	&& $opt =~ /^([^=]+)=/ ) {
+	$opt = $1;
+	$optarg = $';
+	print STDERR ("=> option \"", $opt, 
+		      "\", optarg = \"$optarg\"\n") if $debug;
+    }
 
-	    # Check for option or option list terminator.
-	    if ($arg eq $argend ||
-		$arg =~ /^$genprefix.+/) {
-		# Push back.
-		unshift (@ARGV, $arg);
-		# Supply empty value.
-		$arg = '';
+    #### Look it up ###
+
+    my $tryopt = $opt;		# option to try
+    my $optbl = \%opctl;	# table to look it up (long names)
+    my $type;
+
+    if ( $bundling && $starter eq '-' ) {
+	# Unbundle single letter option.
+	$rest = substr ($tryopt, 1);
+	$tryopt = substr ($tryopt, 0, 1);
+	$tryopt = lc ($tryopt) if $ignorecase > 1;
+	print STDERR ("=> $starter$tryopt unbundled from ",
+		      "$starter$tryopt$rest\n") if $debug;
+	$rest = undef unless $rest ne '';
+	$optbl = \%bopctl;	# look it up in the short names table
+
+	# If bundling == 2, long options can override bundles.
+	if ( $bundling == 2 and
+	     defined ($type = $opctl{$tryopt.$rest}) ) {
+	    print STDERR ("=> $starter$tryopt rebundled to ",
+			  "$starter$tryopt$rest\n") if $debug;
+	    $tryopt .= $rest;
+	    undef $rest;
+	}
+    } 
+
+    # Try auto-abbreviation.
+    elsif ( $autoabbrev ) {
+	# Downcase if allowed.
+	$tryopt = $opt = lc ($opt) if $ignorecase;
+	# Turn option name into pattern.
+	my $pat = quotemeta ($opt);
+	# Look up in option names.
+	my @hits = grep (/^$pat/, @opctl);
+	print STDERR ("=> ", scalar(@hits), " hits (@hits) with \"$pat\" ",
+		      "out of ", scalar(@opctl), "\n") if $debug;
+
+	# Check for ambiguous results.
+	unless ( (@hits <= 1) || (grep ($_ eq $opt, @hits) == 1) ) {
+	    # See if all matches are for the same option.
+	    my %hit;
+	    foreach ( @hits ) {
+		$_ = $aliases{$_} if defined $aliases{$_};
+		$hit{$_} = 1;
 	    }
-	    next;
+	    # Now see if it really is ambiguous.
+	    unless ( keys(%hit) == 1 ) {
+		return 0 if $passthrough;
+		print STDERR ("Option ", $opt, " is ambiguous (",
+			      join(", ", @hits), ")\n");
+		$error++;
+		undef $opt;
+		return 1;
+	    }
+	    @hits = keys(%hit);
 	}
 
-	if ( $type eq "n" || $type eq "i" ) { # numeric/integer
-	    if ( $arg !~ /^-?[0-9]+$/ ) {
-		if ( defined $optarg || $mand eq "=" ) {
-		    print STDERR ("Value \"", $arg, "\" invalid for option ",
-				  $opt, " (number expected)\n");
-		    $Getopt::Long::error++;
-		    undef $arg;	# don't assign it
-		}
-		else {
-		    # Push back.
-		    unshift (@ARGV, $arg);
-		    # Supply default value.
-		    $arg = 0;
-		}
-	    }
-	    next;
+	# Complete the option name, if appropriate.
+	if ( @hits == 1 && $hits[0] ne $opt ) {
+	    $tryopt = $hits[0];
+	    $tryopt = lc ($tryopt) if $ignorecase;
+	    print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n")
+		if $debug;
 	}
+    }
 
-	if ( $type eq "f" ) { # fixed real number, int is also ok
-	    if ( $arg !~ /^-?[0-9.]+$/ ) {
-		if ( defined $optarg || $mand eq "=" ) {
-		    print STDERR ("Value \"", $arg, "\" invalid for option ",
-				  $opt, " (real number expected)\n");
-		    $Getopt::Long::error++;
-		    undef $arg;	# don't assign it
-		}
-		else {
-		    # Push back.
-		    unshift (@ARGV, $arg);
-		    # Supply default value.
-		    $arg = 0.0;
-		}
-	    }
-	    next;
+    # Map to all lowercase if ignoring case.
+    elsif ( $ignorecase ) {
+	$tryopt = lc ($opt);
+    }
+
+    # Check validity by fetching the info.
+    $type = $optbl->{$tryopt} unless defined $type;
+    unless  ( defined $type ) {
+	return 0 if $passthrough;
+	warn ("Unknown option: ", $opt, "\n");
+	$error++;
+	return 1;
+    }
+    # Apparently valid.
+    $opt = $tryopt;
+    print STDERR ("=> found \"$type\" for ", $opt, "\n") if $debug;
+
+    #### Determine argument status ####
+
+    # If it is an option w/o argument, we're almost finished with it.
+    if ( $type eq '' || $type eq '!' ) {
+	if ( defined $optarg ) {
+	    return 0 if $passthrough;
+	    print STDERR ("Option ", $opt, " does not take an argument\n");
+	    $error++;
+	    undef $opt;
+	}
+	elsif ( $type eq '' ) {
+	    $arg = 1;		# supply explicit value
 	}
+	else {
+	    substr ($opt, 0, 2) = ''; # strip NO prefix
+	    $arg = 0;		# supply explicit value
+	}
+	unshift (@ARGV, $starter.$rest) if defined $rest;
+	return 1;
+    }
 
-	die ("GetOpt::Long internal error (Can't happen)\n");
+    # Get mandatory status and type info.
+    my $mand;
+    ($mand, $type, $array, $hash) = $type =~ /^(.)(.)(@?)(%?)$/;
+
+    # Check if there is an option argument available.
+    if ( defined $optarg ? ($optarg eq '') 
+	 : !(defined $rest || @ARGV > 0) ) {
+	# Complain if this option needs an argument.
+	if ( $mand eq "=" ) {
+	    return 0 if $passthrough;
+	    print STDERR ("Option ", $opt, " requires an argument\n");
+	    $error++;
+	    undef $opt;
+	}
+	if ( $mand eq ":" ) {
+	    $arg = $type eq "s" ? '' : 0;
+	}
+	return 1;
     }
 
-    continue {
-	if ( defined $arg ) {
-	    $opt = $aliases{$opt} if defined $aliases{$opt};
+    # Get (possibly optional) argument.
+    $arg = (defined $rest ? $rest
+	    : (defined $optarg ? $optarg : shift (@ARGV)));
 
-	    if ( defined $linkage{$opt} ) {
-		print STDERR ("=> ref(\$L{$opt}) -> ",
-			      ref($linkage{$opt}), "\n") if $debug;
+    # Get key if this is a "name=value" pair for a hash option.
+    $key = undef;
+    if ($hash && defined $arg) {
+	($key, $arg) = ($arg =~ /=/o) ? ($`, $') : ($arg, 1);
+    }
 
-		if ( ref($linkage{$opt}) eq 'SCALAR' ) {
-		    print STDERR ("=> \$\$L{$opt} = \"$arg\"\n") if $debug;
-		    ${$linkage{$opt}} = $arg;
-		}
-		elsif ( ref($linkage{$opt}) eq 'ARRAY' ) {
-		    print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")
-			if $debug;
-		    push (@{$linkage{$opt}}, $arg);
-		}
-		elsif ( ref($linkage{$opt}) eq 'CODE' ) {
-		    print STDERR ("=> &L{$opt}(\"$opt\", \"$arg\")\n")
-			if $debug;
-		    &{$linkage{$opt}}($opt, $arg);
-		}
-		else {
-		    print STDERR ("Invalid REF type \"", ref($linkage{$opt}),
-				  "\" in linkage\n");
-		    die ("Getopt::Long -- internal error!\n");
-		}
-	    }
-	    # No entry in linkage means entry in userlinkage.
-	    elsif ( $array ) {
-		if ( defined $userlinkage->{$opt} ) {
-		    print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n")
-			if $debug;
-		    push (@{$userlinkage->{$opt}}, $arg);
-		}
-		else {
-		    print STDERR ("=>\$L{$opt} = [\"$arg\"]\n")
-			if $debug;
-		    $userlinkage->{$opt} = [$arg];
-		}
+    #### Check if the argument is valid for this option ####
+
+    if ( $type eq "s" ) {	# string
+	# A mandatory string takes anything. 
+	return 1 if $mand eq "=";
+
+	# An optional string takes almost anything. 
+	return 1 if defined $optarg || defined $rest;
+	return 1 if $arg eq "-"; # ??
+
+	# Check for option or option list terminator.
+	if ($arg eq $argend ||
+	    $arg =~ /^$genprefix.+/) {
+	    # Push back.
+	    unshift (@ARGV, $arg);
+	    # Supply empty value.
+	    $arg = '';
+	}
+    }
+
+    elsif ( $type eq "n" || $type eq "i" ) { # numeric/integer
+	if ( $arg !~ /^-?[0-9]+$/ ) {
+	    if ( defined $optarg || $mand eq "=" ) {
+		return 0 if $passthrough;
+		print STDERR ("Value \"", $arg, "\" invalid for option ",
+			      $opt, " (number expected)\n");
+		$error++;
+		undef $opt;
+		# Push back.
+		unshift (@ARGV, $starter.$rest) if defined $rest;
 	    }
 	    else {
-		print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug;
-		$userlinkage->{$opt} = $arg;
+		# Push back.
+		unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
+		# Supply default value.
+		$arg = 0;
 	    }
 	}
     }
 
-    # Finish.
-    if ( $Getopt::Long::order == $Getopt::Long::PERMUTE ) {
-	#  Push back accumulated arguments
-	unshift (@ARGV, @ret) if @ret > 0;
+    elsif ( $type eq "f" ) { # real number, int is also ok
+	if ( $arg !~ /^-?[0-9.]+([eE]-?[0-9]+)?$/ ) {
+	    if ( defined $optarg || $mand eq "=" ) {
+		return 0 if  $passthrough;
+		print STDERR ("Value \"", $arg, "\" invalid for option ",
+			      $opt, " (real number expected)\n");
+		$error++;
+		undef $opt;
+		# Push back.
+		unshift (@ARGV, $starter.$rest) if defined $rest;
+	    }
+	    else {
+		# Push back.
+		unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
+		# Supply default value.
+		$arg = 0.0;
+	    }
+	}
+    }
+    else {
+	die ("GetOpt::Long internal error (Can't happen)\n");
     }
+    return 1;
+};
+
+$config_defaults = sub {
+    # Handle POSIX compliancy.
+    if ( defined $ENV{"POSIXLY_CORRECT"} ) {
+	$gen_prefix = "(--|-)";
+	$autoabbrev = 0;		# no automatic abbrev of options
+	$bundling = 0;			# no bundling of single letter switches
+	$getopt_compat = 0;		# disallow '+' to start options
+	$order = $REQUIRE_ORDER;
+    }
+    else {
+	$gen_prefix = "(--|-|\\+)";
+	$autoabbrev = 1;		# automatic abbrev of options
+	$bundling = 0;			# bundling off by default
+	$getopt_compat = 1;		# allow '+' to start options
+	$order = $PERMUTE;
+    }
+    # Other configurable settings.
+    $debug = 0;			# for debugging
+    $error = 0;			# error tally
+    $ignorecase = 1;		# ignore case when matching options
+    $passthrough = 0;		# leave unrecognized options alone
+};
 
-    return ($Getopt::Long::error == 0);
-}
+################ Initialization ################
+
+# Values for $order. See GNU getopt.c for details.
+($REQUIRE_ORDER, $PERMUTE, $RETURN_IN_ORDER) = (0..2);
+# Version major/minor numbers.
+($major_version, $minor_version) = $VERSION =~ /^(\d+)\.(\d+)/;
+
+# Set defaults.
+&$config_defaults ();
 
 ################ Package return ################
 
-# Returning 1 is so boring...
-$Getopt::Long::major_version * 1000 + $Getopt::Long::minor_version;
+1;
diff --git a/lib/Getopt/Std.pm b/lib/Getopt/Std.pm
index 4117ca7f8b..fee0d33e8f 100644
--- a/lib/Getopt/Std.pm
+++ b/lib/Getopt/Std.pm
@@ -11,9 +11,12 @@ getopts - Process single-character switches with switch clustering
 =head1 SYNOPSIS
 
     use Getopt::Std;
-    getopt('oDI');  # -o, -D & -I take arg.  Sets opt_* as a side effect.
+
+    getopt('oDI');    # -o, -D & -I take arg.  Sets opt_* as a side effect.
+    getopt('oDI', \%opts);    # -o, -D & -I take arg.  Values in %opts
     getopts('oif:');  # -o & -i are boolean flags, -f takes an argument
 		      # Sets opt_* as a side effect.
+    getopts('oif:', \%opts);  # options as above. Values in %opts
 
 =head1 DESCRIPTION
 
@@ -24,6 +27,11 @@ switch name) to the value of the argument, or 1 if no argument.  Switches
 which take an argument don't care whether there is a space between the
 switch and the argument.
 
+For those of you who don't like additional variables being created, getopt()
+and getopts() will also accept a hash reference as an optional second argument. 
+Hash keys will be x (where x is the switch name) with key values the value of
+the argument or 1 if no argument is specified.
+
 =cut
 
 @ISA = qw(Exporter);
@@ -40,8 +48,8 @@ switch and the argument.
 # Usage:
 #	getopt('oDI');  # -o, -D & -I take arg.  Sets opt_* as a side effect.
 
-sub getopt {
-    local($argumentative) = @_;
+sub getopt ($;$) {
+    local($argumentative, $hash) = @_;
     local($_,$first,$rest);
     local $Exporter::ExportLevel;
 
@@ -55,12 +63,22 @@ sub getopt {
 		shift(@ARGV);
 		$rest = shift(@ARGV);
 	    }
-	    eval "\$opt_$first = \$rest;";
-	    push( @EXPORT, "\$opt_$first" );
+          if (ref $hash) {
+              $$hash{$first} = $rest;
+          }
+          else {
+              eval "\$opt_$first = \$rest;";
+              push( @EXPORT, "\$opt_$first" );
+          }
 	}
 	else {
-	    eval "\$opt_$first = 1;";
-	    push( @EXPORT, "\$opt_$first" );
+          if (ref $hash) {
+              $$hash{$first} = 1;
+          }
+          else {
+              eval "\$opt_$first = 1;";
+              push( @EXPORT, "\$opt_$first" );
+          }
 	    if ($rest ne '') {
 		$ARGV[0] = "-$rest";
 	    }
@@ -77,8 +95,8 @@ sub getopt {
 #   getopts('a:bc');	# -a takes arg. -b & -c not. Sets opt_* as a
 #			#  side effect.
 
-sub getopts {
-    local($argumentative) = @_;
+sub getopts ($;$) {
+    local($argumentative, $hash) = @_;
     local(@args,$_,$first,$rest);
     local($errs) = 0;
     local $Exporter::ExportLevel;
@@ -94,12 +112,22 @@ sub getopts {
 		    ++$errs unless @ARGV;
 		    $rest = shift(@ARGV);
 		}
-		eval "\$opt_$first = \$rest;";
-		push( @EXPORT, "\$opt_$first" );
+              if (ref $hash) {
+                  $$hash{$first} = $rest;
+              }
+              else {
+                  eval "\$opt_$first = \$rest;";
+                  push( @EXPORT, "\$opt_$first" );
+              }
 	    }
 	    else {
-		eval "\$opt_$first = 1";
-		push( @EXPORT, "\$opt_$first" );
+              if (ref $hash) {
+                  $$hash{$first} = 1;
+              }
+              else {
+                  eval "\$opt_$first = 1";
+                  push( @EXPORT, "\$opt_$first" );
+              }
 		if($rest eq '') {
 		    shift(@ARGV);
 		}
diff --git a/lib/I18N/Collate.pm b/lib/I18N/Collate.pm
index 0d8314e12e..6961dc2f1c 100644
--- a/lib/I18N/Collate.pm
+++ b/lib/I18N/Collate.pm
@@ -1,3 +1,8 @@
+#-----------------------------------------------------------------------#
+# NOTE! This module is deprecated (obsolete) after the Perl release     #
+# 5.003_06 as the functionality has been integrated into the Perl core. #
+#-----------------------------------------------------------------------#
+
 package I18N::Collate;
 
 =head1 NAME
@@ -23,30 +28,29 @@ You can compare $s1 and $s2 above with
 
 to extract the data itself, you'll need a dereference: $$s1
 
-This uses POSIX::setlocale(). The basic collation conversion is done by
-strxfrm() which terminates at NUL characters being a decent C routine.
-collate_xfrm() handles embedded NUL characters gracefully.  Due to C<cmp>
-and overload magic, C<lt>, C<le>, C<eq>, C<ge>, and C<gt> work also.  The
-available locales depend on your operating system; try whether C<locale
--a> shows them or man pages for "locale" or "nlsinfo" or
-the direct approach C<ls /usr/lib/nls/loc> or C<ls
-/usr/lib/nls>.  Not all the locales that your vendor supports
-are necessarily installed: please consult your operating system's
-documentation and possibly your local system administration.
+This module uses POSIX::setlocale(). The basic collation conversion is
+done by strxfrm() which terminates at NUL characters being a decent C
+routine.  collate_xfrm() handles embedded NUL characters gracefully.
 
-The locale names are probably something like
-C<"xx_XX.(ISO)?8859-N"> or C<"xx_XX.(ISO)?8859N">, for example
-C<"fr_CH.ISO8859-1"> is the Swiss (CH) variant of French (fr),
-ISO Latin (8859) 1 (-1) which is the Western European character set.
+The available locales depend on your operating system; try whether
+C<locale -a> shows them or man pages for "locale" or "nlsinfo" or the
+direct approach C<ls /usr/lib/nls/loc> or C<ls /usr/lib/nls> or
+C<ls /usr/lib/locale>.  Not all the locales that your vendor supports
+are necessarily installed: please consult your operating system's
+documentation and possibly your local system administration.  The
+locale names are probably something like C<xx_XX.(ISO)?8859-N> or
+C<xx_XX.(ISO)?8859N>, for example C<fr_CH.ISO8859-1> is the Swiss (CH)
+variant of French (fr), ISO Latin (8859) 1 (-1) which is the Western
+European character set.
 
 =cut
 
 # I18N::Collate.pm
 #
-# Author:	Jarkko Hietaniemi <Jarkko.Hietaniemi@hut.fi>
+# Author:	Jarkko Hietaniemi <F<jhi@iki.fi>>
 #		Helsinki University of Technology, Finland
 #
-# Acks:		Guy Decoux <decoux@moulon.inra.fr> understood
+# Acks:		Guy Decoux <F<decoux@moulon.inra.fr>> understood
 #		overloading magic much deeper than I and told
 #		how to cut the size of this code by more than half.
 #		(my first version did overload all of lt gt eq le ge cmp)
@@ -87,7 +91,7 @@ ISO Latin (8859) 1 (-1) which is the Western European character set.
 #		   variant of French (fr), ISO Latin (8859) 1 (-1)
 #		   which is the Western European character set.
 #
-# Updated:	19960104 1946 GMT
+# Updated:	19961005
 #
 # ---
 
@@ -104,7 +108,33 @@ fallback	1
 cmp		collate_cmp
 );
 
-sub new { my $new = $_[1]; bless \$new }
+sub new {
+  my $new = $_[1];
+
+  if ($^W && $] >= 5.003_06) {
+    unless ($please_use_I18N_Collate_even_if_deprecated) {
+      warn <<___EOD___;
+***
+
+  WARNING: starting from the Perl version 5.003_06 the I18N::Collate
+  interface for comparing 8-bit scalar data according to the current locale
+
+	HAS BEEN DEPRECATED
+
+  (that is, please do not use it anymore for any new applications and please
+  migrate the old applications away from it) because its functionality was
+  integrated into the Perl core language in the release 5.003_06.
+
+  See pod/perllocale.pod for further information.
+
+***
+___EOD___
+      $please_use_I18N_Collate_even_if_deprecated++;
+    }
+  }
+
+  bless \$new;
+}
 
 sub setlocale {
  my ($category, $locale) = @_[0,1];
diff --git a/lib/IPC/Open2.pm b/lib/IPC/Open2.pm
index 243412ef09..32282d62b3 100644
--- a/lib/IPC/Open2.pm
+++ b/lib/IPC/Open2.pm
@@ -1,7 +1,14 @@
 package IPC::Open2;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT);
+
 require 5.000;
 require Exporter;
-use Carp;
+
+$VERSION	= 1.01;
+@ISA		= qw(Exporter);
+@EXPORT		= qw(open2);
 
 =head1 NAME
 
@@ -20,7 +27,16 @@ The open2() function spawns the given $cmd and connects $rdr for
 reading and $wtr for writing.  It's what you think should work 
 when you try
 
-    open(HANDLE, "|cmd args");
+    open(HANDLE, "|cmd args|");
+
+The write filehandle will have autoflush turned on.
+
+If $rdr is a string (that is, a bareword filehandle rather than a glob
+or a reference) and it begins with ">&", then the child will send output
+directly to that file handle.  If $wtr is a string that begins with
+"<&", then WTR will be closed in the parent, and the child will read
+from it directly.  In both cases, there will be a dup(2) instead of a
+pipe(2) made.
 
 open2() returns the process ID of the child process.  It doesn't return on
 failure: it just raises an exception matching C</^open2:/>.
@@ -38,19 +54,17 @@ a time.  Programs like B<sort> that read their entire input stream first,
 however, are quite apt to cause deadlock.  
 
 The big problem with this approach is that if you don't have control 
-over source code being run in the the child process, you can't control what it does 
-with pipe buffering.  Thus you can't just open a pipe to C<cat -v> and continually
-read and write a line from it.
+over source code being run in the child process, you can't control
+what it does with pipe buffering.  Thus you can't just open a pipe to
+C<cat -v> and continually read and write a line from it.
 
 =head1 SEE ALSO
 
-See L<open3> for an alternative that handles STDERR as well.
+See L<IPC::Open3> for an alternative that handles STDERR as well.  This
+function is really just a wrapper around open3().
 
 =cut
 
-@ISA = qw(Exporter);
-@EXPORT = qw(open2);
-
 # &open2: tom christiansen, <tchrist@convex.com>
 #
 # usage: $pid = open2('rdr', 'wtr', 'some cmd and args');
@@ -67,41 +81,15 @@ See L<open3> for an alternative that handles STDERR as well.
 # 
 # abort program if
 #	rdr or wtr are null
-# 	pipe or fork or exec fails
+# 	a system call fails
 
-$fh = 'FHOPEN000';  # package static in case called more than once
+require IPC::Open3;
 
 sub open2 {
-    local($kidpid);
-    local($dad_rdr, $dad_wtr, @cmd) = @_;
-
-    $dad_rdr ne '' 		|| croak "open2: rdr should not be null";
-    $dad_wtr ne '' 		|| croak "open2: wtr should not be null";
-
-    # force unqualified filehandles into callers' package
-    local($package) = caller;
-    $dad_rdr =~ s/^[^']+$/$package'$&/ unless ref $dad_rdr;
-    $dad_wtr =~ s/^[^']+$/$package'$&/ unless ref $dad_wtr;
-
-    local($kid_rdr) = ++$fh;
-    local($kid_wtr) = ++$fh;
-
-    pipe($dad_rdr, $kid_wtr) 	|| croak "open2: pipe 1 failed: $!";
-    pipe($kid_rdr, $dad_wtr) 	|| croak "open2: pipe 2 failed: $!";
-
-    if (($kidpid = fork) < 0) {
-	croak "open2: fork failed: $!";
-    } elsif ($kidpid == 0) {
-	close $dad_rdr; close $dad_wtr;
-	open(STDIN,  "<&$kid_rdr");
-	open(STDOUT, ">&$kid_wtr");
-	warn "execing @cmd\n" if $debug;
-	exec @cmd
-	    or croak "open2: exec of @cmd failed";   
-    } 
-    close $kid_rdr; close $kid_wtr;
-    select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe
-    $kidpid;
+    my ($read, $write, @cmd) = @_;
+    local $Carp::CarpLevel = $Carp::CarpLevel + 1;
+    return IPC::Open3::_open3('open2', scalar caller,
+				$write, $read, '>&STDERR', @cmd);
 }
-1; # so require is happy
 
+1
diff --git a/lib/IPC/Open3.pm b/lib/IPC/Open3.pm
index dbf5562028..43caa03763 100644
--- a/lib/IPC/Open3.pm
+++ b/lib/IPC/Open3.pm
@@ -1,7 +1,18 @@
 package IPC::Open3;
+
+use strict;
+no strict 'refs'; # because users pass me bareword filehandles
+use vars qw($VERSION @ISA @EXPORT $Fh $Me);
+
 require 5.001;
 require Exporter;
+
 use Carp;
+use Symbol 'qualify';
+
+$VERSION	= 1.0101;
+@ISA		= qw(Exporter);
+@EXPORT		= qw(open3);
 
 =head1 NAME
 
@@ -9,7 +20,7 @@ IPC::Open3, open3 - open a process for reading, writing, and error handling
 
 =head1 SYNOPSIS
 
-    $pid = open3(\*WTRFH, \*RDRFH, \*ERRFH 
+    $pid = open3(\*WTRFH, \*RDRFH, \*ERRFH
 		    'some cmd and args', 'optarg', ...);
 
 =head1 DESCRIPTION
@@ -17,24 +28,40 @@ IPC::Open3, open3 - open a process for reading, writing, and error handling
 Extremely similar to open2(), open3() spawns the given $cmd and
 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.
+on the same file handle.  The WTRFH will have autoflush turned on.
 
-If WTRFH begins with "<&", then WTRFH will be closed in the parent, and
+If WTRFH begins with "E<lt>&", 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.
+"E<gt>&", 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.
 
 If you try to read from the child's stdout writer and their stderr
 writer, you'll have problems with blocking, which means you'll
 want to use select(), which means you'll have to use sysread() instead
 of normal stuff.
 
-All caveats from open2() continue to apply.  See L<open2> for details.
+open3() returns the process ID of the child process.  It doesn't return on
+failure: it just raises an exception matching C</^open3:/>.
 
-=cut
+=head1 WARNING
+
+It will not create these file handles for you.  You have to do this
+yourself.  So don't pass it empty variables expecting them to get filled
+in for you.
+
+Additionally, this is very dangerous as you may block forever.  It
+assumes it's going to talk to something like B<bc>, both writing to it
+and reading from it.  This is presumably safe because you "know" that
+commands like B<bc> will read a line at a time and output a line at a
+time.  Programs like B<sort> that read their entire input stream first,
+however, are quite apt to cause deadlock.
 
-@ISA = qw(Exporter);
-@EXPORT = qw(open3);
+The big problem with this approach is that if you don't have control
+over source code being run in the child process, you can't control
+what it does with pipe buffering.  Thus you can't just open a pipe to
+C<cat -v> and continually read and write a line from it.
+
+=cut
 
 # &open3: Marc Horowitz <marc@mit.edu>
 # derived mostly from &open2 by tom christiansen, <tchrist@convex.com>
@@ -48,7 +75,7 @@ All caveats from open2() continue to apply.  See L<open2> for details.
 # reading, wtr for writing, and err for errors.
 # if err is '', or the same as rdr, then stdout and
 # stderr of the child are on the same fh.  returns pid
-# of child, or 0 on failure.
+# of child (or dies on failure).
 
 
 # if wtr begins with '<&', then wtr will be closed in the parent, and
@@ -64,17 +91,43 @@ All caveats from open2() continue to apply.  See L<open2> for details.
 #
 # abort program if
 #   rdr or wtr are null
-#   pipe or fork or exec fails
+#   a system call fails
 
-$fh = 'FHOPEN000';  # package static in case called more than once
+$Fh = 'FHOPEN000';	# package static in case called more than once
+$Me = 'open3 (bug)';	# you should never see this, it's always localized
 
-sub open3 {
-    my($kidpid);
-    my($dad_wtr, $dad_rdr, $dad_err, @cmd) = @_;
-    my($dup_wtr, $dup_rdr, $dup_err);
+# Fatal.pm needs to be fixed WRT prototypes.
+
+sub xfork {
+    my $pid = fork;
+    defined $pid or croak "$Me: fork failed: $!";
+    return $pid;
+}
+
+sub xpipe {
+    pipe $_[0], $_[1] or croak "$Me: pipe($_[0], $_[1]) failed: $!";
+}
 
-    $dad_wtr			|| croak "open3: wtr should not be null";
-    $dad_rdr			|| croak "open3: rdr should not be null";
+# I tried using a * prototype character for the filehandle but it still
+# disallows a bearword while compiling under strict subs.
+
+sub xopen {
+    open $_[0], $_[1] or croak "$Me: open($_[0], $_[1]) failed: $!";
+}
+
+sub xclose {
+    close $_[0] or croak "$Me: close($_[0]) failed: $!";
+}
+
+my $do_spawn = $^O eq 'os2';
+
+sub _open3 {
+    local $Me = shift;
+    my($package, $dad_wtr, $dad_rdr, $dad_err, @cmd) = @_;
+    my($dup_wtr, $dup_rdr, $dup_err, $kidpid);
+
+    $dad_wtr			or croak "$Me: wtr should not be null";
+    $dad_rdr			or croak "$Me: rdr should not be null";
     $dad_err = $dad_rdr if ($dad_err eq '');
 
     $dup_wtr = ($dad_wtr =~ s/^[<>]&//);
@@ -82,63 +135,155 @@ sub open3 {
     $dup_err = ($dad_err =~ s/^[<>]&//);
 
     # force unqualified filehandles into callers' package
-    my($package) = caller;
-    $dad_wtr =~ s/^[^:]+$/$package\:\:$&/ unless ref $dad_wtr;
-    $dad_rdr =~ s/^[^:]+$/$package\:\:$&/ unless ref $dad_rdr;
-    $dad_err =~ s/^[^:]+$/$package\:\:$&/ unless ref $dad_err;
+    $dad_wtr = qualify $dad_wtr, $package;
+    $dad_rdr = qualify $dad_rdr, $package;
+    $dad_err = qualify $dad_err, $package;
 
-    my($kid_rdr) = ++$fh;
-    my($kid_wtr) = ++$fh;
-    my($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: $!";
-    }
-    if (!$dup_rdr) {
-	pipe($dad_rdr, $kid_wtr)    || croak "open3: pipe 2 (stdout) failed: $!";
-    }
-    if ($dad_err ne $dad_rdr && !$dup_err) {
-	pipe($dad_err, $kid_err)    || croak "open3: pipe 3 (stderr) failed: $!";
-    }
+    xpipe $kid_rdr, $dad_wtr if !$dup_wtr;
+    xpipe $dad_rdr, $kid_wtr if !$dup_rdr;
+    xpipe $dad_err, $kid_err if !$dup_err && $dad_err ne $dad_rdr;
+
+    $kidpid = $do_spawn ? -1 : xfork;
+    if ($kidpid == 0) {		# Kid
+	# If she wants to dup the kid's stderr onto her stdout I need to
+	# save a copy of her stdout before I put something else there.
+	if ($dad_rdr ne $dad_err && $dup_err
+		&& fileno($dad_err) == fileno(STDOUT)) {
+	    my $tmp = ++$Fh;
+	    xopen($tmp, ">&$dad_err");
+	    $dad_err = $tmp;
+	}
 
-    if (($kidpid = fork) < 0) {
-        croak "open3: fork failed: $!";
-    } elsif ($kidpid == 0) {
 	if ($dup_wtr) {
-	    open(STDIN,  "<&$dad_wtr") if (fileno(STDIN) != fileno($dad_wtr));
+	    xopen \*STDIN,  "<&$dad_wtr" if fileno(STDIN) != fileno($dad_wtr);
 	} else {
-	    close($dad_wtr);
-	    open(STDIN,  "<&$kid_rdr");
+	    xclose $dad_wtr;
+	    xopen \*STDIN,  "<&$kid_rdr";
+	    xclose $kid_rdr;
 	}
 	if ($dup_rdr) {
-	    open(STDOUT, ">&$dad_rdr") if (fileno(STDOUT) != fileno($dad_rdr));
+	    xopen \*STDOUT, ">&$dad_rdr" if fileno(STDOUT) != fileno($dad_rdr);
 	} else {
-	    close($dad_rdr);
-	    open(STDOUT, ">&$kid_wtr");
+	    xclose $dad_rdr;
+	    xopen \*STDOUT, ">&$kid_wtr";
+	    xclose $kid_wtr;
 	}
 	if ($dad_rdr ne $dad_err) {
 	    if ($dup_err) {
-		open(STDERR, ">&$dad_err")
-		    if (fileno(STDERR) != fileno($dad_err));
+		xopen \*STDERR, ">&$dad_err"
+		    if fileno(STDERR) != fileno($dad_err);
 	    } else {
-		close($dad_err);
-		open(STDERR, ">&$kid_err");
+		xclose $dad_err;
+		xopen \*STDERR, ">&$kid_err";
+		xclose $kid_err;
 	    }
 	} else {
-	    open(STDERR, ">&STDOUT") if (fileno(STDERR) != fileno(STDOUT));
+	    xopen \*STDERR, ">&STDOUT" if fileno(STDERR) != fileno(STDOUT);
 	}
 	local($")=(" ");
 	exec @cmd
 	    or croak "open3: exec of @cmd failed";
-    }
+    } elsif ($do_spawn) {
+	# All the bookkeeping of coincidence between handles is
+	# handled in spawn_with_handles.
 
-    close $kid_rdr; close $kid_wtr; close $kid_err;
-    if ($dup_wtr) {
-	close($dad_wtr);
+	my @close;
+	if ($dup_wtr) {
+	  $kid_rdr = $dad_wtr;
+	  push @close, \*{$kid_rdr};
+	} else {
+	  push @close, \*{$dad_wtr}, \*{$kid_rdr};
+	}
+	if ($dup_rdr) {
+	  $kid_wtr = $dad_rdr;
+	  push @close, \*{$kid_wtr};
+	} else {
+	  push @close, \*{$dad_rdr}, \*{$kid_wtr};
+	}
+	if ($dad_rdr ne $dad_err) {
+	    if ($dup_err) {
+	      $kid_err = $dad_err ;
+	      push @close, \*{$kid_err};
+	    } else {
+	      push @close, \*{$dad_err}, \*{$kid_err};
+	    }
+	} else {
+	  $kid_err = $kid_wtr;
+	}
+	require IO::Pipe;
+	$kidpid = eval {
+	    spawn_with_handles( [ { mode => 'r',
+				    open_as => \*{$kid_rdr},
+				    handle => \*STDIN },
+				  { mode => 'w',
+				    open_as => \*{$kid_wtr},
+				    handle => \*STDOUT },
+				  { mode => 'w',
+				    open_as => \*{$kid_err},
+				    handle => \*STDERR },
+				], \@close, @cmd);
+	};
+	die "open3: $@" if $@;
     }
 
+    xclose $kid_rdr if !$dup_wtr;
+    xclose $kid_wtr if !$dup_rdr;
+    xclose $kid_err if !$dup_err && $dad_rdr ne $dad_err;
+    # If the write handle is a dup give it away entirely, close my copy
+    # of it.
+    xclose $dad_wtr if $dup_wtr;
+
     select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe
     $kidpid;
 }
-1; # so require is happy
 
+sub open3 {
+    if (@_ < 4) {
+	local $" = ', ';
+	croak "open3(@_): not enough arguments";
+    }
+    return _open3 'open3', scalar caller, @_
+}
+
+sub spawn_with_handles {
+    my $fds = shift;		# Fields: handle, mode, open_as
+    my $close_in_child = shift;
+    my ($fd, $pid, @saved_fh, $saved, %saved, @errs);
+    require Fcntl;
+
+    foreach $fd (@$fds) {
+	$fd->{tmp_copy} = IO::Handle->new_from_fd($fd->{handle}, $fd->{mode});
+	$saved{fileno $fd->{handle}} = $fd->{tmp_copy};
+    }
+    foreach $fd (@$fds) {
+	bless $fd->{handle}, 'IO::Handle'
+	    unless eval { $fd->{handle}->isa('IO::Handle') } ;
+	# If some of handles to redirect-to coincide with handles to
+	# redirect, we need to use saved variants:
+	$fd->{handle}->fdopen($saved{fileno $fd->{open_as}} || $fd->{open_as},
+			      $fd->{mode});
+    }
+    # Stderr may be redirected below, so we save the err text:
+    foreach $fd (@$close_in_child) {
+	fcntl($fd, Fcntl::F_SETFD(), 1) or push @errs, "fcntl $fd: $!"
+	    unless $saved{fileno $fd};	# Do not close what we redirect!
+    }
+
+    unless (@errs) {
+	$pid = eval { system 1, @_ }; # 1 == P_NOWAIT
+	push @errs, "IO::Pipe: Can't spawn-NOWAIT: $!" if !$pid || $pid < 0;
+    }
+
+    foreach $fd (@$fds) {
+	$fd->{handle}->fdopen($fd->{tmp_copy}, $fd->{mode});
+	$fd->{tmp_copy}->close or croak "Can't close: $!";
+    }
+    croak join "\n", @errs if @errs;
+    return $pid;
+}
+
+1; # so require is happy
diff --git a/lib/Math/BigInt.pm b/lib/Math/BigInt.pm
index 68856aea6e..422dca42fd 100644
--- a/lib/Math/BigInt.pm
+++ b/lib/Math/BigInt.pm
@@ -106,13 +106,23 @@ sub bcmp { #(num_str, num_str) return cond_code
 
 sub cmp { # post-normalized compare for internal use
     local($cx, $cy) = @_;
-    $cx cmp $cy
-    &&
-    (
-	ord($cy) <=> ord($cx)
-	||
-	($cx cmp ',') * (length($cy) <=> length($cx) || $cy cmp $cx)
-    );
+    
+    return 0 if ($cx eq $cy);
+
+    local($sx, $sy) = (substr($cx, 0, 1), substr($cy, 0, 1));
+    local($ld);
+
+    if ($sx eq '+') {
+      return  1 if ($sy eq '-' || $cy eq '+0');
+      $ld = length($cx) - length($cy);
+      return $ld if ($ld);
+      return $cx cmp $cy;
+    } else { # $sx eq '-'
+      return -1 if ($sy eq '+');
+      $ld = length($cy) - length($cx);
+      return $ld if ($ld);
+      return $cy cmp $cx;
+    }
 }
 
 sub badd { #(num_str, num_str) return num_str
@@ -161,11 +171,11 @@ sub add { #(int_num_array, int_num_array) return int_num_array
     $car = 0;
     for $x (@x) {
 	last unless @y || $car;
-	$x -= 1e5 if $car = (($x += shift(@y) + $car) >= 1e5);
+	$x -= 1e5 if $car = (($x += shift(@y) + $car) >= 1e5) ? 1 : 0;
     }
     for $y (@y) {
 	last unless $car;
-	$y -= 1e5 if $car = (($y += $car) >= 1e5);
+	$y -= 1e5 if $car = (($y += $car) >= 1e5) ? 1 : 0;
     }
     (@x, @y, $car);
 }
@@ -204,7 +214,7 @@ sub mul { #(*int_num_array, *int_num_array) return int_num_array
     for $x (@x) {
       ($car, $cty) = (0, $[);
       for $y (@y) {
-	$prod = $x * $y + $prod[$cty] + $car;
+	$prod = $x * $y + ($prod[$cty] || 0) + $car;
 	$prod[$cty++] =
 	  $prod - ($car = int($prod * 1e-5)) * 1e5;
       }
diff --git a/lib/Math/Complex.pm b/lib/Math/Complex.pm
index 969f3c2c79..7a4617c65a 100644
--- a/lib/Math/Complex.pm
+++ b/lib/Math/Complex.pm
@@ -1,123 +1,1084 @@
-package Math::Complex;
+# $RCSFile$
+#
+# Complex numbers and associated mathematical functions
+# -- Raphael Manfredi, September 1996
+# -- Jarkko Hietaniemi, March-April 1997
 
 require Exporter;
+package Math::Complex;
+
+use strict;
+
+use vars qw($VERSION @ISA
+	    @EXPORT %EXPORT_TAGS
+	    $package $display
+	    $i $logn %logn);
+
+@ISA = qw(Exporter);
 
-@ISA = ('Exporter');
+$VERSION = 1.01;
 
-# just to make use happy
+my @trig = qw(
+	      pi
+	      sin cos tan
+	      csc cosec sec cot cotan
+	      asin acos atan
+	      acsc acosec asec acot acotan
+	      sinh cosh tanh
+	      csch cosech sech coth cotanh
+	      asinh acosh atanh
+	      acsch acosech asech acoth acotanh
+	     );
+
+@EXPORT = (qw(
+	     i Re Im arg
+	     sqrt exp log ln
+	     log10 logn cbrt root
+	     cplx cplxe
+	     ),
+	   @trig);
+
+%EXPORT_TAGS = (
+    'trig' => [@trig],
+);
 
 use overload
-    '+'   => sub  { my($x1,$y1,$x2,$y2) = (@{$_[0]},@{$_[1]});
-                      bless [ $x1+$x2, $y1+$y2];
-             },
-
-    '-'   => sub  { my($x1,$y1,$x2,$y2) = (@{$_[0]},@{$_[1]});
-                      bless [ $x1-$x2, $y1-$y2];
-             },
-
-    '*'   => sub  { my($x1,$y1,$x2,$y2) = (@{$_[0]},@{$_[1]});
-                    bless [ $x1*$x2-$y1*$y2,$x1*$y2+$x2*$y1];
-             },
-
-    '/'   => sub  { my($x1,$y1,$x2,$y2) = (@{$_[0]},@{$_[1]});
-                    my $q = $x2*$x2+$y2*$y2;
-                    bless [($x1*$x2+$y1*$y2)/$q, ($y1*$x2-$y2*$x1)/$q];
-             },
-
-    'neg' => sub  { my($x,$y) = @{$_[0]}; bless [ -$x, -$y];
-             },
-
-    '~'   => sub  { my($x,$y) = @{$_[0]}; bless [ $x, -$y];
-             },
-
-    'abs'   => sub  { my($x,$y) = @{$_[0]}; sqrt $x*$x+$y*$y;
-             },
-
-    'cos' => sub { my($x,$y) = @{$_[0]};
-                   my ($ab,$c,$s) = (exp $y, cos $x, sin $x);
-                   my $abr = 1/(2*$ab); $ab /= 2;
-                   bless [ ($abr+$ab)*$c, ($abr-$ab)*$s];
-             },
-
-    'sin' => sub { my($x,$y) = @{$_[0]};
-                   my ($ab,$c,$s) = (exp $y, cos $x, sin $x);
-                   my $abr = 1/(2*$ab); $ab /= 2;
-                   bless [ (-$abr-$ab)*$s, ($abr-$ab)*$c];
-             },
-
-    'exp' => sub { my($x,$y) = @{$_[0]};
-                   my ($ab,$c,$s) = (exp $x, cos $y, sin $y);
-                   bless [ $ab*$c, $ab*$s ];
-              },
-
-    'sqrt' => sub { 
-	my($zr,$zi) = @{$_[0]};
-	my ($x, $y, $r, $w);
-	my $c = new Math::Complex (0,0);
-        if (($zr == 0) && ($zi == 0)) { 
-	    # nothing, $c already set
-	}
-        else {
-	  $x = abs($zr);
-	  $y = abs($zi);
-	  if ($x >= $y) { 
-	      $r = $y/$x; 
-	      $w = sqrt($x) * sqrt(0.5*(1.0+sqrt(1.0+$r*$r))); 
-	  }
-	  else { 
-	      $r = $x/$y; 
-	      $w = sqrt($y) * sqrt($y) * sqrt(0.5*($r+sqrt(1.0+$r*$r))); 
-	  }
-	  if ( $zr >= 0) { 
-	      @$c = ($w, $zi/(2 * $w) ); 
-	  }
-	  else { 
-	      $c->[1] = ($zi >= 0) ? $w : -$w;
-	      $c->[0] = $zi/(2.0* $c->[1]); 
-	  }
-        } 
-        return $c;
-      },
-
-    qw("" stringify)
-;
-
-sub new {
-    my $class = shift;
-    my @C = @_;
-    bless \@C, $class;
+	'+'	=> \&plus,
+	'-'	=> \&minus,
+	'*'	=> \&multiply,
+	'/'	=> \&divide,
+	'**'	=> \&power,
+	'<=>'	=> \&spaceship,
+	'neg'	=> \&negate,
+	'~'	=> \&conjugate,
+	'abs'	=> \&abs,
+	'sqrt'	=> \&sqrt,
+	'exp'	=> \&exp,
+	'log'	=> \&log,
+	'sin'	=> \&sin,
+	'cos'	=> \&cos,
+	'tan'	=> \&tan,
+	'atan2'	=> \&atan2,
+	qw("" stringify);
+
+#
+# Package globals
+#
+
+$package = 'Math::Complex';		# Package name
+$display = 'cartesian';			# Default display format
+
+#
+# Object attributes (internal):
+#	cartesian	[real, imaginary] -- cartesian form
+#	polar		[rho, theta] -- polar form
+#	c_dirty		cartesian form not up-to-date
+#	p_dirty		polar form not up-to-date
+#	display		display format (package's global when not set)
+#
+
+#
+# ->make
+#
+# Create a new complex number (cartesian form)
+#
+sub make {
+	my $self = bless {}, shift;
+	my ($re, $im) = @_;
+	$self->{'cartesian'} = [$re, $im];
+	$self->{c_dirty} = 0;
+	$self->{p_dirty} = 1;
+	return $self;
+}
+
+#
+# ->emake
+#
+# Create a new complex number (exponential form)
+#
+sub emake {
+	my $self = bless {}, shift;
+	my ($rho, $theta) = @_;
+	$theta += pi() if $rho < 0;
+	$self->{'polar'} = [abs($rho), $theta];
+	$self->{p_dirty} = 0;
+	$self->{c_dirty} = 1;
+	return $self;
+}
+
+sub new { &make }		# For backward compatibility only.
+
+#
+# cplx
+#
+# Creates a complex number from a (re, im) tuple.
+# This avoids the burden of writing Math::Complex->make(re, im).
+#
+sub cplx {
+	my ($re, $im) = @_;
+	return $package->make($re, defined $im ? $im : 0);
+}
+
+#
+# cplxe
+#
+# Creates a complex number from a (rho, theta) tuple.
+# This avoids the burden of writing Math::Complex->emake(rho, theta).
+#
+sub cplxe {
+	my ($rho, $theta) = @_;
+	return $package->emake($rho, defined $theta ? $theta : 0);
 }
 
+#
+# pi
+#
+# The number defined as 2 * pi = 360 degrees
+#
+
+use constant pi => 4 * atan2(1, 1);
+
+#
+# log2inv
+#
+# Used in log10().
+#
+
+use constant log10inv => 1 / log(10);
+
+#
+# i
+#
+# The number defined as i*i = -1;
+#
+sub i () {
+        return $i if ($i);
+	$i = bless {};
+	$i->{'cartesian'} = [0, 1];
+	$i->{'polar'}     = [1, pi/2];
+	$i->{c_dirty} = 0;
+	$i->{p_dirty} = 0;
+	return $i;
+}
+
+#
+# Attribute access/set routines
+#
+
+sub cartesian {$_[0]->{c_dirty} ?
+		   $_[0]->update_cartesian : $_[0]->{'cartesian'}}
+sub polar     {$_[0]->{p_dirty} ?
+		   $_[0]->update_polar : $_[0]->{'polar'}}
+
+sub set_cartesian { $_[0]->{p_dirty}++; $_[0]->{'cartesian'} = $_[1] }
+sub set_polar     { $_[0]->{c_dirty}++; $_[0]->{'polar'} = $_[1] }
+
+#
+# ->update_cartesian
+#
+# Recompute and return the cartesian form, given accurate polar form.
+#
+sub update_cartesian {
+	my $self = shift;
+	my ($r, $t) = @{$self->{'polar'}};
+	$self->{c_dirty} = 0;
+	return $self->{'cartesian'} = [$r * cos $t, $r * sin $t];
+}
+
+#
+#
+# ->update_polar
+#
+# Recompute and return the polar form, given accurate cartesian form.
+#
+sub update_polar {
+	my $self = shift;
+	my ($x, $y) = @{$self->{'cartesian'}};
+	$self->{p_dirty} = 0;
+	return $self->{'polar'} = [0, 0] if $x == 0 && $y == 0;
+	return $self->{'polar'} = [sqrt($x*$x + $y*$y), atan2($y, $x)];
+}
+
+#
+# (plus)
+#
+# Computes z1+z2.
+#
+sub plus {
+	my ($z1, $z2, $regular) = @_;
+	my ($re1, $im1) = @{$z1->cartesian};
+	$z2 = cplx($z2) unless ref $z2;
+	my ($re2, $im2) = ref $z2 ? @{$z2->cartesian} : ($z2, 0);
+	unless (defined $regular) {
+		$z1->set_cartesian([$re1 + $re2, $im1 + $im2]);
+		return $z1;
+	}
+	return (ref $z1)->make($re1 + $re2, $im1 + $im2);
+}
+
+#
+# (minus)
+#
+# Computes z1-z2.
+#
+sub minus {
+	my ($z1, $z2, $inverted) = @_;
+	my ($re1, $im1) = @{$z1->cartesian};
+	$z2 = cplx($z2) unless ref $z2;
+	my ($re2, $im2) = @{$z2->cartesian};
+	unless (defined $inverted) {
+		$z1->set_cartesian([$re1 - $re2, $im1 - $im2]);
+		return $z1;
+	}
+	return $inverted ?
+		(ref $z1)->make($re2 - $re1, $im2 - $im1) :
+		(ref $z1)->make($re1 - $re2, $im1 - $im2);
+
+}
+
+#
+# (multiply)
+#
+# Computes z1*z2.
+#
+sub multiply {
+	my ($z1, $z2, $regular) = @_;
+	my ($r1, $t1) = @{$z1->polar};
+	$z2 = cplxe(abs($z2), $z2 >= 0 ? 0 : pi) unless ref $z2;
+	my ($r2, $t2) = @{$z2->polar};
+	unless (defined $regular) {
+		$z1->set_polar([$r1 * $r2, $t1 + $t2]);
+		return $z1;
+	}
+	return (ref $z1)->emake($r1 * $r2, $t1 + $t2);
+}
+
+#
+# _divbyzero
+#
+# Die on division by zero.
+#
+sub _divbyzero {
+    my $mess = "$_[0]: Division by zero.\n";
+
+    if (defined $_[1]) {
+	$mess .= "(Because in the definition of $_[0], the divisor ";
+	$mess .= "$_[1] " unless ($_[1] eq '0');
+	$mess .= "is 0)\n";
+    }
+
+    my @up = caller(1);
+    
+    $mess .= "Died at $up[1] line $up[2].\n";
+
+    die $mess;
+}
+
+#
+# (divide)
+#
+# Computes z1/z2.
+#
+sub divide {
+	my ($z1, $z2, $inverted) = @_;
+	my ($r1, $t1) = @{$z1->polar};
+	$z2 = cplxe(abs($z2), $z2 >= 0 ? 0 : pi) unless ref $z2;
+	my ($r2, $t2) = @{$z2->polar};
+	unless (defined $inverted) {
+		_divbyzero "$z1/0" if ($r2 == 0);
+		$z1->set_polar([$r1 / $r2, $t1 - $t2]);
+		return $z1;
+	}
+	if ($inverted) {
+		_divbyzero "$z2/0" if ($r1 == 0);
+		return (ref $z1)->emake($r2 / $r1, $t2 - $t1);
+	} else {
+		_divbyzero "$z1/0" if ($r2 == 0);
+		return (ref $z1)->emake($r1 / $r2, $t1 - $t2);
+	}
+}
+
+#
+# _zerotozero
+#
+# Die on zero raised to the zeroth.
+#
+sub _zerotozero {
+    my $mess = "The zero raised to the zeroth power is not defined.\n";
+
+    my @up = caller(1);
+    
+    $mess .= "Died at $up[1] line $up[2].\n";
+
+    die $mess;
+}
+
+#
+# (power)
+#
+# Computes z1**z2 = exp(z2 * log z1)).
+#
+sub power {
+	my ($z1, $z2, $inverted) = @_;
+	my $z1z = $z1 == 0;
+	my $z2z = $z2 == 0;
+	_zerotozero if ($z1z and $z2z);
+	if ($inverted) {
+	    return 0 if ($z2z);
+	    return 1 if ($z1z or $z2 == 1);
+	} else {
+	    return 0 if ($z1z);
+	    return 1 if ($z2z or $z1 == 1);
+	}
+	$z2 = cplx($z2) unless ref $z2;
+	unless (defined $inverted) {
+		my $z3 = exp($z2 * log $z1);
+		$z1->set_cartesian([@{$z3->cartesian}]);
+		return $z1;
+	}
+	return exp($z2 * log $z1) unless $inverted;
+	return exp($z1 * log $z2);
+}
+
+#
+# (spaceship)
+#
+# Computes z1 <=> z2.
+# Sorts on the real part first, then on the imaginary part. Thus 2-4i > 3+8i.
+#
+sub spaceship {
+	my ($z1, $z2, $inverted) = @_;
+	my ($re1, $im1) = ref $z1 ? @{$z1->cartesian} : ($z1, 0);
+	my ($re2, $im2) = ref $z2 ? @{$z2->cartesian} : ($z2, 0);
+	my $sgn = $inverted ? -1 : 1;
+	return $sgn * ($re1 <=> $re2) if $re1 != $re2;
+	return $sgn * ($im1 <=> $im2);
+}
+
+#
+# (negate)
+#
+# Computes -z.
+#
+sub negate {
+	my ($z) = @_;
+	if ($z->{c_dirty}) {
+		my ($r, $t) = @{$z->polar};
+		return (ref $z)->emake($r, pi + $t);
+	}
+	my ($re, $im) = @{$z->cartesian};
+	return (ref $z)->make(-$re, -$im);
+}
+
+#
+# (conjugate)
+#
+# Compute complex's conjugate.
+#
+sub conjugate {
+	my ($z) = @_;
+	if ($z->{c_dirty}) {
+		my ($r, $t) = @{$z->polar};
+		return (ref $z)->emake($r, -$t);
+	}
+	my ($re, $im) = @{$z->cartesian};
+	return (ref $z)->make($re, -$im);
+}
+
+#
+# (abs)
+#
+# Compute complex's norm (rho).
+#
+sub abs {
+	my ($z) = @_;
+	return abs($z) unless ref $z;
+	my ($r, $t) = @{$z->polar};
+	return abs($r);
+}
+
+#
+# arg
+#
+# Compute complex's argument (theta).
+#
+sub arg {
+	my ($z) = @_;
+	return ($z < 0 ? pi : 0) unless ref $z;
+	my ($r, $t) = @{$z->polar};
+	return $t;
+}
+
+#
+# (sqrt)
+#
+# Compute sqrt(z).
+#
+sub sqrt {
+	my ($z) = @_;
+	$z = cplx($z, 0) unless ref $z;
+	my ($r, $t) = @{$z->polar};
+	return (ref $z)->emake(sqrt($r), $t/2);
+}
+
+#
+# cbrt
+#
+# Compute cbrt(z) (cubic root).
+#
+sub cbrt {
+	my ($z) = @_;
+	return cplx($z, 0) ** (1/3) unless ref $z;
+	my ($r, $t) = @{$z->polar};
+	return (ref $z)->emake($r**(1/3), $t/3);
+}
+
+#
+# _rootbad
+#
+# Die on bad root.
+#
+sub _rootbad {
+    my $mess = "Root $_[0] not defined, root must be positive integer.\n";
+
+    my @up = caller(1);
+    
+    $mess .= "Died at $up[1] line $up[2].\n";
+
+    die $mess;
+}
+
+#
+# root
+#
+# Computes all nth root for z, returning an array whose size is n.
+# `n' must be a positive integer.
+#
+# The roots are given by (for k = 0..n-1):
+#
+# z^(1/n) = r^(1/n) (cos ((t+2 k pi)/n) + i sin ((t+2 k pi)/n))
+#
+sub root {
+	my ($z, $n) = @_;
+	_rootbad($n) if ($n < 1 or int($n) != $n);
+	my ($r, $t) = ref $z ? @{$z->polar} : (abs($z), $z >= 0 ? 0 : pi);
+	my @root;
+	my $k;
+	my $theta_inc = 2 * pi / $n;
+	my $rho = $r ** (1/$n);
+	my $theta;
+	my $complex = ref($z) || $package;
+	for ($k = 0, $theta = $t / $n; $k < $n; $k++, $theta += $theta_inc) {
+		push(@root, $complex->emake($rho, $theta));
+	}
+	return @root;
+}
+
+#
+# Re
+#
+# Return Re(z).
+#
 sub Re {
-    my($x,$y) = @{$_[0]};
-    $x;
+	my ($z) = @_;
+	return $z unless ref $z;
+	my ($re, $im) = @{$z->cartesian};
+	return $re;
 }
 
+#
+# Im
+#
+# Return Im(z).
+#
 sub Im {
-    my($x,$y) = @{$_[0]};
-    $y;
+	my ($z) = @_;
+	return 0 unless ref $z;
+	my ($re, $im) = @{$z->cartesian};
+	return $im;
 }
 
-sub arg {
-    my($x,$y) = @{$_[0]};
-    atan2($y,$x);
+#
+# (exp)
+#
+# Computes exp(z).
+#
+sub exp {
+	my ($z) = @_;
+	$z = cplx($z, 0) unless ref $z;
+	my ($x, $y) = @{$z->cartesian};
+	return (ref $z)->emake(exp($x), $y);
+}
+
+#
+# (log)
+#
+# Compute log(z).
+#
+sub log {
+	my ($z) = @_;
+	$z = cplx($z, 0) unless ref $z;
+	my ($x, $y) = @{$z->cartesian};
+	my ($r, $t) = @{$z->polar};
+	$t -= 2 * pi if ($t >  pi() and $x < 0);
+	$t += 2 * pi if ($t < -pi() and $x < 0);
+	return (ref $z)->make(log($r), $t);
+}
+
+#
+# ln
+#
+# Alias for log().
+#
+sub ln { Math::Complex::log(@_) }
+
+#
+# log10
+#
+# Compute log10(z).
+#
+
+sub log10 {
+	my ($z) = @_;
+
+	return log(cplx($z, 0)) * log10inv unless ref $z;
+	my ($r, $t) = @{$z->polar};
+	return (ref $z)->make(log($r) * log10inv, $t * log10inv);
+}
+
+#
+# logn
+#
+# Compute logn(z,n) = log(z) / log(n)
+#
+sub logn {
+	my ($z, $n) = @_;
+	$z = cplx($z, 0) unless ref $z;
+	my $logn = $logn{$n};
+	$logn = $logn{$n} = log($n) unless defined $logn;	# Cache log(n)
+	return log($z) / $logn;
+}
+
+#
+# (cos)
+#
+# Compute cos(z) = (exp(iz) + exp(-iz))/2.
+#
+sub cos {
+	my ($z) = @_;
+	$z = cplx($z, 0) unless ref $z;
+	my ($x, $y) = @{$z->cartesian};
+	my $ey = exp($y);
+	my $ey_1 = 1 / $ey;
+	return (ref $z)->make(cos($x) * ($ey + $ey_1)/2,
+			      sin($x) * ($ey_1 - $ey)/2);
+}
+
+#
+# (sin)
+#
+# Compute sin(z) = (exp(iz) - exp(-iz))/2.
+#
+sub sin {
+	my ($z) = @_;
+	$z = cplx($z, 0) unless ref $z;
+	my ($x, $y) = @{$z->cartesian};
+	my $ey = exp($y);
+	my $ey_1 = 1 / $ey;
+	return (ref $z)->make(sin($x) * ($ey + $ey_1)/2,
+			      cos($x) * ($ey - $ey_1)/2);
+}
+
+#
+# tan
+#
+# Compute tan(z) = sin(z) / cos(z).
+#
+sub tan {
+	my ($z) = @_;
+	my $cz = cos($z);
+	_divbyzero "tan($z)", "cos($z)" if ($cz == 0);
+	return sin($z) / $cz;
+}
+
+#
+# sec
+#
+# Computes the secant sec(z) = 1 / cos(z).
+#
+sub sec {
+	my ($z) = @_;
+	my $cz = cos($z);
+	_divbyzero "sec($z)", "cos($z)" if ($cz == 0);
+	return 1 / $cz;
+}
+
+#
+# csc
+#
+# Computes the cosecant csc(z) = 1 / sin(z).
+#
+sub csc {
+	my ($z) = @_;
+	my $sz = sin($z);
+	_divbyzero "csc($z)", "sin($z)" if ($sz == 0);
+	return 1 / $sz;
+}
+
+#
+# cosec
+#
+# Alias for csc().
+#
+sub cosec { Math::Complex::csc(@_) }
+
+#
+# cot
+#
+# Computes cot(z) = 1 / tan(z).
+#
+sub cot {
+	my ($z) = @_;
+	my $sz = sin($z);
+	_divbyzero "cot($z)", "sin($z)" if ($sz == 0);
+	return cos($z) / $sz;
+}
+
+#
+# cotan
+#
+# Alias for cot().
+#
+sub cotan { Math::Complex::cot(@_) }
+
+#
+# acos
+#
+# Computes the arc cosine acos(z) = -i log(z + sqrt(z*z-1)).
+#
+sub acos {
+	my ($z) = @_;
+	$z = cplx($z, 0) unless ref $z;
+	return ~i * log($z + (Re($z) * Im($z) > 0 ? 1 : -1) * sqrt($z*$z - 1));
+}
+
+#
+# asin
+#
+# Computes the arc sine asin(z) = -i log(iz + sqrt(1-z*z)).
+#
+sub asin {
+	my ($z) = @_;
+	$z = cplx($z, 0) unless ref $z;
+	return ~i * log(i * $z + sqrt(1 - $z*$z));
+}
+
+#
+# atan
+#
+# Computes the arc tangent atan(z) = i/2 log((i+z) / (i-z)).
+#
+sub atan {
+	my ($z) = @_;
+	$z = cplx($z, 0) unless ref $z;
+	_divbyzero "atan($z)", "i - $z" if ($z == i);
+	return i/2*log((i + $z) / (i - $z));
+}
+
+#
+# asec
+#
+# Computes the arc secant asec(z) = acos(1 / z).
+#
+sub asec {
+	my ($z) = @_;
+	_divbyzero "asec($z)", $z if ($z == 0);
+	return acos(1 / $z);
+}
+
+#
+# acsc
+#
+# Computes the arc cosecant sec(z) = asin(1 / z).
+#
+sub acsc {
+	my ($z) = @_;
+	_divbyzero "acsc($z)", $z if ($z == 0);
+	return asin(1 / $z);
+}
+
+#
+# acosec
+#
+# Alias for acsc().
+#
+sub acosec { Math::Complex::acsc(@_) }
+
+#
+# acot
+#
+# Computes the arc cotangent acot(z) = -i/2 log((i+z) / (z-i))
+#
+sub acot {
+	my ($z) = @_;
+	$z = cplx($z, 0) unless ref $z;
+	_divbyzero "acot($z)", "$z - i" if ($z == i);
+	return i/-2 * log((i + $z) / ($z - i));
+}
+
+#
+# acotan
+#
+# Alias for acot().
+#
+sub acotan { Math::Complex::acot(@_) }
+
+#
+# cosh
+#
+# Computes the hyperbolic cosine cosh(z) = (exp(z) + exp(-z))/2.
+#
+sub cosh {
+	my ($z) = @_;
+	my $real;
+	unless (ref $z) {
+	    $z = cplx($z, 0);
+	    $real = 1;
+	}
+	my ($x, $y) = @{$z->cartesian};
+	my $ex = exp($x);
+	my $ex_1 = 1 / $ex;
+	return cplx(0.5 * ($ex + $ex_1), 0) if $real;
+	return (ref $z)->make(cos($y) * ($ex + $ex_1)/2,
+			      sin($y) * ($ex - $ex_1)/2);
+}
+
+#
+# sinh
+#
+# Computes the hyperbolic sine sinh(z) = (exp(z) - exp(-z))/2.
+#
+sub sinh {
+	my ($z) = @_;
+	my $real;
+	unless (ref $z) {
+	    $z = cplx($z, 0);
+	    $real = 1;
+	}
+	my ($x, $y) = @{$z->cartesian};
+	my $ex = exp($x);
+	my $ex_1 = 1 / $ex;
+	return cplx(0.5 * ($ex - $ex_1), 0) if $real;
+	return (ref $z)->make(cos($y) * ($ex - $ex_1)/2,
+			      sin($y) * ($ex + $ex_1)/2);
+}
+
+#
+# tanh
+#
+# Computes the hyperbolic tangent tanh(z) = sinh(z) / cosh(z).
+#
+sub tanh {
+	my ($z) = @_;
+	my $cz = cosh($z);
+	_divbyzero "tanh($z)", "cosh($z)" if ($cz == 0);
+	return sinh($z) / $cz;
+}
+
+#
+# sech
+#
+# Computes the hyperbolic secant sech(z) = 1 / cosh(z).
+#
+sub sech {
+	my ($z) = @_;
+	my $cz = cosh($z);
+	_divbyzero "sech($z)", "cosh($z)" if ($cz == 0);
+	return 1 / $cz;
+}
+
+#
+# csch
+#
+# Computes the hyperbolic cosecant csch(z) = 1 / sinh(z).
+#
+sub csch {
+	my ($z) = @_;
+	my $sz = sinh($z);
+	_divbyzero "csch($z)", "sinh($z)" if ($sz == 0);
+	return 1 / $sz;
+}
+
+#
+# cosech
+#
+# Alias for csch().
+#
+sub cosech { Math::Complex::csch(@_) }
+
+#
+# coth
+#
+# Computes the hyperbolic cotangent coth(z) = cosh(z) / sinh(z).
+#
+sub coth {
+	my ($z) = @_;
+	my $sz = sinh($z);
+	_divbyzero "coth($z)", "sinh($z)" if ($sz == 0);
+	return cosh($z) / $sz;
+}
+
+#
+# cotanh
+#
+# Alias for coth().
+#
+sub cotanh { Math::Complex::coth(@_) }
+
+#
+# acosh
+#
+# Computes the arc hyperbolic cosine acosh(z) = log(z + sqrt(z*z-1)).
+#
+sub acosh {
+	my ($z) = @_;
+	$z = cplx($z, 0) unless ref $z;
+	return log($z + sqrt($z*$z - 1));
+}
+
+#
+# asinh
+#
+# Computes the arc hyperbolic sine asinh(z) = log(z + sqrt(z*z-1))
+#
+sub asinh {
+	my ($z) = @_;
+	$z = cplx($z, 0) unless ref $z;
+	return log($z + sqrt($z*$z + 1));
+}
+
+#
+# atanh
+#
+# Computes the arc hyperbolic tangent atanh(z) = 1/2 log((1+z) / (1-z)).
+#
+sub atanh {
+	my ($z) = @_;
+	_divbyzero 'atanh(1)', "1 - $z" if ($z == 1);
+	$z = cplx($z, 0) unless ref $z;
+	my $cz = (1 + $z) / (1 - $z);
+	return log($cz) / 2;
+}
+
+#
+# asech
+#
+# Computes the hyperbolic arc secant asech(z) = acosh(1 / z).
+#
+sub asech {
+	my ($z) = @_;
+	_divbyzero 'asech(0)', $z if ($z == 0);
+	return acosh(1 / $z);
+}
+
+#
+# acsch
+#
+# Computes the hyperbolic arc cosecant acsch(z) = asinh(1 / z).
+#
+sub acsch {
+	my ($z) = @_;
+	_divbyzero 'acsch(0)', $z if ($z == 0);
+	return asinh(1 / $z);
 }
 
+#
+# acosech
+#
+# Alias for acosh().
+#
+sub acosech { Math::Complex::acsch(@_) }
+
+#
+# acoth
+#
+# Computes the arc hyperbolic cotangent acoth(z) = 1/2 log((1+z) / (z-1)).
+#
+sub acoth {
+	my ($z) = @_;
+	_divbyzero 'acoth(1)', "$z - 1" if ($z == 1);
+	$z = cplx($z, 0) unless ref $z;
+	my $cz = (1 + $z) / ($z - 1);
+	return log($cz) / 2;
+}
+
+#
+# acotanh
+#
+# Alias for acot().
+#
+sub acotanh { Math::Complex::acoth(@_) }
+
+#
+# (atan2)
+#
+# Compute atan(z1/z2).
+#
+sub atan2 {
+	my ($z1, $z2, $inverted) = @_;
+	my ($re1, $im1) = ref $z1 ? @{$z1->cartesian} : ($z1, 0);
+	my ($re2, $im2) = ref $z2 ? @{$z2->cartesian} : ($z2, 0);
+	my $tan;
+	if (defined $inverted && $inverted) {	# atan(z2/z1)
+		return pi * ($re2 > 0 ? 1 : -1) if $re1 == 0 && $im1 == 0;
+		$tan = $z2 / $z1;
+	} else {
+		return pi * ($re1 > 0 ? 1 : -1) if $re2 == 0 && $im2 == 0;
+		$tan = $z1 / $z2;
+	}
+	return atan($tan);
+}
+
+#
+# display_format
+# ->display_format
+#
+# Set (fetch if no argument) display format for all complex numbers that
+# don't happen to have overrriden it via ->display_format
+#
+# When called as a method, this actually sets the display format for
+# the current object.
+#
+# Valid object formats are 'c' and 'p' for cartesian and polar. The first
+# letter is used actually, so the type can be fully spelled out for clarity.
+#
+sub display_format {
+	my $self = shift;
+	my $format = undef;
+
+	if (ref $self) {			# Called as a method
+		$format = shift;
+	} else {				# Regular procedure call
+		$format = $self;
+		undef $self;
+	}
+
+	if (defined $self) {
+		return defined $self->{display} ? $self->{display} : $display
+			unless defined $format;
+		return $self->{display} = $format;
+	}
+
+	return $display unless defined $format;
+	return $display = $format;
+}
+
+#
+# (stringify)
+#
+# Show nicely formatted complex number under its cartesian or polar form,
+# depending on the current display format:
+#
+# . If a specific display format has been recorded for this object, use it.
+# . Otherwise, use the generic current default for all complex numbers,
+#   which is a package global variable.
+#
 sub stringify {
-    my($x,$y) = @{$_[0]};
-    my($re,$im);
+	my ($z) = shift;
+	my $format;
 
-    $re = $x if ($x);
-    if ($y == 1) {$im = 'i';}  
-    elsif ($y == -1){$im = '-i';} 
-    elsif ($y) {$im = "${y}i"; }
+	$format = $display;
+	$format = $z->{display} if defined $z->{display};
 
-    local $_ = $re.'+'.$im;
-    s/\+-/-/;
-    s/^\+//;
-    s/[\+-]$//;
-    $_ = 0 if ($_ eq '');
-    return $_;
+	return $z->stringify_polar if $format =~ /^p/i;
+	return $z->stringify_cartesian;
+}
+
+#
+# ->stringify_cartesian
+#
+# Stringify as a cartesian representation 'a+bi'.
+#
+sub stringify_cartesian {
+	my $z  = shift;
+	my ($x, $y) = @{$z->cartesian};
+	my ($re, $im);
+
+	$x = int($x + ($x < 0 ? -1 : 1) * 1e-14)
+		if int(abs($x)) != int(abs($x) + 1e-14);
+	$y = int($y + ($y < 0 ? -1 : 1) * 1e-14)
+		if int(abs($y)) != int(abs($y) + 1e-14);
+
+	$re = "$x" if abs($x) >= 1e-14;
+	if ($y == 1)				{ $im = 'i' }
+	elsif ($y == -1)			{ $im = '-i' }
+	elsif (abs($y) >= 1e-14)	{ $im = $y . "i" }
+
+	my $str = '';
+	$str = $re if defined $re;
+	$str .= "+$im" if defined $im;
+	$str =~ s/\+-/-/;
+	$str =~ s/^\+//;
+	$str = '0' unless $str;
+
+	return $str;
+}
+
+#
+# ->stringify_polar
+#
+# Stringify as a polar representation '[r,t]'.
+#
+sub stringify_polar {
+	my $z  = shift;
+	my ($r, $t) = @{$z->polar};
+	my $theta;
+	my $eps = 1e-14;
+
+	return '[0,0]' if $r <= $eps;
+
+	my $tpi = 2 * pi;
+	my $nt = $t / $tpi;
+	$nt = ($nt - int($nt)) * $tpi;
+	$nt += $tpi if $nt < 0;			# Range [0, 2pi]
+
+	if (abs($nt) <= $eps)		{ $theta = 0 }
+	elsif (abs(pi-$nt) <= $eps)	{ $theta = 'pi' }
+
+	if (defined $theta) {
+		$r = int($r + ($r < 0 ? -1 : 1) * $eps)
+			if int(abs($r)) != int(abs($r) + $eps);
+		$theta = int($theta + ($theta < 0 ? -1 : 1) * $eps)
+			if ($theta ne 'pi' and
+			    int(abs($theta)) != int(abs($theta) + $eps));
+		return "\[$r,$theta\]";
+	}
+
+	#
+	# Okay, number is not a real. Try to identify pi/n and friends...
+	#
+
+	$nt -= $tpi if $nt > pi;
+	my ($n, $k, $kpi);
+	
+	for ($k = 1, $kpi = pi; $k < 10; $k++, $kpi += pi) {
+		$n = int($kpi / $nt + ($nt > 0 ? 1 : -1) * 0.5);
+		if (abs($kpi/$n - $nt) <= $eps) {
+			$theta = ($nt < 0 ? '-':'').
+				 ($k == 1 ? 'pi':"${k}pi").'/'.abs($n);
+			last;
+		}
+	}
+
+	$theta = $nt unless defined $theta;
+
+	$r = int($r + ($r < 0 ? -1 : 1) * $eps)
+		if int(abs($r)) != int(abs($r) + $eps);
+	$theta = int($theta + ($theta < 0 ? -1 : 1) * $eps)
+		if ($theta !~ m(^-?\d*pi/\d+$) and
+		    int(abs($theta)) != int(abs($theta) + $eps));
+
+	return "\[$r,$theta\]";
 }
 
 1;
@@ -125,39 +1086,394 @@ __END__
 
 =head1 NAME
 
-Math::Complex - complex numbers package
+Math::Complex - complex numbers and associated mathematical functions
 
 =head1 SYNOPSIS
 
-  use Math::Complex;
-  $i = new Math::Complex;
+	use Math::Complex;
+	
+	$z = Math::Complex->make(5, 6);
+	$t = 4 - 3*i + $z;
+	$j = cplxe(1, 2*pi/3);
 
 =head1 DESCRIPTION
 
-Complex numbers declared as
+This package lets you create and manipulate complex numbers. By default,
+I<Perl> limits itself to real numbers, but an extra C<use> statement brings
+full complex support, along with a full set of mathematical functions
+typically associated with and/or extended to complex numbers.
+
+If you wonder what complex numbers are, they were invented to be able to solve
+the following equation:
+
+	x*x = -1
+
+and by definition, the solution is noted I<i> (engineers use I<j> instead since
+I<i> usually denotes an intensity, but the name does not matter). The number
+I<i> is a pure I<imaginary> number.
+
+The arithmetics with pure imaginary numbers works just like you would expect
+it with real numbers... you just have to remember that
+
+	i*i = -1
+
+so you have:
+
+	5i + 7i = i * (5 + 7) = 12i
+	4i - 3i = i * (4 - 3) = i
+	4i * 2i = -8
+	6i / 2i = 3
+	1 / i = -i
+
+Complex numbers are numbers that have both a real part and an imaginary
+part, and are usually noted:
+
+	a + bi
+
+where C<a> is the I<real> part and C<b> is the I<imaginary> part. The
+arithmetic with complex numbers is straightforward. You have to
+keep track of the real and the imaginary parts, but otherwise the
+rules used for real numbers just apply:
+
+	(4 + 3i) + (5 - 2i) = (4 + 5) + i(3 - 2) = 9 + i
+	(2 + i) * (4 - i) = 2*4 + 4i -2i -i*i = 8 + 2i + 1 = 9 + 2i
+
+A graphical representation of complex numbers is possible in a plane
+(also called the I<complex plane>, but it's really a 2D plane).
+The number
+
+	z = a + bi
+
+is the point whose coordinates are (a, b). Actually, it would
+be the vector originating from (0, 0) to (a, b). It follows that the addition
+of two complex numbers is a vectorial addition.
+
+Since there is a bijection between a point in the 2D plane and a complex
+number (i.e. the mapping is unique and reciprocal), a complex number
+can also be uniquely identified with polar coordinates:
+
+	[rho, theta]
+
+where C<rho> is the distance to the origin, and C<theta> the angle between
+the vector and the I<x> axis. There is a notation for this using the
+exponential form, which is:
+
+	rho * exp(i * theta)
+
+where I<i> is the famous imaginary number introduced above. Conversion
+between this form and the cartesian form C<a + bi> is immediate:
+
+	a = rho * cos(theta)
+	b = rho * sin(theta)
+
+which is also expressed by this formula:
+
+	z = rho * exp(i * theta) = rho * (cos theta + i * sin theta) 
+
+In other words, it's the projection of the vector onto the I<x> and I<y>
+axes. Mathematicians call I<rho> the I<norm> or I<modulus> and I<theta>
+the I<argument> of the complex number. The I<norm> of C<z> will be
+noted C<abs(z)>.
+
+The polar notation (also known as the trigonometric
+representation) is much more handy for performing multiplications and
+divisions of complex numbers, whilst the cartesian notation is better
+suited for additions and substractions. Real numbers are on the I<x>
+axis, and therefore I<theta> is zero.
+
+All the common operations that can be performed on a real number have
+been defined to work on complex numbers as well, and are merely
+I<extensions> of the operations defined on real numbers. This means
+they keep their natural meaning when there is no imaginary part, provided
+the number is within their definition set.
+
+For instance, the C<sqrt> routine which computes the square root of
+its argument is only defined for positive real numbers and yields a
+positive real number (it is an application from B<R+> to B<R+>).
+If we allow it to return a complex number, then it can be extended to
+negative real numbers to become an application from B<R> to B<C> (the
+set of complex numbers):
+
+	sqrt(x) = x >= 0 ? sqrt(x) : sqrt(-x)*i
 
-    $i = Math::Complex->new(1,1);
+It can also be extended to be an application from B<C> to B<C>,
+whilst its restriction to B<R> behaves as defined above by using
+the following definition:
 
-can be manipulated with overloaded math operators. The operators
+	sqrt(z = [r,t]) = sqrt(r) * exp(i * t/2)
 
-  + - * / neg ~ abs cos sin exp sqrt
+Indeed, a negative real number can be noted C<[x,pi]>
+(the modulus I<x> is always positive, so C<[x,pi]> is really C<-x>, a
+negative number)
+and the above definition states that
 
-are supported as well as
+	sqrt([x,pi]) = sqrt(x) * exp(i*pi/2) = [sqrt(x),pi/2] = sqrt(x)*i
 
-  "" (stringify)
+which is exactly what we had defined for negative real numbers above.
 
-The methods
+All the common mathematical functions defined on real numbers that
+are extended to complex numbers share that same property of working
+I<as usual> when the imaginary part is zero (otherwise, it would not
+be called an extension, would it?).
 
-  Re Im arg
+A I<new> operation possible on a complex number that is
+the identity for real numbers is called the I<conjugate>, and is noted
+with an horizontal bar above the number, or C<~z> here.
 
-are also provided.
+	 z = a + bi
+	~z = a - bi
+
+Simple... Now look:
+
+	z * ~z = (a + bi) * (a - bi) = a*a + b*b
+
+We saw that the norm of C<z> was noted C<abs(z)> and was defined as the
+distance to the origin, also known as:
+
+	rho = abs(z) = sqrt(a*a + b*b)
+
+so
+
+	z * ~z = abs(z) ** 2
+
+If z is a pure real number (i.e. C<b == 0>), then the above yields:
+
+	a * a = abs(a) ** 2
+
+which is true (C<abs> has the regular meaning for real number, i.e. stands
+for the absolute value). This example explains why the norm of C<z> is
+noted C<abs(z)>: it extends the C<abs> function to complex numbers, yet
+is the regular C<abs> we know when the complex number actually has no
+imaginary part... This justifies I<a posteriori> our use of the C<abs>
+notation for the norm.
+
+=head1 OPERATIONS
+
+Given the following notations:
+
+	z1 = a + bi = r1 * exp(i * t1)
+	z2 = c + di = r2 * exp(i * t2)
+	z = <any complex or real number>
+
+the following (overloaded) operations are supported on complex numbers:
+
+	z1 + z2 = (a + c) + i(b + d)
+	z1 - z2 = (a - c) + i(b - d)
+	z1 * z2 = (r1 * r2) * exp(i * (t1 + t2))
+	z1 / z2 = (r1 / r2) * exp(i * (t1 - t2))
+	z1 ** z2 = exp(z2 * log z1)
+	~z1 = a - bi
+	abs(z1) = r1 = sqrt(a*a + b*b)
+	sqrt(z1) = sqrt(r1) * exp(i * t1/2)
+	exp(z1) = exp(a) * exp(i * b)
+	log(z1) = log(r1) + i*t1
+	sin(z1) = 1/2i (exp(i * z1) - exp(-i * z1))
+	cos(z1) = 1/2 (exp(i * z1) + exp(-i * z1))
+	abs(z1) = r1
+	atan2(z1, z2) = atan(z1/z2)
+
+The following extra operations are supported on both real and complex
+numbers:
+
+	Re(z) = a
+	Im(z) = b
+	arg(z) = t
+
+	cbrt(z) = z ** (1/3)
+	log10(z) = log(z) / log(10)
+	logn(z, n) = log(z) / log(n)
+
+	tan(z) = sin(z) / cos(z)
+
+	csc(z) = 1 / sin(z)
+	sec(z) = 1 / cos(z)
+	cot(z) = 1 / tan(z)
+
+	asin(z) = -i * log(i*z + sqrt(1-z*z))
+	acos(z) = -i * log(z + sqrt(z*z-1))
+	atan(z) = i/2 * log((i+z) / (i-z))
+
+	acsc(z) = asin(1 / z)
+	asec(z) = acos(1 / z)
+	acot(z) = -i/2 * log((i+z) / (z-i))
+
+	sinh(z) = 1/2 (exp(z) - exp(-z))
+	cosh(z) = 1/2 (exp(z) + exp(-z))
+	tanh(z) = sinh(z) / cosh(z) = (exp(z) - exp(-z)) / (exp(z) + exp(-z))
+
+	csch(z) = 1 / sinh(z)
+	sech(z) = 1 / cosh(z)
+	coth(z) = 1 / tanh(z)
+	
+	asinh(z) = log(z + sqrt(z*z+1))
+	acosh(z) = log(z + sqrt(z*z-1))
+	atanh(z) = 1/2 * log((1+z) / (1-z))
+
+	acsch(z) = asinh(1 / z)
+	asech(z) = acosh(1 / z)
+	acoth(z) = atanh(1 / z) = 1/2 * log((1+z) / (z-1))
+
+I<log>, I<csc>, I<cot>, I<acsc>, I<acot>, I<csch>, I<coth>,
+I<acosech>, I<acotanh>, have aliases I<ln>, I<cosec>, I<cotan>,
+I<acosec>, I<acotan>, I<cosech>, I<cotanh>, I<acosech>, I<acotanh>,
+respectively.
+
+The I<root> function is available to compute all the I<n>
+roots of some complex, where I<n> is a strictly positive integer.
+There are exactly I<n> such roots, returned as a list. Getting the
+number mathematicians call C<j> such that:
+
+	1 + j + j*j = 0;
+
+is a simple matter of writing:
+
+	$j = ((root(1, 3))[1];
+
+The I<k>th root for C<z = [r,t]> is given by:
+
+	(root(z, n))[k] = r**(1/n) * exp(i * (t + 2*k*pi)/n)
+
+The I<spaceship> comparison operator, E<lt>=E<gt>, is also defined. In
+order to ensure its restriction to real numbers is conform to what you
+would expect, the comparison is run on the real part of the complex
+number first, and imaginary parts are compared only when the real
+parts match.
+
+=head1 CREATION
+
+To create a complex number, use either:
+
+	$z = Math::Complex->make(3, 4);
+	$z = cplx(3, 4);
+
+if you know the cartesian form of the number, or
+
+	$z = 3 + 4*i;
+
+if you like. To create a number using the trigonometric form, use either:
+
+	$z = Math::Complex->emake(5, pi/3);
+	$x = cplxe(5, pi/3);
+
+instead. The first argument is the modulus, the second is the angle
+(in radians, the full circle is 2*pi).  (Mnmemonic: C<e> is used as a
+notation for complex numbers in the trigonometric form).
+
+It is possible to write:
+
+	$x = cplxe(-3, pi/4);
+
+but that will be silently converted into C<[3,-3pi/4]>, since the modulus
+must be positive (it represents the distance to the origin in the complex
+plane).
+
+=head1 STRINGIFICATION
+
+When printed, a complex number is usually shown under its cartesian
+form I<a+bi>, but there are legitimate cases where the polar format
+I<[r,t]> is more appropriate.
+
+By calling the routine C<Math::Complex::display_format> and supplying either
+C<"polar"> or C<"cartesian">, you override the default display format,
+which is C<"cartesian">. Not supplying any argument returns the current
+setting.
+
+This default can be overridden on a per-number basis by calling the
+C<display_format> method instead. As before, not supplying any argument
+returns the current display format for this number. Otherwise whatever you
+specify will be the new display format for I<this> particular number.
+
+For instance:
+
+	use Math::Complex;
+
+	Math::Complex::display_format('polar');
+	$j = ((root(1, 3))[1];
+	print "j = $j\n";		# Prints "j = [1,2pi/3]
+	$j->display_format('cartesian');
+	print "j = $j\n";		# Prints "j = -0.5+0.866025403784439i"
+
+The polar format attempts to emphasize arguments like I<k*pi/n>
+(where I<n> is a positive integer and I<k> an integer within [-9,+9]).
+
+=head1 USAGE
+
+Thanks to overloading, the handling of arithmetics with complex numbers
+is simple and almost transparent.
+
+Here are some examples:
+
+	use Math::Complex;
+
+	$j = cplxe(1, 2*pi/3);	# $j ** 3 == 1
+	print "j = $j, j**3 = ", $j ** 3, "\n";
+	print "1 + j + j**2 = ", 1 + $j + $j**2, "\n";
+
+	$z = -16 + 0*i;			# Force it to be a complex
+	print "sqrt($z) = ", sqrt($z), "\n";
+
+	$k = exp(i * 2*pi/3);
+	print "$j - $k = ", $j - $k, "\n";
+
+=head1 ERRORS DUE TO DIVISION BY ZERO
+
+The division (/) and the following functions
+
+	tan
+	sec
+	csc
+	cot
+	asec
+	acsc
+	atan
+	acot
+	tanh
+	sech
+	csch
+	coth
+	atanh
+	asech
+	acsch
+	acoth
+
+cannot be computed for all arguments because that would mean dividing
+by zero. These situations cause fatal runtime errors looking like this
+
+	cot(0): Division by zero.
+	(Because in the definition of cot(0), the divisor sin(0) is 0)
+	Died at ...
+
+For the C<csc>, C<cot>, C<asec>, C<acsc>, C<csch>, C<coth>, C<asech>,
+C<acsch>, the argument cannot be C<0> (zero). For the C<atanh>,
+C<acoth>, the argument cannot be C<1> (one). For the C<atan>, C<acot>,
+the argument cannot be C<i> (the imaginary unit).  For the C<tan>,
+C<sec>, C<tanh>, C<sech>, the argument cannot be I<pi/2 + k * pi>, where
+I<k> is any integer.
 
 =head1 BUGS
 
-sqrt() should return two roots, but only returns one.
+Saying C<use Math::Complex;> exports many mathematical routines in the
+caller environment and even overrides some (C<sin>, C<cos>, C<sqrt>,
+C<log>, C<exp>).  This is construed as a feature by the Authors,
+actually... ;-)
+
+The code is not optimized for speed, although we try to use the cartesian
+form for addition-like operators and the trigonometric form for all
+multiplication-like operators.
+
+The arg() routine does not ensure the angle is within the range [-pi,+pi]
+(a side effect caused by multiplication and division using the trigonometric
+representation).
+
+All routines expect to be given real or complex numbers. Don't attempt to
+use BigFloat, since Perl has currently no rule to disambiguate a '+'
+operation (for instance) between two overloaded entities.
 
 =head1 AUTHORS
 
-Dave Nadler, Tom Christiansen, Tim Bunce, Larry Wall.
+Raphael Manfredi <F<Raphael_Manfredi@grenoble.hp.com>> and
+Jarkko Hietaniemi <F<jhi@iki.fi>>.
 
 =cut
+
+# eof
diff --git a/lib/Math/Trig.pm b/lib/Math/Trig.pm
new file mode 100644
index 0000000000..c9c045d15d
--- /dev/null
+++ b/lib/Math/Trig.pm
@@ -0,0 +1,226 @@
+#
+# Trigonometric functions, mostly inherited from Math::Complex.
+# -- Jarkko Hietaniemi, April 1997
+# -- Raphael Manfredi, September 1996 (indirectly: because of Math::Complex)
+#
+
+require Exporter;
+package Math::Trig;
+
+use strict;
+
+use Math::Complex qw(:trig);
+
+use vars qw($VERSION $PACKAGE
+	    @ISA
+	    @EXPORT);
+
+@ISA = qw(Exporter);
+
+$VERSION = 1.00;
+
+my @angcnv = qw(rad2deg rad2grad
+	     deg2rad deg2grad
+	     grad2rad grad2deg);
+
+@EXPORT = (@{$Math::Complex::EXPORT_TAGS{'trig'}},
+	   @angcnv);
+
+use constant pi2 => 2 * pi;
+use constant DR  => pi2/360;
+use constant RD  => 360/pi2;
+use constant DG  => 400/360;
+use constant GD  => 360/400;
+use constant RG  => 400/pi2;
+use constant GR  => pi2/400;
+
+#
+# Truncating remainder.
+#
+
+sub remt ($$) {
+    # Oh yes, POSIX::fmod() would be faster. Possibly. If it is available.
+    $_[0] - $_[1] * int($_[0] / $_[1]);
+}
+
+#
+# Angle conversions.
+#
+
+sub rad2deg ($)  { remt(RD * $_[0], 360) }
+
+sub deg2rad ($)  { remt(DR * $_[0], pi2) }
+
+sub grad2deg ($) { remt(GD * $_[0], 360) }
+
+sub deg2grad ($) { remt(DG * $_[0], 400) }
+
+sub rad2grad ($) { remt(RG * $_[0], 400) }
+
+sub grad2rad ($) { remt(GR * $_[0], pi2) }
+
+=head1 NAME
+
+Math::Trig - trigonometric functions
+
+=head1 SYNOPSIS
+
+	use Math::Trig;
+	
+	$x = tan(0.9);
+	$y = acos(3.7);
+	$z = asin(2.4);
+	
+	$halfpi = pi/2;
+
+	$rad = deg2rad(120);
+
+=head1 DESCRIPTION
+
+C<Math::Trig> defines many trigonometric functions not defined by the
+core Perl which defines only the C<sin()> and C<cos()>.  The constant
+B<pi> is also defined as are a few convenience functions for angle
+conversions.
+
+=head1 TRIGONOMETRIC FUNCTIONS
+
+The tangent
+
+	tan
+
+The cofunctions of the sine, cosine, and tangent (cosec/csc and cotan/cot
+are aliases)
+
+	csc cosec sec cot cotan
+
+The arcus (also known as the inverse) functions of the sine, cosine,
+and tangent
+
+	asin acos atan
+
+The principal value of the arc tangent of y/x
+
+	atan2(y, x)
+
+The arcus cofunctions of the sine, cosine, and tangent (acosec/acsc
+and acotan/acot are aliases)
+
+	acsc acosec asec acot acotan
+
+The hyperbolic sine, cosine, and tangent
+
+	sinh cosh tanh
+
+The cofunctions of the hyperbolic sine, cosine, and tangent (cosech/csch
+and cotanh/coth are aliases)
+
+	csch cosech sech coth cotanh
+
+The arcus (also known as the inverse) functions of the hyperbolic
+sine, cosine, and tangent
+
+	asinh acosh atanh
+
+The arcus cofunctions of the hyperbolic sine, cosine, and tangent
+(acsch/acosech and acoth/acotanh are aliases)
+
+	acsch acosech asech acoth acotanh
+
+The trigonometric constant B<pi> is also defined.
+
+	$pi2 = 2 * pi;
+
+=head2 ERRORS DUE TO DIVISION BY ZERO
+
+The following functions
+
+	tan
+	sec
+	csc
+	cot
+	asec
+	acsc
+	tanh
+	sech
+	csch
+	coth
+	atanh
+	asech
+	acsch
+	acoth
+
+cannot be computed for all arguments because that would mean dividing
+by zero. These situations cause fatal runtime errors looking like this
+
+	cot(0): Division by zero.
+	(Because in the definition of cot(0), the divisor sin(0) is 0)
+	Died at ...
+
+For the C<csc>, C<cot>, C<asec>, C<acsc>, C<csch>, C<coth>, C<asech>,
+C<acsch>, the argument cannot be C<0> (zero). For the C<atanh>,
+C<acoth>, the argument cannot be C<1> (one). For the C<tan>, C<sec>,
+C<tanh>, C<sech>, the argument cannot be I<pi/2 + k * pi>, where I<k> is
+any integer.
+
+=head2 SIMPLE (REAL) ARGUMENTS, COMPLEX RESULTS
+
+Please note that some of the trigonometric functions can break out
+from the B<real axis> into the B<complex plane>. For example
+C<asin(2)> has no definition for plain real numbers but it has
+definition for complex numbers.
+
+In Perl terms this means that supplying the usual Perl numbers (also
+known as scalars, please see L<perldata>) as input for the
+trigonometric functions might produce as output results that no more
+are simple real numbers: instead they are complex numbers.
+
+The C<Math::Trig> handles this by using the C<Math::Complex> package
+which knows how to handle complex numbers, please see L<Math::Complex>
+for more information. In practice you need not to worry about getting
+complex numbers as results because the C<Math::Complex> takes care of
+details like for example how to display complex numbers. For example:
+
+	print asin(2), "\n";
+    
+should produce something like this (take or leave few last decimals):
+
+	1.5707963267949-1.31695789692482i
+
+That is, a complex number with the real part of approximately C<1.571>
+and the imaginary part of approximately C<-1.317>.
+
+=head1 ANGLE CONVERSIONS
+
+(Plane, 2-dimensional) angles may be converted with the following functions.
+
+	$radians  = deg2rad($degrees);
+	$radians  = grad2rad($gradians);
+	
+	$degrees  = rad2deg($radians);
+	$degrees  = grad2deg($gradians);
+	
+	$gradians = deg2grad($degrees);
+	$gradians = rad2grad($radians);
+
+The full circle is 2 I<pi> radians or I<360> degrees or I<400> gradians.
+
+=head1 BUGS
+
+Saying C<use Math::Trig;> exports many mathematical routines in the
+caller environment and even overrides some (C<sin>, C<cos>).  This is
+construed as a feature by the Authors, actually... ;-)
+
+The code is not optimized for speed, especially because we use
+C<Math::Complex> and thus go quite near complex numbers while doing
+the computations even when the arguments are not. This, however,
+cannot be completely avoided if we want things like C<asin(2)> to give
+an answer instead of giving a fatal runtime error.
+
+=head1 AUTHORS
+
+Jarkko Hietaniemi <F<jhi@iki.fi>> and 
+Raphael Manfredi <F<Raphael_Manfredi@grenoble.hp.com>>.
+
+=cut
+
+# eof
diff --git a/lib/Net/Ping.pm b/lib/Net/Ping.pm
index 3ba88d5751..91077ddad1 100644
--- a/lib/Net/Ping.pm
+++ b/lib/Net/Ping.pm
@@ -1,106 +1,550 @@
 package Net::Ping;
 
-# Authors: karrer@bernina.ethz.ch (Andreas Karrer)
-#          pmarquess@bfsec.bt.co.uk (Paul Marquess)
-
-require 5.002 ;
+# Author:   mose@ccsn.edu (Russell Mosemann)
+#
+# Authors of the original pingecho():
+#           karrer@bernina.ethz.ch (Andreas Karrer)
+#           pmarquess@bfsec.bt.co.uk (Paul Marquess)
+#
+# Copyright (c) 1996 Russell Mosemann.  All rights reserved.  This
+# program is free software; you may redistribute it and/or modify it
+# under the same terms as Perl itself.
+
+require 5.002;
 require Exporter;
 
-use strict ;
-use vars qw(@ISA @EXPORT $VERSION $tcp_proto $echo_port) ;
+use strict;
+use vars qw(@ISA @EXPORT $VERSION
+            $def_timeout $def_proto $max_datasize);
+use FileHandle;
+use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW PF_INET
+               inet_aton sockaddr_in );
+use Carp;
 
 @ISA = qw(Exporter);
-@EXPORT = qw(ping pingecho);
-$VERSION = 1.01;
-
-use Socket 'PF_INET', 'AF_INET', 'SOCK_STREAM';
-use Carp ;
-
-$tcp_proto = (getprotobyname('tcp'))[2];
-$echo_port = (getservbyname('echo', 'tcp'))[2];
-
-sub ping {
-    croak "ping not implemented yet. Use pingecho()";
-}
+@EXPORT = qw(pingecho);
+$VERSION = 2.02;
 
+# Constants
 
-sub pingecho {
+$def_timeout = 5;           # Default timeout to wait for a reply
+$def_proto = "udp";         # Default protocol to use for pinging
+$max_datasize = 1024;       # Maximum data bytes in a packet
 
-    croak "usage: pingecho host [timeout]" 
-        unless @_ == 1 or @_ == 2 ;
+# Description:  The pingecho() subroutine is provided for backward
+# compatibility with the original Net::Ping.  It accepts a host
+# name/IP and an optional timeout in seconds.  Create a tcp ping
+# object and try pinging the host.  The result of the ping is returned.
 
-    my ($host, $timeout) = @_;
-    my ($saddr, $ip);
-    my ($ret) ;
-    local (*PINGSOCK);
+sub pingecho
+{
+    my ($host,              # Name or IP number of host to ping
+        $timeout            # Optional timeout in seconds
+        ) = @_;
+    my ($p);                # A ping object
 
-    # check if $host is alive by connecting to its echo port, within $timeout
-    # (default 5) seconds. returns 1 if OK, 0 if no answer, 0 if host not found
+    $p = Net::Ping->new("tcp", $timeout);
+    $p->ping($host);        # Going out of scope closes the connection
+}
 
-    $timeout = 5 unless $timeout;
+# Description:  The new() method creates a new ping object.  Optional
+# parameters may be specified for the protocol to use, the timeout in
+# seconds and the size in bytes of additional data which should be
+# included in the packet.
+#   After the optional parameters are checked, the data is constructed
+# and a socket is opened if appropriate.  The object is returned.
+
+sub new
+{
+    my ($this,
+        $proto,             # Optional protocol to use for pinging
+        $timeout,           # Optional timeout in seconds
+        $data_size          # Optional additional bytes of data
+        ) = @_;
+    my  $class = ref($this) || $this;
+    my  $self = {};
+    my ($cnt,               # Count through data bytes
+        $min_datasize       # Minimum data bytes required
+        );
+
+    bless($self, $class);
+
+    $proto = $def_proto unless $proto;          # Determine the protocol
+    croak("Protocol for ping must be \"tcp\", \"udp\" or \"icmp\"")
+        unless $proto =~ m/^(tcp|udp|icmp)$/;
+    $self->{"proto"} = $proto;
+
+    $timeout = $def_timeout unless $timeout;    # Determine the timeout
+    croak("Default timeout for ping must be greater than 0 seconds")
+        if $timeout <= 0;
+    $self->{"timeout"} = $timeout;
+
+    $min_datasize = ($proto eq "udp") ? 1 : 0;  # Determine data size
+    $data_size = $min_datasize unless defined($data_size) && $proto ne "tcp";
+    croak("Data for ping must be from $min_datasize to $max_datasize bytes")
+        if ($data_size < $min_datasize) || ($data_size > $max_datasize);
+    $data_size-- if $self->{"proto"} eq "udp";  # We provide the first byte
+    $self->{"data_size"} = $data_size;
+
+    $self->{"data"} = "";                       # Construct data bytes
+    for ($cnt = 0; $cnt < $self->{"data_size"}; $cnt++)
+    {
+        $self->{"data"} .= chr($cnt % 256);
+    }
+
+    $self->{"seq"} = 0;                         # For counting packets
+    if ($self->{"proto"} eq "udp")              # Open a socket
+    {
+        $self->{"proto_num"} = (getprotobyname('udp'))[2] ||
+            croak("Can't udp protocol by name");
+        $self->{"port_num"} = (getservbyname('echo', 'udp'))[2] ||
+            croak("Can't get udp echo port by name");
+        $self->{"fh"} = FileHandle->new();
+        socket($self->{"fh"}, &PF_INET(), &SOCK_DGRAM(),
+               $self->{"proto_num"}) ||
+            croak("udp socket error - $!");
+    }
+    elsif ($self->{"proto"} eq "icmp")
+    {
+        croak("icmp ping requires root privilege") if $>;
+        $self->{"proto_num"} = (getprotobyname('icmp'))[2] ||
+                    croak("Can't get icmp protocol by name");
+        $self->{"pid"} = $$ & 0xffff;           # Save lower 16 bits of pid
+        $self->{"fh"} = FileHandle->new();
+        socket($self->{"fh"}, &PF_INET(), &SOCK_RAW(), $self->{"proto_num"}) ||
+            croak("icmp socket error - $!");
+    }
+    elsif ($self->{"proto"} eq "tcp")           # Just a file handle for now
+    {
+        $self->{"proto_num"} = (getprotobyname('tcp'))[2] ||
+            croak("Can't get tcp protocol by name");
+        $self->{"port_num"} = (getservbyname('echo', 'tcp'))[2] ||
+            croak("Can't get tcp echo port by name");
+        $self->{"fh"} = FileHandle->new();
+    }
+
+
+    return($self);
+}
 
-    if ($host =~ /^\s*((\d+\.){3}\d+)\s*$/)
-      { $ip = pack ('C4', split (/\./, $1)) }
+# Description: Ping a host name or IP number with an optional timeout.
+# First lookup the host, and return undef if it is not found.  Otherwise
+# perform the specific ping method based on the protocol.  Return the 
+# result of the ping.
+
+sub ping
+{
+    my ($self,
+        $host,              # Name or IP number of host to ping
+        $timeout            # Seconds after which ping times out
+        ) = @_;
+    my ($ip,                # Packed IP number of $host
+        $ret                # The return value
+        );
+
+    croak("Usage: \$p->ping(\$host [, \$timeout])") unless @_ == 2 || @_ == 3;
+    $timeout = $self->{"timeout"} unless $timeout;
+    croak("Timeout must be greater than 0 seconds") if $timeout <= 0;
+
+    $ip = inet_aton($host);
+    return(undef) unless defined($ip);      # Does host exist?
+
+    if ($self->{"proto"} eq "udp")
+    {
+        $ret = $self->ping_udp($ip, $timeout);
+    }
+    elsif ($self->{"proto"} eq "icmp")
+    {
+        $ret = $self->ping_icmp($ip, $timeout);
+    }
+    elsif ($self->{"proto"} eq "tcp")
+    {
+        $ret = $self->ping_tcp($ip, $timeout);
+    }
     else
-      { $ip = (gethostbyname($host))[4] }
-
-    return 0 unless $ip;		# "no such host"
+    {
+        croak("Unknown protocol \"$self->{proto}\" in ping()");
+    }
+    return($ret);
+}
 
-    $saddr = pack('S n a4 x8', AF_INET, $echo_port, $ip);
-    $SIG{'ALRM'} = sub { die } ;
-    alarm($timeout);
-    
+sub ping_icmp
+{
+    my ($self,
+        $ip,                # Packed IP number of the host
+        $timeout            # Seconds after which ping times out
+        ) = @_;
+
+    my $ICMP_ECHOREPLY = 0; # ICMP packet types
+    my $ICMP_ECHO = 8;
+    my $icmp_struct = "C2 S3 A";  # Structure of a minimal ICMP packet
+    my $subcode = 0;        # No ICMP subcode for ECHO and ECHOREPLY
+    my $flags = 0;          # No special flags when opening a socket
+    my $port = 0;           # No port with ICMP
+
+    my ($saddr,             # sockaddr_in with port and ip
+        $checksum,          # Checksum of ICMP packet
+        $msg,               # ICMP packet to send
+        $len_msg,           # Length of $msg
+        $rbits,             # Read bits, filehandles for reading
+        $nfound,            # Number of ready filehandles found
+        $finish_time,       # Time ping should be finished
+        $done,              # set to 1 when we are done
+        $ret,               # Return value
+        $recv_msg,          # Received message including IP header
+        $from_saddr,        # sockaddr_in of sender
+        $from_port,         # Port packet was sent from
+        $from_ip,           # Packed IP of sender
+        $from_type,         # ICMP type
+        $from_subcode,      # ICMP subcode
+        $from_chk,          # ICMP packet checksum
+        $from_pid,          # ICMP packet id
+        $from_seq,          # ICMP packet sequence
+        $from_msg           # ICMP message
+        );
+
+    $self->{"seq"} = ($self->{"seq"} + 1) % 65536; # Increment sequence
+    $checksum = 0;                          # No checksum for starters
+    $msg = pack($icmp_struct . $self->{"data_size"}, $ICMP_ECHO, $subcode,
+                $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
+    $checksum = Net::Ping->checksum($msg);
+    $msg = pack($icmp_struct . $self->{"data_size"}, $ICMP_ECHO, $subcode,
+                $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
+    $len_msg = length($msg);
+    $saddr = sockaddr_in($port, $ip);
+    send($self->{"fh"}, $msg, $flags, $saddr); # Send the message
+
+    $rbits = "";
+    vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
     $ret = 0;
+    $done = 0;
+    $finish_time = time() + $timeout;       # Must be done by this time
+    while (!$done && $timeout > 0)          # Keep trying if we have time
+    {
+        $nfound = select($rbits, undef, undef, $timeout); # Wait for packet
+        $timeout = $finish_time - time();   # Get remaining time
+        if (!defined($nfound))              # Hmm, a strange error
+        {
+            $ret = undef;
+            $done = 1;
+        }
+        elsif ($nfound)                     # Got a packet from somewhere
+        {
+            $recv_msg = "";
+            $from_saddr = recv($self->{"fh"}, $recv_msg, 1500, $flags);
+            ($from_port, $from_ip) = sockaddr_in($from_saddr);
+            ($from_type, $from_subcode, $from_chk,
+             $from_pid, $from_seq, $from_msg) =
+                unpack($icmp_struct . $self->{"data_size"},
+                       substr($recv_msg, length($recv_msg) - $len_msg,
+                              $len_msg));
+            if (($from_type == $ICMP_ECHOREPLY) &&
+                ($from_ip eq $ip) &&
+                ($from_pid == $self->{"pid"}) && # Does the packet check out?
+                ($from_seq == $self->{"seq"}))
+            {
+                $ret = 1;                   # It's a winner
+                $done = 1;
+            }
+        }
+        else                                # Oops, timed out
+        {
+            $done = 1;
+        }
+    }
+    return($ret)
+}
+
+# Description:  Do a checksum on the message.  Basically sum all of
+# the short words and fold the high order bits into the low order bits.
+
+sub checksum
+{
+    my ($class,
+        $msg            # The message to checksum
+        ) = @_;
+    my ($len_msg,       # Length of the message
+        $num_short,     # The number of short words in the message
+        $short,         # One short word
+        $chk            # The checksum
+        );
+
+    $len_msg = length($msg);
+    $num_short = $len_msg / 2;
+    $chk = 0;
+    foreach $short (unpack("S$num_short", $msg))
+    {
+        $chk += $short;
+    }                                           # Add the odd byte in
+    $chk += unpack("C", substr($msg, $len_msg - 1, 1)) if $len_msg % 2;
+    $chk = ($chk >> 16) + ($chk & 0xffff);      # Fold high into low
+    return(~(($chk >> 16) + $chk) & 0xffff);    # Again and complement
+}
+
+# Description:  Perform a tcp echo ping.  Since a tcp connection is
+# host specific, we have to open and close each connection here.  We
+# can't just leave a socket open.  Because of the robust nature of
+# tcp, it will take a while before it gives up trying to establish a
+# connection.  Therefore, we have to set the alarm to break out of the
+# connection sooner if the timeout expires.  No data bytes are actually
+# sent since the successful establishment of a connection is proof
+# enough of the reachability of the remote host.  Also, tcp is
+# expensive and doesn't need our help to add to the overhead.
+
+sub ping_tcp
+{
+    my ($self,
+        $ip,                # Packed IP number of the host
+        $timeout            # Seconds after which ping times out
+        ) = @_;
+    my ($saddr,             # sockaddr_in with port and ip
+        $ret                # The return value
+        );
+                            
+    socket($self->{"fh"}, &PF_INET(), &SOCK_STREAM(), $self->{"proto_num"}) ||
+        croak("tcp socket error - $!");
+    $saddr = sockaddr_in($self->{"port_num"}, $ip);
+
+    $SIG{'ALRM'} = sub { die };
+    alarm($timeout);        # Interrupt connect() if we have to
+            
+    $ret = 0;               # Default to unreachable
     eval <<'EOM' ;
-    return unless socket(PINGSOCK, PF_INET, SOCK_STREAM, $tcp_proto) ;
-    return unless connect(PINGSOCK, $saddr) ;
-    $ret=1 ;
+        return unless connect($self->{"fh"}, $saddr);
+        $ret = 1;
 EOM
     alarm(0);
-    close(PINGSOCK);
-    $ret;
+    $self->{"fh"}->close();
+    return($ret);
+}
+
+# Description:  Perform a udp echo ping.  Construct a message of
+# at least the one-byte sequence number and any additional data bytes.
+# Send the message out and wait for a message to come back.  If we
+# get a message, make sure all of its parts match.  If they do, we are
+# done.  Otherwise go back and wait for the message until we run out
+# of time.  Return the result of our efforts.
+
+sub ping_udp
+{
+    my ($self,
+        $ip,                # Packed IP number of the host
+        $timeout            # Seconds after which ping times out
+        ) = @_;
+
+    my $flags = 0;          # Nothing special on open
+
+    my ($saddr,             # sockaddr_in with port and ip
+        $ret,               # The return value
+        $msg,               # Message to be echoed
+        $finish_time,       # Time ping should be finished
+        $done,              # Set to 1 when we are done pinging
+        $rbits,             # Read bits, filehandles for reading
+        $nfound,            # Number of ready filehandles found
+        $from_saddr,        # sockaddr_in of sender
+        $from_msg,          # Characters echoed by $host
+        $from_port,         # Port message was echoed from
+        $from_ip            # Packed IP number of sender
+        );
+
+    $saddr = sockaddr_in($self->{"port_num"}, $ip);
+    $self->{"seq"} = ($self->{"seq"} + 1) % 256;    # Increment sequence
+    $msg = chr($self->{"seq"}) . $self->{"data"};   # Add data if any
+    send($self->{"fh"}, $msg, $flags, $saddr);      # Send it
+
+    $rbits = "";
+    vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
+    $ret = 0;                   # Default to unreachable
+    $done = 0;
+    $finish_time = time() + $timeout;       # Ping needs to be done by then
+    while (!$done && $timeout > 0)
+    {
+        $nfound = select($rbits, undef, undef, $timeout); # Wait for response
+        $timeout = $finish_time - time();   # Get remaining time
+
+        if (!defined($nfound))  # Hmm, a strange error
+        {
+            $ret = undef;
+            $done = 1;
+        }
+        elsif ($nfound)         # A packet is waiting
+        {
+            $from_msg = "";
+            $from_saddr = recv($self->{"fh"}, $from_msg, 1500, $flags);
+            ($from_port, $from_ip) = sockaddr_in($from_saddr);
+            if (($from_ip eq $ip) &&        # Does the packet check out?
+                ($from_port == $self->{"port_num"}) &&
+                ($from_msg eq $msg))
+            {
+                $ret = 1;       # It's a winner
+                $done = 1;
+            }
+        }
+        else                    # Oops, timed out
+        {
+            $done = 1;
+        }
+    }
+    return($ret);
 }   
 
+# Description:  Close the connection unless we are using the tcp
+# protocol, since it will already be closed.
+
+sub close
+{
+    my ($self) = @_;
+
+    $self->{"fh"}->close() unless $self->{"proto"} eq "tcp";
+}
+
+
 1;
 __END__
 
-=cut
-
 =head1 NAME
 
-Net::Ping, pingecho - check a host for upness
+Net::Ping - check a remote host for reachability
 
 =head1 SYNOPSIS
 
     use Net::Ping;
-    print "'jimmy' is alive and kicking\n" if pingecho('jimmy', 10) ;
-
-=head1 DESCRIPTION
 
-This module contains routines to test for the reachability of remote hosts.
-Currently the only routine implemented is pingecho(). 
+    $p = Net::Ping->new();
+    print "$host is alive.\n" if $p->ping($host);
+    $p->close();
+
+    $p = Net::Ping->new("icmp");
+    foreach $host (@host_array)
+    {
+        print "$host is ";
+        print "NOT " unless $p->ping($host, 2);
+        print "reachable.\n";
+        sleep(1);
+    }
+    $p->close();
+    
+    $p = Net::Ping->new("tcp", 2);
+    while ($stop_time > time())
+    {
+        print "$host not reachable ", scalar(localtime()), "\n"
+            unless $p->ping($host);
+        sleep(300);
+    }
+    undef($p);
+    
+    # For backward compatibility
+    print "$host is alive.\n" if pingecho($host);
 
-pingecho() uses a TCP echo (I<not> an ICMP one) to determine if the
-remote host is reachable. This is usually adequate to tell that a remote
-host is available to rsh(1), ftp(1), or telnet(1) onto.
+=head1 DESCRIPTION
 
-=head2 Parameters
+This module contains methods to test the reachability of remote
+hosts on a network.  A ping object is first created with optional
+parameters, a variable number of hosts may be pinged multiple
+times and then the connection is closed.
+
+You may choose one of three different protocols to use for the ping.
+With the "tcp" protocol the ping() method attempts to establish a
+connection to the remote host's echo port.  If the connection is
+successfully established, the remote host is considered reachable.  No
+data is actually echoed.  This protocol does not require any special
+privileges but has higher overhead than the other two protocols.
+
+Specifying the "udp" protocol causes the ping() method to send a udp
+packet to the remote host's echo port.  If the echoed packet is
+received from the remote host and the received packet contains the
+same data as the packet that was sent, the remote host is considered
+reachable.  This protocol does not require any special privileges.
+
+If the "icmp" protocol is specified, the ping() method sends an icmp
+echo message to the remote host, which is what the UNIX ping program
+does.  If the echoed message is received from the remote host and
+the echoed information is correct, the remote host is considered
+reachable.  Specifying the "icmp" protocol requires that the program
+be run as root or that the program be setuid to root.
+
+=head2 Functions
+
+=over 4
+
+=item Net::Ping->new([$proto [, $def_timeout [, $bytes]]]);
+
+Create a new ping object.  All of the parameters are optional.  $proto
+specifies the protocol to use when doing a ping.  The current choices
+are "tcp", "udp" or "icmp".  The default is "udp".
+
+If a default timeout ($def_timeout) in seconds is provided, it is used
+when a timeout is not given to the ping() method (below).  The timeout
+must be greater than 0 and the default, if not specified, is 5 seconds.
+
+If the number of data bytes ($bytes) is given, that many data bytes
+are included in the ping packet sent to the remote host. The number of
+data bytes is ignored if the protocol is "tcp".  The minimum (and
+default) number of data bytes is 1 if the protocol is "udp" and 0
+otherwise.  The maximum number of data bytes that can be specified is
+1024.
+
+=item $p->ping($host [, $timeout]);
+
+Ping the remote host and wait for a response.  $host can be either the
+hostname or the IP number of the remote host.  The optional timeout
+must be greater than 0 seconds and defaults to whatever was specified
+when the ping object was created.  If the hostname cannot be found or
+there is a problem with the IP number, undef is returned.  Otherwise,
+1 is returned if the host is reachable and 0 if it is not.  For all
+practical purposes, undef and 0 and can be treated as the same case.
+
+=item $p->close();
+
+Close the network connection for this ping object.  The network
+connection is also closed by "undef $p".  The network connection is
+automatically closed if the ping object goes out of scope (e.g. $p is
+local to a subroutine and you leave the subroutine).
+
+=item pingecho($host [, $timeout]);
+
+To provide backward compatibility with the previous version of
+Net::Ping, a pingecho() subroutine is available with the same
+functionality as before.  pingecho() uses the tcp protocol.  The
+return values and parameters are the same as described for the ping()
+method.  This subroutine is obsolete and may be removed in a future
+version of Net::Ping.
 
-=over 5
+=back
 
-=item hostname
+=head1 WARNING
 
-The remote host to check, specified either as a hostname or as an IP address.
+pingecho() or a ping object with the tcp protocol use alarm() to
+implement the timeout.  So, don't use alarm() in your program while
+you are using pingecho() or a ping object with the tcp protocol.  The
+udp and icmp protocols do not use alarm() to implement the timeout.
 
-=item timeout
+=head1 NOTES
 
-The timeout in seconds. If not specified it will default to 5 seconds.
+There will be less network overhead (and some efficiency in your
+program) if you specify either the udp or the icmp protocol.  The tcp
+protocol will generate 2.5 times or more traffic for each ping than
+either udp or icmp.  If many hosts are pinged frequently, you may wish
+to implement a small wait (e.g. 25ms or more) between each ping to
+avoid flooding your network with packets.
 
-=back
+The icmp protocol requires that the program be run as root or that it
+be setuid to root.  The tcp and udp protocols do not require special
+privileges, but not all network devices implement the echo protocol
+for tcp or udp.
 
-=head1 WARNING
+Local hosts should normally respond to pings within milliseconds.
+However, on a very congested network it may take up to 3 seconds or
+longer to receive an echo packet from the remote host.  If the timeout
+is set too low under these conditions, it will appear that the remote
+host is not reachable (which is almost the truth).
 
-pingecho() uses alarm to implement the timeout, so don't set another alarm
-while you are using it.
+Reachability doesn't necessarily mean that the remote host is actually
+functioning beyond its ability to echo packets.
 
+Because of a lack of anything better, this module uses its own
+routines to pack and unpack ICMP packets.  It would be better for a
+separate module to be written which understands all of the different
+kinds of ICMP packets.
 
+=cut
diff --git a/lib/Net/hostent.pm b/lib/Net/hostent.pm
new file mode 100644
index 0000000000..dfca789817
--- /dev/null
+++ b/lib/Net/hostent.pm
@@ -0,0 +1,149 @@
+package Net::hostent;
+use strict;
+
+BEGIN { 
+    use Exporter   ();
+    use vars       qw(@EXPORT @EXPORT_OK %EXPORT_TAGS);
+    @EXPORT      = qw(gethostbyname gethostbyaddr gethost);
+    @EXPORT_OK   = qw(
+			$h_name	    	@h_aliases
+			$h_addrtype 	$h_length
+			@h_addr_list 	$h_addr
+		   );
+    %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
+}
+use vars      @EXPORT_OK;
+
+# Class::Struct forbids use of @ISA
+sub import { goto &Exporter::import }
+
+use Class::Struct qw(struct);
+struct 'Net::hostent' => [
+   name		=> '$',
+   aliases	=> '@',
+   addrtype	=> '$',
+   'length'	=> '$',
+   addr_list	=> '@',
+];
+
+sub addr { shift->addr_list->[0] }
+
+sub populate (@) {
+    return unless @_;
+    my $hob = new();
+    $h_name 	 =    $hob->[0]     	     = $_[0];
+    @h_aliases	 = @{ $hob->[1] } = split ' ', $_[1];
+    $h_addrtype  =    $hob->[2] 	     = $_[2];
+    $h_length	 =    $hob->[3] 	     = $_[3];
+    $h_addr 	 =                             $_[4];
+    @h_addr_list = @{ $hob->[4] } =          @_[ (4 .. $#_) ];
+    return $hob;
+} 
+
+sub gethostbyname ($)  { populate(CORE::gethostbyname(shift)) } 
+
+sub gethostbyaddr ($;$) { 
+    my ($addr, $addrtype);
+    $addr = shift;
+    require Socket unless @_;
+    $addrtype = @_ ? shift : Socket::AF_INET();
+    populate(CORE::gethostbyaddr($addr, $addrtype)) 
+} 
+
+sub gethost($) {
+    if ($_[0] =~ /^\d+(?:\.\d+(?:\.\d+(?:\.\d+)?)?)?$/) {
+	require Socket;
+	&gethostbyaddr(Socket::inet_aton(shift));
+    } else {
+	&gethostbyname;
+    } 
+} 
+
+1;
+__END__
+
+=head1 NAME
+
+Net::hostent - by-name interface to Perl's built-in gethost*() functions
+
+=head1 SYNOPSIS
+
+ use Net::hostnet;
+
+=head1 DESCRIPTION
+
+This module's default exports override the core gethostbyname() and
+gethostbyaddr() functions, replacing them with versions that return
+"Net::hostent" objects.  This object has methods that return the similarly
+named structure field name from the C's hostent structure from F<netdb.h>;
+namely name, aliases, addrtype, length, and addresses.  The aliases and
+addresses methods return array reference, the rest scalars.  The addr
+method is equivalent to the zeroth element in the addresses array
+reference.
+
+You may also import all the structure fields directly into your namespace
+as regular variables using the :FIELDS import tag.  (Note that this still
+overrides your core functions.)  Access these fields as variables named
+with a preceding C<h_>.  Thus, C<$host_obj-E<gt>name()> corresponds to
+$h_name if you import the fields.  Array references are available as
+regular array variables, so for example C<@{ $host_obj-E<gt>aliases()
+}> would be simply @h_aliases.
+
+The gethost() funtion is a simple front-end that forwards a numeric
+argument to gethostbyaddr() by way of Socket::inet_aton, and the rest
+to gethostbyname().
+
+To access this functionality without the core overrides,
+pass the C<use> an empty import list, and then access
+function functions with their full qualified names.
+On the other hand, the built-ins are still available
+via the C<CORE::> pseudo-package.
+
+=head1 EXAMPLES
+
+ use Net::hostent;
+ use Socket;
+
+ @ARGV = ('netscape.com') unless @ARGV;
+
+ for $host ( @ARGV ) {
+
+    unless ($h = gethost($host)) {
+	warn "$0: no such host: $host\n";
+	next;
+    }
+
+    printf "\n%s is %s%s\n", 
+	    $host, 
+	    lc($h->name) eq lc($host) ? "" : "*really* ",
+	    $h->name;
+
+    print "\taliases are ", join(", ", @{$h->aliases}), "\n"
+		if @{$h->aliases};     
+
+    if ( @{$h->addr_list} > 1 ) { 
+	my $i;
+	for $addr ( @{$h->addr_list} ) {
+	    printf "\taddr #%d is [%s]\n", $i++, inet_ntoa($addr);
+	} 
+    } else {
+	printf "\taddress is [%s]\n", inet_ntoa($h->addr);
+    } 
+
+    if ($h = gethostbyaddr($h->addr)) {
+	if (lc($h->name) ne lc($host)) {
+	    printf "\tThat addr reverses to host %s!\n", $h->name;
+	    $host = $h->name;
+	    redo;
+	} 
+    }
+ }
+
+=head1 NOTE
+
+While this class is currently implemented using the Class::Struct
+module to build a struct-like class, you shouldn't rely upon this.
+
+=head1 AUTHOR
+
+Tom Christiansen
diff --git a/lib/Net/netent.pm b/lib/Net/netent.pm
new file mode 100644
index 0000000000..b82447cad7
--- /dev/null
+++ b/lib/Net/netent.pm
@@ -0,0 +1,167 @@
+package Net::netent;
+use strict;
+
+BEGIN { 
+    use Exporter   ();
+    use vars       qw(@EXPORT @EXPORT_OK %EXPORT_TAGS);
+    @EXPORT      = qw(getnetbyname getnetbyaddr getnet);
+    @EXPORT_OK   = qw(
+			$n_name	    	@n_aliases
+			$n_addrtype 	$n_net
+		   );
+    %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
+}
+use vars      @EXPORT_OK;
+
+# Class::Struct forbids use of @ISA
+sub import { goto &Exporter::import }
+
+use Class::Struct qw(struct);
+struct 'Net::netent' => [
+   name		=> '$',
+   aliases	=> '@',
+   addrtype	=> '$',
+   net		=> '$',
+];
+
+sub populate (@) {
+    return unless @_;
+    my $nob = new();
+    $n_name 	 =    $nob->[0]     	     = $_[0];
+    @n_aliases	 = @{ $nob->[1] } = split ' ', $_[1];
+    $n_addrtype  =    $nob->[2] 	     = $_[2];
+    $n_net	 =    $nob->[3] 	     = $_[3];
+    return $nob;
+} 
+
+sub getnetbyname ($)  { populate(CORE::getnetbyname(shift)) } 
+
+sub getnetbyaddr ($;$) { 
+    my ($net, $addrtype);
+    $net = shift;
+    require Socket if @_;
+    $addrtype = @_ ? shift : Socket::AF_INET();
+    populate(CORE::getnetbyaddr($net, $addrtype)) 
+} 
+
+sub getnet($) {
+    if ($_[0] =~ /^\d+(?:\.\d+(?:\.\d+(?:\.\d+)?)?)?$/) {
+	require Socket;
+	&getnetbyaddr(Socket::inet_aton(shift));
+    } else {
+	&getnetbyname;
+    } 
+} 
+
+1;
+__END__
+
+=head1 NAME
+
+Net::netent - by-name interface to Perl's built-in getnet*() functions
+
+=head1 SYNOPSIS
+
+ use Net::netent qw(:FIELDS);
+ getnetbyname("loopback") 		or die "bad net";
+ printf "%s is %08X\n", $n_name, $n_net;
+
+ use Net::netent;
+
+ $n = getnetbyname("loopback") 		or die "bad net";
+ { # there's gotta be a better way, eh?
+     @bytes = unpack("C4", pack("N", $n->net));
+     shift @bytes while @bytes && $bytes[0] == 0;
+ }
+ printf "%s is %08X [%d.%d.%d.%d]\n", $n->name, $n->net, @bytes;
+
+=head1 DESCRIPTION
+
+This module's default exports override the core getnetbyname() and
+getnetbyaddr() functions, replacing them with versions that return
+"Net::netent" objects.  This object has methods that return the similarly
+named structure field name from the C's netent structure from F<netdb.h>;
+namely name, aliases, addrtype, and net.  The aliases 
+method returns an array reference, the rest scalars.  
+
+You may also import all the structure fields directly into your namespace
+as regular variables using the :FIELDS import tag.  (Note that this still
+overrides your core functions.)  Access these fields as variables named
+with a preceding C<n_>.  Thus, C<$net_obj-E<gt>name()> corresponds to
+$n_name if you import the fields.  Array references are available as
+regular array variables, so for example C<@{ $net_obj-E<gt>aliases()
+}> would be simply @n_aliases.
+
+The getnet() funtion is a simple front-end that forwards a numeric
+argument to getnetbyaddr(), and the rest
+to getnetbyname().
+
+To access this functionality without the core overrides,
+pass the C<use> an empty import list, and then access
+function functions with their full qualified names.
+On the other hand, the built-ins are still available
+via the C<CORE::> pseudo-package.
+
+=head1 EXAMPLES
+
+The getnet() functions do this in the Perl core:
+
+    sv_setiv(sv, (I32)nent->n_net);
+
+The gethost() functions do this in the Perl core:
+
+    sv_setpvn(sv, hent->h_addr, len);
+
+That means that the address comes back in binary for the
+host functions, and as a regular perl integer for the net ones.
+This seems a bug, but here's how to deal with it:
+
+ use strict;
+ use Socket;
+ use Net::netent;
+ 
+ @ARGV = ('loopback') unless @ARGV;
+ 
+ my($n, $net);
+ 
+ for $net ( @ARGV ) {
+ 
+     unless ($n = getnetbyname($net)) {
+ 	warn "$0: no such net: $net\n";
+ 	next;
+     }
+ 
+     printf "\n%s is %s%s\n", 
+ 	    $net, 
+ 	    lc($n->name) eq lc($net) ? "" : "*really* ",
+ 	    $n->name;
+ 
+     print "\taliases are ", join(", ", @{$n->aliases}), "\n"
+ 		if @{$n->aliases};     
+ 
+     # this is stupid; first, why is this not in binary?
+     # second, why am i going through these convolutions
+     # to make it looks right
+     {
+ 	my @a = unpack("C4", pack("N", $n->net));
+ 	shift @a while @a && $a[0] == 0;
+ 	printf "\taddr is %s [%d.%d.%d.%d]\n", $n->net, @a;
+     }
+ 
+     if ($n = getnetbyaddr($n->net)) {
+ 	if (lc($n->name) ne lc($net)) {
+ 	    printf "\tThat addr reverses to net %s!\n", $n->name;
+ 	    $net = $n->name;
+ 	    redo;
+ 	} 
+     }
+ }
+
+=head1 NOTE
+
+While this class is currently implemented using the Class::Struct
+module to build a struct-like class, you shouldn't rely upon this.
+
+=head1 AUTHOR
+
+Tom Christiansen
diff --git a/lib/Net/protoent.pm b/lib/Net/protoent.pm
new file mode 100644
index 0000000000..737ff5a33b
--- /dev/null
+++ b/lib/Net/protoent.pm
@@ -0,0 +1,94 @@
+package Net::protoent;
+use strict;
+
+BEGIN { 
+    use Exporter   ();
+    use vars       qw(@EXPORT @EXPORT_OK %EXPORT_TAGS);
+    @EXPORT      = qw(getprotobyname getprotobynumber getprotoent);
+    @EXPORT_OK   = qw( $p_name @p_aliases $p_proto );
+    %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
+}
+use vars      @EXPORT_OK;
+
+# Class::Struct forbids use of @ISA
+sub import { goto &Exporter::import }
+
+use Class::Struct qw(struct);
+struct 'Net::protoent' => [
+   name		=> '$',
+   aliases	=> '@',
+   proto	=> '$',
+];
+
+sub populate (@) {
+    return unless @_;
+    my $pob = new();
+    $p_name 	 =    $pob->[0]     	     = $_[0];
+    @p_aliases	 = @{ $pob->[1] } = split ' ', $_[1];
+    $p_proto	 =    $pob->[2] 	     = $_[2];
+    return $pob;
+} 
+
+sub getprotoent      ( )  { populate(CORE::getprotoent()) } 
+sub getprotobyname   ($)  { populate(CORE::getprotobyname(shift)) } 
+sub getprotobynumber ($)  { populate(CORE::getprotobynumber(shift)) } 
+
+sub getproto ($;$) {
+    no strict 'refs';
+    return &{'getprotoby' . ($_[0]=~/^\d+$/ ? 'number' : 'name')}(@_);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Net::protoent - by-name interface to Perl's built-in getproto*() functions
+
+=head1 SYNOPSIS
+
+ use Net::protoent;
+ $p = getprotobyname(shift || 'tcp') || die "no proto";
+ printf "proto for %s is %d, aliases are %s\n",
+    $p->name, $p->proto, "@{$p->aliases}";
+
+ use Net::protoent qw(:FIELDS);
+ getprotobyname(shift || 'tcp') || die "no proto";
+ print "proto for $p_name is $p_proto, aliases are @p_aliases\n";
+
+=head1 DESCRIPTION
+
+This module's default exports override the core getprotoent(),
+getprotobyname(), and getnetbyport() functions, replacing them with
+versions that return "Net::protoent" objects.  They take default
+second arguments of "tcp".  This object has methods that return the
+similarly named structure field name from the C's protoent structure
+from F<netdb.h>; namely name, aliases, and proto.  The aliases method
+returns an array reference, the rest scalars.
+
+You may also import all the structure fields directly into your namespace
+as regular variables using the :FIELDS import tag.  (Note that this still
+overrides your core functions.)  Access these fields as variables named
+with a preceding C<p_>.  Thus, C<$proto_obj-E<gt>name()> corresponds to
+$p_name if you import the fields.  Array references are available as
+regular array variables, so for example C<@{ $proto_obj-E<gt>aliases()
+}> would be simply @p_aliases.
+
+The getproto() function is a simple front-end that forwards a numeric
+argument to getprotobyport(), and the rest to getprotobyname().
+
+To access this functionality without the core overrides,
+pass the C<use> an empty import list, and then access
+function functions with their full qualified names.
+On the other hand, the built-ins are still available
+via the C<CORE::> pseudo-package.
+
+=head1 NOTE
+
+While this class is currently implemented using the Class::Struct
+module to build a struct-like class, you shouldn't rely upon this.
+
+=head1 AUTHOR
+
+Tom Christiansen
diff --git a/lib/Net/servent.pm b/lib/Net/servent.pm
new file mode 100644
index 0000000000..fb85dd04bf
--- /dev/null
+++ b/lib/Net/servent.pm
@@ -0,0 +1,111 @@
+package Net::servent;
+use strict;
+
+BEGIN {
+    use Exporter   ();
+    use vars       qw(@EXPORT @EXPORT_OK %EXPORT_TAGS);
+    @EXPORT      = qw(getservbyname getservbyport getservent getserv);
+    @EXPORT_OK   = qw( $s_name @s_aliases $s_port $s_proto );
+    %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
+}
+use vars      @EXPORT_OK;
+
+# Class::Struct forbids use of @ISA
+sub import { goto &Exporter::import }
+
+use Class::Struct qw(struct);
+struct 'Net::servent' => [
+   name		=> '$',
+   aliases	=> '@',
+   port		=> '$',
+   proto	=> '$',
+];
+
+sub populate (@) {
+    return unless @_;
+    my $sob = new();
+    $s_name 	 =    $sob->[0]     	     = $_[0];
+    @s_aliases	 = @{ $sob->[1] } = split ' ', $_[1];
+    $s_port	 =    $sob->[2] 	     = $_[2];
+    $s_proto	 =    $sob->[3] 	     = $_[3];
+    return $sob;
+}
+
+sub getservent    (   ) { populate(CORE::getservent()) }
+sub getservbyname ($;$) { populate(CORE::getservbyname(shift,shift||'tcp')) }
+sub getservbyport ($;$) { populate(CORE::getservbyport(shift,shift||'tcp')) }
+
+sub getserv ($;$) {
+    no strict 'refs';
+    return &{'getservby' . ($_[0]=~/^\d+$/ ? 'port' : 'name')}(@_);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Net::servent - by-name interface to Perl's built-in getserv*() functions
+
+=head1 SYNOPSIS
+
+ use Net::servent;
+ $s = getservbyname(shift || 'ftp') || die "no service";
+ printf "port for %s is %s, aliases are %s\n",
+    $s->name, $s->port, "@{$s->aliases}";
+
+ use Net::servent qw(:FIELDS);
+ getservbyname(shift || 'ftp') || die "no service";
+ print "port for $s_name is $s_port, aliases are @s_aliases\n";
+
+=head1 DESCRIPTION
+
+This module's default exports override the core getservent(),
+getservbyname(), and
+getnetbyport() functions, replacing them with versions that return
+"Net::servent" objects.  They take default second arguments of "tcp".  This object has methods that return the similarly
+named structure field name from the C's servent structure from F<netdb.h>;
+namely name, aliases, port, and proto.  The aliases
+method returns an array reference, the rest scalars.
+
+You may also import all the structure fields directly into your namespace
+as regular variables using the :FIELDS import tag.  (Note that this still
+overrides your core functions.)  Access these fields as variables named
+with a preceding C<n_>.  Thus, C<$serv_obj-E<gt>name()> corresponds to
+$s_name if you import the fields.  Array references are available as
+regular array variables, so for example C<@{ $serv_obj-E<gt>aliases()
+}> would be simply @s_aliases.
+
+The getserv() function is a simple front-end that forwards a numeric
+argument to getservbyport(), and the rest to getservbyname().
+
+To access this functionality without the core overrides,
+pass the C<use> an empty import list, and then access
+function functions with their full qualified names.
+On the other hand, the built-ins are still available
+via the C<CORE::> pseudo-package.
+
+=head1 EXAMPLES
+
+ use Net::servent qw(:FIELDS);
+
+ while (@ARGV) {
+     my ($service, $proto) = ((split m!/!, shift), 'tcp');
+     my $valet = getserv($service, $proto);
+     unless ($valet) {
+         warn "$0: No service: $service/$proto\n"
+         next;
+     }
+     printf "service $service/$proto is port %d\n", $valet->port;
+     print "alias are @s_aliases\n" if @s_aliases;
+ }
+
+=head1 NOTE
+
+While this class is currently implemented using the Class::Struct
+module to build a struct-like class, you shouldn't rely upon this.
+
+=head1 AUTHOR
+
+Tom Christiansen
diff --git a/lib/Pod/Functions.pm b/lib/Pod/Functions.pm
index a775cf6165..3cc9b385a0 100644
--- a/lib/Pod/Functions.pm
+++ b/lib/Pod/Functions.pm
@@ -5,7 +5,7 @@ package Pod::Functions;
 require Exporter;
 
 @ISA = qw(Exporter);
-@EXPORT = qw(%Kinds %Type %Flavor %Type_Descriptions @Type_Order);
+@EXPORT = qw(%Kinds %Type %Flavor %Type_Description @Type_Order);
 
 %Type_Description = (
     'ARRAY'	=> 'Functions for real @ARRAYs',
@@ -193,6 +193,7 @@ my	Misc,Namespace	declare and assign a local variable (lexical scoping)
 next	Flow	iterate a block prematurely
 no	Modules	unimport some module symbols or semantics at compile time
 package	Modules,Objects,Namespace	declare a separate global namespace
+prototype	Flow,Misc	get the prototype (if any) of a subroutine
 oct	String,Math	convert a string to an octal number
 open	File	open a file, pipe, or descriptor
 opendir	File	open a directory
diff --git a/lib/Pod/Html.pm b/lib/Pod/Html.pm
new file mode 100644
index 0000000000..aaefc3cdac
--- /dev/null
+++ b/lib/Pod/Html.pm
@@ -0,0 +1,1484 @@
+package Pod::Html;
+
+use Pod::Functions;
+use Getopt::Long;	# package for handling command-line parameters
+require Exporter;
+@ISA = Exporter;
+@EXPORT = qw(pod2html htmlify);
+use Cwd;
+
+use Carp;
+
+use strict;
+
+=head1 NAME
+
+Pod::HTML - module to convert pod files to HTML
+
+=head1 SYNOPSIS
+
+    use Pod::HTML;
+    pod2html([options]);
+
+=head1 DESCRIPTION
+
+Converts files from pod format (see L<perlpod>) to HTML format.  It
+can automatically generate indexes and cross-references, and it keeps
+a cache of things it knows how to cross-reference.
+
+=head1 ARGUMENTS
+
+Pod::Html takes the following arguments:
+
+=over 4
+
+=item help
+
+    --help
+
+Displays the usage message.
+
+=item htmlroot
+
+    --htmlroot=name
+
+Sets the base URL for the HTML files.  When cross-references are made,
+the HTML root is prepended to the URL.
+
+=item infile
+
+    --infile=name
+
+Specify the pod file to convert.  Input is taken from STDIN if no
+infile is specified.
+
+=item outfile
+
+    --outfile=name
+
+Specify the HTML file to create.  Output goes to STDOUT if no outfile
+is specified.
+
+=item podroot
+
+    --podroot=name
+
+Specify the base directory for finding library pods.
+
+=item podpath
+
+    --podpath=name:...:name
+
+Specify which subdirectories of the podroot contain pod files whose
+HTML converted forms can be linked-to in cross-references.
+
+=item libpods
+
+    --libpods=name:...:name
+
+List of page names (eg, "perlfunc") which contain linkable C<=item>s.
+
+=item netscape
+
+    --netscape
+
+Use Netscape HTML directives when applicable.
+
+=item nonetscape
+
+    --nonetscape
+
+Do not use Netscape HTML directives (default).
+
+=item index
+
+    --index
+
+Generate an index at the top of the HTML file (default behaviour).
+
+=item noindex
+
+    --noindex
+
+Do not generate an index at the top of the HTML file.
+
+
+=item recurse
+
+    --recurse
+
+Recurse into subdirectories specified in podpath (default behaviour).
+
+=item norecurse
+
+    --norecurse
+
+Do not recurse into subdirectories specified in podpath.
+
+=item title
+
+    --title=title
+
+Specify the title of the resulting HTML file.
+
+=item verbose
+
+    --verbose
+
+Display progress messages.
+
+=back
+
+=head1 EXAMPLE
+
+    pod2html("pod2html",
+	     "--podpath=lib:ext:pod:vms", 
+	     "--podroot=/usr/src/perl",
+	     "--htmlroot=/perl/nmanual",
+	     "--libpods=perlfunc:perlguts:perlvar:perlrun:perlop",
+	     "--recurse",
+	     "--infile=foo.pod",
+	     "--outfile=/perl/nmanual/foo.html");
+
+=head1 AUTHOR
+
+Tom Christiansen, E<lt>tchrist@perl.comE<gt>.
+
+=head1 BUGS
+
+Has trouble with C<> etc in = commands.
+
+=head1 SEE ALSO
+
+L<perlpod>
+
+=head1 COPYRIGHT
+
+This program is distributed under the Artistic License.
+
+=cut
+
+my $dircache = "pod2html-dircache";
+my $itemcache = "pod2html-itemcache";
+
+my @begin_stack = ();		# begin/end stack
+
+my @libpods = ();	    	# files to search for links from C<> directives
+my $htmlroot = "/";	    	# http-server base directory from which all
+				#   relative paths in $podpath stem.
+my $htmlfile = "";		# write to stdout by default
+my $podfile = "";		# read from stdin by default
+my @podpath = ();		# list of directories containing library pods.
+my $podroot = ".";		# filesystem base directory from which all
+				#   relative paths in $podpath stem.
+my $recurse = 1;		# recurse on subdirectories in $podpath.
+my $verbose = 0;		# not verbose by default
+my $doindex = 1;   	    	# non-zero if we should generate an index
+my $listlevel = 0;		# current list depth
+my @listitem = ();		# stack of HTML commands to use when a =item is
+				#   encountered.  the top of the stack is the
+				#   current list.
+my @listdata = ();		# similar to @listitem, but for the text after
+				#   an =item
+my @listend = ();		# similar to @listitem, but the text to use to
+				#   end the list.
+my $ignore = 1;			# whether or not to format text.  we don't
+				#   format text until we hit our first pod
+				#   directive.
+
+my %items_named = ();		# for the multiples of the same item in perlfunc
+my @items_seen = ();
+my $netscape = 0;		# whether or not to use netscape directives.
+my $title;			# title to give the pod(s)
+my $top = 1;			# true if we are at the top of the doc.  used
+				#   to prevent the first <HR> directive.
+my $paragraph;			# which paragraph we're processing (used
+				#   for error messages)
+my %pages = ();			# associative array used to find the location
+				#   of pages referenced by L<> links.
+my %sections = ();		# sections within this page
+my %items = ();			# associative array used to find the location
+				#   of =item directives referenced by C<> links
+sub init_globals {
+$dircache = "pod2html-dircache";
+$itemcache = "pod2html-itemcache";
+
+@begin_stack = ();		# begin/end stack
+
+@libpods = ();	    	# files to search for links from C<> directives
+$htmlroot = "/";	    	# http-server base directory from which all
+				#   relative paths in $podpath stem.
+$htmlfile = "";		# write to stdout by default
+$podfile = "";		# read from stdin by default
+@podpath = ();		# list of directories containing library pods.
+$podroot = ".";		# filesystem base directory from which all
+				#   relative paths in $podpath stem.
+$recurse = 1;		# recurse on subdirectories in $podpath.
+$verbose = 0;		# not verbose by default
+$doindex = 1;   	    	# non-zero if we should generate an index
+$listlevel = 0;		# current list depth
+@listitem = ();		# stack of HTML commands to use when a =item is
+				#   encountered.  the top of the stack is the
+				#   current list.
+@listdata = ();		# similar to @listitem, but for the text after
+				#   an =item
+@listend = ();		# similar to @listitem, but the text to use to
+				#   end the list.
+$ignore = 1;			# whether or not to format text.  we don't
+				#   format text until we hit our first pod
+				#   directive.
+
+@items_seen = ();
+%items_named = ();
+$netscape = 0;		# whether or not to use netscape directives.
+$title = '';			# title to give the pod(s)
+$top = 1;			# true if we are at the top of the doc.  used
+				#   to prevent the first <HR> directive.
+$paragraph = '';			# which paragraph we're processing (used
+				#   for error messages)
+%pages = ();			# associative array used to find the location
+				#   of pages referenced by L<> links.
+%sections = ();		# sections within this page
+%items = ();			# associative array used to find the location
+				#   of =item directives referenced by C<> links
+
+}
+
+sub pod2html {
+    local(@ARGV) = @_;
+    local($/);
+    local $_;
+
+    init_globals();
+
+    # cache of %pages and %items from last time we ran pod2html
+    my $podpath = '';		
+
+    #undef $opt_help if defined $opt_help;
+
+    # parse the command-line parameters
+    parse_command_line();
+
+    # set some variables to their default values if necessary
+    local *POD;
+    unless (@ARGV && $ARGV[0]) { 
+	$podfile  = "-" unless $podfile;	# stdin
+	open(POD, "<$podfile")
+		|| die "$0: cannot open $podfile file for input: $!\n";
+    } else {
+	$podfile = $ARGV[0];  # XXX: might be more filenames
+	*POD = *ARGV;
+    } 
+    $htmlfile = "-" unless $htmlfile;	# stdout
+    $htmlroot = "" if $htmlroot eq "/";	# so we don't get a //
+
+    # read the pod a paragraph at a time
+    warn "Scanning for sections in input file(s)\n" if $verbose;
+    $/ = "";
+    my @poddata  = <POD>;
+    close(POD);
+
+    # scan the pod for =head[1-6] directives and build an index
+    my $index = scan_headings(\%sections, @poddata);
+
+    # open the output file
+    open(HTML, ">$htmlfile")
+	    || die "$0: cannot open $htmlfile file for output: $!\n";
+
+    # put a title in the HTML file
+    $title = '';
+    TITLE_SEARCH: {
+	for (my $i = 0; $i < @poddata; $i++) { 
+	    if ($poddata[$i] =~ /^=head1\s*NAME\b/m) {
+		for my $para ( @poddata[$i, $i+1] ) { 
+		    last TITLE_SEARCH if ($title) = $para =~ /(\S+\s+-+\s*.*)/s;
+		}
+	    } 
+
+	} 
+    } 
+    unless ($title) { 
+	$podfile =~ /^(.*)(\.[^.\/]+)?$/;
+	$title = ($podfile eq "-" ? 'No Title' : $1);
+		warn "found $title" if $verbose;
+    }
+    if ($title =~ /\.pm/) {
+	warn "$0: no title for $podfile";
+	$title = $podfile;
+    }
+    print HTML <<END_OF_HEAD;
+    <HTML> 
+	<HEAD> 
+	    <TITLE>$title</TITLE> 
+	</HEAD>
+
+	<BODY>
+
+END_OF_HEAD
+
+    # load a cache of %pages and %items if possible.  $tests will be
+    #  non-zero if successful.
+    my $tests = 0;
+    if (-f $dircache && -f $itemcache) {
+	warn "scanning for item cache\n" if $verbose;
+	$tests = find_cache($dircache, $itemcache, $podpath, $podroot);
+    }
+
+    # if we didn't succeed in loading the cache then we must (re)build
+    #  %pages and %items.
+    if (!$tests) {
+	warn "scanning directories in pod-path\n" if $verbose;
+	scan_podpath($podroot, $recurse);
+    }
+
+    # scan the pod for =item directives
+    scan_items("", \%items, @poddata);
+
+    # put an index at the top of the file.  note, if $doindex is 0 we
+    # still generate an index, but surround it with an html comment.
+    # that way some other program can extract it if desired.
+    $index =~ s/--+/-/g;
+    print HTML "<!-- INDEX BEGIN -->\n";
+    print HTML "<!--\n" unless $doindex;
+    print HTML $index;
+    print HTML "-->\n" unless $doindex;
+    print HTML "<!-- INDEX END -->\n\n";
+    print HTML "<HR>\n" if $doindex;
+
+    # now convert this file
+    warn "Converting input file\n" if $verbose;
+    foreach my $i (0..$#poddata) {
+	$_ = $poddata[$i];
+	$paragraph = $i+1;
+	if (/^(=.*)/s) {	# is it a pod directive?
+	    $ignore = 0;
+	    $_ = $1;
+	    if (/^=begin\s+(\S+)\s*(.*)/si) {# =begin
+		process_begin($1, $2);
+	    } elsif (/^=end\s+(\S+)\s*(.*)/si) {# =end
+		process_end($1, $2);
+	    } elsif (/^=cut/) {			# =cut
+		process_cut();
+	    } elsif (/^=pod/) {			# =pod
+		process_pod();
+	    } else {
+		next if @begin_stack && $begin_stack[-1] ne 'html';
+
+		if (/^=(head[1-6])\s+(.*)/s) {	# =head[1-6] heading
+		    process_head($1, $2);
+		} elsif (/^=item\s*(.*)/sm) {	# =item text
+		    process_item($1);
+		} elsif (/^=over\s*(.*)/) {		# =over N
+		    process_over();
+		} elsif (/^=back/) {		# =back
+		    process_back();
+		} elsif (/^=for\s+(\S+)\s+(.*)/si) {# =for
+		    process_for($1,$2);
+		} else {
+		    /^=(\S*)\s*/;
+		    warn "$0: $podfile: unknown pod directive '$1' in "
+		       . "paragraph $paragraph.  ignoring.\n";
+		}
+	    }
+	    $top = 0;
+	}
+	else {
+	    next if $ignore;
+	    next if @begin_stack && $begin_stack[-1] ne 'html';
+	    my $text = $_;
+	    process_text(\$text, 1);
+	    print HTML "$text\n<P>\n\n";
+	}
+    }
+
+    # finish off any pending directives
+    finish_list();
+    print HTML <<END_OF_TAIL;
+    </BODY>
+
+    </HTML>
+END_OF_TAIL
+
+    # close the html file
+    close(HTML);
+
+    warn "Finished\n" if $verbose;
+}
+
+##############################################################################
+
+my $usage;			# see below
+sub usage {
+    my $podfile = shift;
+    warn "$0: $podfile: @_\n" if @_;
+    die $usage;
+}
+
+$usage =<<END_OF_USAGE;
+Usage:  $0 --help --htmlroot=<name> --infile=<name> --outfile=<name>
+           --podpath=<name>:...:<name> --podroot=<name>
+           --libpods=<name>:...:<name> --recurse --verbose --index
+           --netscape --norecurse --noindex
+
+  --flush      - flushes the item and directory caches.
+  --help       - prints this message.
+  --htmlroot   - http-server base directory from which all relative paths
+                 in podpath stem (default is /).
+  --index      - generate an index at the top of the resulting html
+                 (default).
+  --infile     - filename for the pod to convert (input taken from stdin
+                 by default).
+  --libpods    - colon-separated list of pages to search for =item pod
+                 directives in as targets of C<> and implicit links (empty
+                 by default).  note, these are not filenames, but rather
+                 page names like those that appear in L<> links.
+  --netscape   - will use netscape html directives when applicable.
+  --nonetscape - will not use netscape directives (default).
+  --outfile    - filename for the resulting html file (output sent to
+                 stdout by default).
+  --podpath    - colon-separated list of directories containing library
+                 pods.  empty by default.
+  --podroot    - filesystem base directory from which all relative paths
+                 in podpath stem (default is .).
+  --noindex    - don't generate an index at the top of the resulting html.
+  --norecurse  - don't recurse on those subdirectories listed in podpath.
+  --recurse    - recurse on those subdirectories listed in podpath
+                 (default behavior).
+  --title      - title that will appear in resulting html file.
+  --verbose    - self-explanatory
+
+END_OF_USAGE
+
+sub parse_command_line {
+    my ($opt_flush,$opt_help,$opt_htmlroot,$opt_index,$opt_infile,$opt_libpods,$opt_netscape,$opt_outfile,$opt_podpath,$opt_podroot,$opt_norecurse,$opt_recurse,$opt_title,$opt_verbose);
+    my $result = GetOptions(
+			    'flush'      => \$opt_flush,
+			    'help'       => \$opt_help,
+			    'htmlroot=s' => \$opt_htmlroot,
+			    'index!'     => \$opt_index,
+			    'infile=s'   => \$opt_infile,
+			    'libpods=s'  => \$opt_libpods,
+			    'netscape!'  => \$opt_netscape,
+			    'outfile=s'  => \$opt_outfile,
+			    'podpath=s'  => \$opt_podpath,
+			    'podroot=s'  => \$opt_podroot,
+			    'norecurse'  => \$opt_norecurse,
+			    'recurse!'   => \$opt_recurse,
+			    'title=s'    => \$opt_title,
+			    'verbose'    => \$opt_verbose,
+			   );
+    usage("-", "invalid parameters") if not $result;
+
+    usage("-") if defined $opt_help;	# see if the user asked for help
+    $opt_help = "";			# just to make -w shut-up.
+
+    $podfile  = $opt_infile if defined $opt_infile;
+    $htmlfile = $opt_outfile if defined $opt_outfile;
+
+    @podpath  = split(":", $opt_podpath) if defined $opt_podpath;
+    @libpods  = split(":", $opt_libpods) if defined $opt_libpods;
+
+    warn "Flushing item and directory caches\n"
+	if $opt_verbose && defined $opt_flush;
+    unlink($dircache, $itemcache) if defined $opt_flush;
+
+    $htmlroot = $opt_htmlroot if defined $opt_htmlroot;
+    $podroot  = $opt_podroot if defined $opt_podroot;
+
+    $doindex  = $opt_index if defined $opt_index;
+    $recurse  = $opt_recurse if defined $opt_recurse;
+    $title    = $opt_title if defined $opt_title;
+    $verbose  = defined $opt_verbose ? 1 : 0;
+    $netscape = $opt_netscape if defined $opt_netscape;
+}
+
+#
+# find_cache - tries to find if the caches stored in $dircache and $itemcache
+#  are valid caches of %pages and %items.  if they are valid then it loads
+#  them and returns a non-zero value.
+#
+sub find_cache {
+    my($dircache, $itemcache, $podpath, $podroot) = @_;
+    my($tests);
+    local $_;
+
+    $tests = 0;
+
+    open(CACHE, "<$itemcache") ||
+	die "$0: error opening $itemcache for reading: $!\n";
+    $/ = "\n";
+
+    # is it the same podpath?
+    $_ = <CACHE>;
+    chomp($_);
+    $tests++ if (join(":", @podpath) eq $_);
+
+    # is it the same podroot?
+    $_ = <CACHE>;
+    chomp($_);
+    $tests++ if ($podroot eq $_);
+
+    # load the cache if its good
+    if ($tests != 2) {
+	close(CACHE);
+
+	%items = ();
+	return 0;
+    }
+
+    warn "loading item cache\n" if $verbose;
+    while (<CACHE>) {
+	/(.*?) (.*)$/;
+	$items{$1} = $2;
+    }
+    close(CACHE);
+
+    warn "scanning for directory cache\n" if $verbose;
+    open(CACHE, "<$dircache") ||
+	die "$0: error opening $dircache for reading: $!\n";
+    $/ = "\n";
+    $tests = 0;
+
+    # is it the same podpath?
+    $_ = <CACHE>;
+    chomp($_);
+    $tests++ if (join(":", @podpath) eq $_);
+
+    # is it the same podroot?
+    $_ = <CACHE>;
+    chomp($_);
+    $tests++ if ($podroot eq $_);
+
+    # load the cache if its good
+    if ($tests != 2) {
+	close(CACHE);
+
+	%pages = ();
+	%items = ();
+	return 0;
+    }
+
+    warn "loading directory cache\n" if $verbose;
+    while (<CACHE>) {
+	/(.*?) (.*)$/;
+	$pages{$1} = $2;
+    }
+
+    close(CACHE);
+
+    return 1;
+}
+
+#
+# scan_podpath - scans the directories specified in @podpath for directories,
+#  .pod files, and .pm files.  it also scans the pod files specified in
+#  @libpods for =item directives.
+#
+sub scan_podpath {
+    my($podroot, $recurse) = @_;
+    my($pwd, $dir);
+    my($libpod, $dirname, $pod, @files, @poddata);
+
+    # scan each directory listed in @podpath
+    $pwd = getcwd();
+    chdir($podroot)
+	|| die "$0: error changing to directory $podroot: $!\n";
+    foreach $dir (@podpath) {
+	scan_dir($dir, $recurse);
+    }
+
+    # scan the pods listed in @libpods for =item directives
+    foreach $libpod (@libpods) {
+	# if the page isn't defined then we won't know where to find it
+	# on the system.
+	next unless defined $pages{$libpod} && $pages{$libpod};
+
+	# if there is a directory then use the .pod and .pm files within it.
+	if ($pages{$libpod} =~ /([^:]*[^(\.pod|\.pm)]):/) {
+	    #  find all the .pod and .pm files within the directory
+	    $dirname = $1;
+	    opendir(DIR, $dirname) ||
+		die "$0: error opening directory $dirname: $!\n";
+	    @files = grep(/(\.pod|\.pm)$/ && ! -d $_, readdir(DIR));
+	    closedir(DIR);
+
+	    # scan each .pod and .pm file for =item directives
+	    foreach $pod (@files) {
+		open(POD, "<$dirname/$pod") ||
+		    die "$0: error opening $dirname/$pod for input: $!\n";
+		@poddata = <POD>;
+		close(POD);
+
+		scan_items("$dirname/$pod", @poddata);
+	    }
+
+	    # use the names of files as =item directives too.
+	    foreach $pod (@files) {
+		$pod =~ /^(.*)(\.pod|\.pm)$/;
+		$items{$1} = "$dirname/$1.html" if $1;
+	    }
+	} elsif ($pages{$libpod} =~ /([^:]*\.pod):/ ||
+		 $pages{$libpod} =~ /([^:]*\.pm):/) {
+	    # scan the .pod or .pm file for =item directives
+	    $pod = $1;
+	    open(POD, "<$pod") ||
+		die "$0: error opening $pod for input: $!\n";
+	    @poddata = <POD>;
+	    close(POD);
+
+	    scan_items("$pod", @poddata);
+	} else {
+	    warn "$0: shouldn't be here (line ".__LINE__."\n";
+	}
+    }
+    @poddata = ();	# clean-up a bit
+
+    chdir($pwd)
+	|| die "$0: error changing to directory $pwd: $!\n";
+
+    # cache the item list for later use
+    warn "caching items for later use\n" if $verbose;
+    open(CACHE, ">$itemcache") ||
+	die "$0: error open $itemcache for writing: $!\n";
+
+    print CACHE join(":", @podpath) . "\n$podroot\n";
+    foreach my $key (keys %items) {
+	print CACHE "$key $items{$key}\n";
+    }
+
+    close(CACHE);
+
+    # cache the directory list for later use
+    warn "caching directories for later use\n" if $verbose;
+    open(CACHE, ">$dircache") ||
+	die "$0: error open $dircache for writing: $!\n";
+
+    print CACHE join(":", @podpath) . "\n$podroot\n";
+    foreach my $key (keys %pages) {
+	print CACHE "$key $pages{$key}\n";
+    }
+
+    close(CACHE);
+}
+
+#
+# scan_dir - scans the directory specified in $dir for subdirectories, .pod
+#  files, and .pm files.  notes those that it finds.  this information will
+#  be used later in order to figure out where the pages specified in L<>
+#  links are on the filesystem.
+#
+sub scan_dir {
+    my($dir, $recurse) = @_;
+    my($t, @subdirs, @pods, $pod, $dirname, @dirs);
+    local $_;
+
+    @subdirs = ();
+    @pods = ();
+
+    opendir(DIR, $dir) ||
+	die "$0: error opening directory $dir: $!\n";
+    while (defined($_ = readdir(DIR))) {
+	if (-d "$dir/$_" && $_ ne "." && $_ ne "..") {	    # directory
+	    $pages{$_}  = "" unless defined $pages{$_};
+	    $pages{$_} .= "$dir/$_:";
+	    push(@subdirs, $_);
+	} elsif (/\.pod$/) {	    	    	    	    # .pod
+	    s/\.pod$//;
+	    $pages{$_}  = "" unless defined $pages{$_};
+	    $pages{$_} .= "$dir/$_.pod:";
+	    push(@pods, "$dir/$_.pod");
+	} elsif (/\.pm$/) { 	    	    	    	    # .pm
+	    s/\.pm$//;
+	    $pages{$_}  = "" unless defined $pages{$_};
+	    $pages{$_} .= "$dir/$_.pm:";
+	    push(@pods, "$dir/$_.pm");
+	}
+    }
+    closedir(DIR);
+
+    # recurse on the subdirectories if necessary
+    if ($recurse) {
+	foreach my $subdir (@subdirs) {
+	    scan_dir("$dir/$subdir", $recurse);
+	}
+    }
+}
+
+#
+# scan_headings - scan a pod file for head[1-6] tags, note the tags, and
+#  build an index.
+#
+sub scan_headings {
+    my($sections, @data) = @_;
+    my($tag, $which_head, $title, $listdepth, $index);
+
+    # here we need	local $ignore = 0;
+    #  unfortunately, we can't have it, because $ignore is lexical
+    $ignore = 0;
+
+    $listdepth = 0;
+    $index = "";
+
+    # scan for =head directives, note their name, and build an index
+    #  pointing to each of them.
+    foreach my $line (@data) {
+	if ($line =~ /^\s*=(head)([1-6])\s+(.*)/) {
+	    ($tag,$which_head, $title) = ($1,$2,$3);
+	    chomp($title);
+	    $$sections{htmlify(0,$title)} = 1;
+
+	    if ($which_head > $listdepth) {
+		$index .= "\n" . ("\t" x $listdepth) . "<UL>\n";
+	    } elsif ($which_head < $listdepth) {
+		$listdepth--;
+		$index .= "\n" . ("\t" x $listdepth) . "</UL>\n";
+	    }
+	    $listdepth = $which_head;
+
+	    $index .= "\n" . ("\t" x $listdepth) . "<LI>" .
+	              "<A HREF=\"#" . htmlify(0,$title) . "\">" .
+		      process_text(\$title, 0) . "</A>";
+	}
+    }
+
+    # finish off the lists
+    while ($listdepth--) {
+	$index .= "\n" . ("\t" x $listdepth) . "</UL>\n";
+    }
+
+    # get rid of bogus lists
+    $index =~ s,\t*<UL>\s*</UL>\n,,g;
+
+    $ignore = 1;	# retore old value;
+
+    return $index;
+}
+
+#
+# scan_items - scans the pod specified by $pod for =item directives.  we
+#  will use this information later on in resolving C<> links.
+#
+sub scan_items {
+    my($pod, @poddata) = @_;
+    my($i, $item);
+    local $_;
+
+    $pod =~ s/\.pod$//;
+    $pod .= ".html" if $pod;
+
+    foreach $i (0..$#poddata) {
+	$_ = $poddata[$i];
+
+	# remove any formatting instructions
+	s,[A-Z]<([^<>]*)>,$1,g;
+
+	# figure out what kind of item it is and get the first word of
+	#  it's name.
+	if (/^=item\s+(\w*)\s*.*$/s) {
+	    if ($1 eq "*") {		# bullet list
+		/\A=item\s+\*\s*(.*?)\s*\Z/s;
+		$item = $1;
+	    } elsif ($1 =~ /^[0-9]+/) {	# numbered list
+		/\A=item\s+[0-9]+\.?(.*?)\s*\Z/s;
+		$item = $1;
+	    } else {
+#		/\A=item\s+(.*?)\s*\Z/s;
+		/\A=item\s+(\w*)/s;
+		$item = $1;
+	    }
+
+	    $items{$item} = "$pod" if $item;
+	}
+    }
+}
+
+#
+# process_head - convert a pod head[1-6] tag and convert it to HTML format.
+#
+sub process_head {
+    my($tag, $heading) = @_;
+    my $firstword;
+
+    # figure out the level of the =head
+    $tag =~ /head([1-6])/;
+    my $level = $1;
+
+    # can't have a heading full of spaces and speechmarks and so on
+    $firstword = $heading; $firstword =~ s/\s*(\w+)\s.*/$1/;
+
+    print HTML "<P>\n" unless $listlevel;
+    print HTML "<HR>\n" unless $listlevel || $top;
+    print HTML "<H$level>"; # unless $listlevel;
+    #print HTML "<H$level>" unless $listlevel;
+    my $convert = $heading; process_text(\$convert, 0);
+    print HTML '<A NAME="' . htmlify(0,$heading) . "\">$convert</A>";
+    print HTML "</H$level>"; # unless $listlevel;
+    print HTML "\n";
+}
+
+#
+# process_item - convert a pod item tag and convert it to HTML format.
+#
+sub process_item {
+    my $text = $_[0];
+    my($i, $quote, $name);
+
+    my $need_preamble = 0;
+    my $this_entry;
+
+
+    # lots of documents start a list without doing an =over.  this is
+    # bad!  but, the proper thing to do seems to be to just assume
+    # they did do an =over.  so warn them once and then continue.
+    warn "$0: $podfile: unexpected =item directive in paragraph $paragraph.  ignoring.\n"
+	unless $listlevel;
+    process_over() unless $listlevel;
+
+    return unless $listlevel;
+
+    # remove formatting instructions from the text
+    1 while $text =~ s/[A-Z]<([^<>]*)>/$1/g;
+    pre_escape(\$text);
+
+    $need_preamble = $items_seen[$listlevel]++ == 0;
+
+    # check if this is the first =item after an =over
+    $i = $listlevel - 1;
+    my $need_new = $listlevel >= @listitem;
+
+    if ($text =~ /\A\*/) {		# bullet
+
+	if ($need_preamble) {
+	    push(@listend,  "</UL>");
+	    print HTML "<UL>\n";
+	}
+
+       print HTML "<LI><STRONG>";
+       $text =~ /\A\*\s*(.*)\Z/s;
+       print HTML "<A NAME=\"item_" . htmlify(1,$1) . "\">" if $1 && !$items_named{$1}++;
+       $quote = 1;
+       #print HTML process_puretext($1, \$quote);
+       print HTML $1;
+       print HTML "</A>" if $1;
+       print HTML "</STRONG>";
+
+    } elsif ($text =~ /\A[0-9#]+/) {	# numbered list
+
+	if ($need_preamble) {
+	    push(@listend,  "</OL>");
+	    print HTML "<OL>\n";
+	}
+
+       print HTML "<LI><STRONG>";
+       $text =~ /\A[0-9]+\.?(.*)\Z/s;
+       print HTML "<A NAME=\"item_" . htmlify(0,$1) . "\">" if $1;
+       $quote = 1;
+       #print HTML process_puretext($1, \$quote);
+       print HTML $1 if $1;
+       print HTML "</A>" if $1;
+       print HTML "</STRONG>";
+
+    } else {			# all others
+
+	if ($need_preamble) {
+	    push(@listend,  '</DL>');
+	    print HTML "<DL>\n";
+	}
+
+       print HTML "<DT><STRONG>";
+       print HTML "<A NAME=\"item_" . htmlify(1,$text) . "\">" 
+	    if $text && !$items_named{($text =~ /(\S+)/)[0]}++;
+	    # preceding craziness so that the duplicate leading bits in 
+	    # perlfunc work to find just the first one.  otherwise
+	    # open etc would have many names
+       $quote = 1;
+       #print HTML process_puretext($text, \$quote);
+       print HTML $text;
+       print HTML "</A>" if $text;
+       print HTML "</STRONG>";
+
+       print HTML '<DD>';
+    }
+
+    print HTML "\n";
+}
+
+#
+# process_over - process a pod over tag and start a corresponding HTML
+# list.
+#
+sub process_over {
+    # start a new list
+    $listlevel++;
+}
+
+#
+# process_back - process a pod back tag and convert it to HTML format.
+#
+sub process_back {
+    warn "$0: $podfile: unexpected =back directive in paragraph $paragraph.  ignorning.\n"
+	unless $listlevel;
+    return unless $listlevel;
+
+    # close off the list.  note, I check to see if $listend[$listlevel] is
+    # defined because an =item directive may have never appeared and thus
+    # $listend[$listlevel] may have never been initialized.
+    $listlevel--;
+    print HTML $listend[$listlevel] if defined $listend[$listlevel];
+    print HTML "\n";
+
+    # don't need the corresponding perl code anymore
+    pop(@listitem);
+    pop(@listdata);
+    pop(@listend);
+
+    pop(@items_seen);
+}
+
+#
+# process_cut - process a pod cut tag, thus stop ignoring pod directives.
+#
+sub process_cut {
+    $ignore = 1;
+}
+
+#
+# process_pod - process a pod pod tag, thus ignore pod directives until we see a
+# corresponding cut.
+#
+sub process_pod {
+    # no need to set $ignore to 0 cause the main loop did it
+}
+
+#
+# process_for - process a =for pod tag.  if it's for html, split
+# it out verbatim, otherwise ignore it.
+#
+sub process_for {
+    my($whom, $text) = @_;
+    if ( $whom =~ /^(pod2)?html$/i) {
+	print HTML $text;
+    } 
+}
+
+#
+# process_begin - process a =begin pod tag.  this pushes
+# whom we're beginning on the begin stack.  if there's a
+# begin stack, we only print if it us.
+#
+sub process_begin {
+    my($whom, $text) = @_;
+    $whom = lc($whom);
+    push (@begin_stack, $whom);
+    if ( $whom =~ /^(pod2)?html$/) {
+	print HTML $text if $text;
+    }
+}
+
+#
+# process_end - process a =end pod tag.  pop the
+# begin stack.  die if we're mismatched.
+#
+sub process_end {
+    my($whom, $text) = @_;
+    $whom = lc($whom);
+    if ($begin_stack[-1] ne $whom ) {
+	die "Unmatched begin/end at chunk $paragraph\n"
+    } 
+    pop @begin_stack;
+}
+
+#
+# process_text - handles plaintext that appears in the input pod file.
+# there may be pod commands embedded within the text so those must be
+# converted to html commands.
+#
+sub process_text {
+    my($text, $escapeQuotes) = @_;
+    my($result, $rest, $s1, $s2, $s3, $s4, $match, $bf);
+    my($podcommand, $params, $tag, $quote);
+
+    return if $ignore;
+
+    $quote  = 0;    	    	# status of double-quote conversion
+    $result = "";
+    $rest = $$text;
+
+    if ($rest =~ /^\s+/) {	# preformatted text, no pod directives
+	$rest =~ s/\n+\Z//;
+	$rest =~ s#.*#
+	    my $line = $&;
+	    1 while $line =~ s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e;
+	    $line;
+	#eg;
+
+	$rest   =~ s/&/&amp;/g;
+	$rest   =~ s/</&lt;/g;
+	$rest   =~ s/>/&gt;/g;
+	$rest   =~ s/"/&quot;/g;
+
+	# try and create links for all occurrences of perl.* within
+	# the preformatted text.
+	$rest =~ s{
+		    (\s*)(perl\w+)
+		  }{
+		    if (defined $pages{$2}) {	# is a link
+			qq($1<A HREF="$htmlroot/$pages{$2}">$2</A>);
+		    } else {
+			"$1$2";
+		    }
+		  }xeg;
+	$rest =~ s/(<A HREF=)([^>:]*:)?([^>:]*)\.pod:([^>:]*:)?/$1$3.html/g;
+
+  my $urls = '(' . join ('|', qw{
+                http
+                telnet
+		mailto
+		news
+                gopher
+                file
+                wais
+                ftp
+            } ) 
+        . ')';
+  
+  my $ltrs = '\w';
+  my $gunk = '/#~:.?+=&%@!\-';
+  my $punc = '.:?\-';
+  my $any  = "${ltrs}${gunk}${punc}";
+
+  $rest =~ s{
+        \b                          # start at word boundary
+        (                           # begin $1  {
+          $urls     :               # need resource and a colon
+          [$any] +?                 # followed by on or more
+                                    #  of any valid character, but
+                                    #  be conservative and take only
+                                    #  what you need to....
+        )                           # end   $1  }
+        (?=                         # look-ahead non-consumptive assertion
+                [$punc]*            # either 0 or more puntuation
+                [^$any]             #   followed by a non-url char
+            |                       # or else
+                $                   #   then end of the string
+        )
+      }{<A HREF="$1">$1</A>}igox;
+
+	$result =   "<PRE>"	# text should be as it is (verbatim)
+		  . "$rest\n"
+		  . "</PRE>\n";
+    } else {			# formatted text
+	# parse through the string, stopping each time we find a
+	# pod-escape.  once the string has been throughly processed
+	# we can output it.
+	while ($rest) {
+	    # check to see if there are any possible pod directives in
+	    # the remaining part of the text.
+	    if ($rest =~ m/[BCEIFLSZ]</) {
+		warn "\$rest\t= $rest\n" unless
+		    $rest =~ /\A
+			   ([^<]*?)
+			   ([BCEIFLSZ]?)
+			   <
+			   (.*)\Z/xs;
+
+		$s1 = $1;	# pure text
+		$s2 = $2;	# the type of pod-escape that follows
+		$s3 = '<';	# '<'
+		$s4 = $3;	# the rest of the string
+	    } else {
+		$s1 = $rest;
+		$s2 = "";
+		$s3 = "";
+		$s4 = "";
+	    }
+
+	    if ($s3 eq '<' && $s2) {	# a pod-escape
+		$result    .= ($escapeQuotes ? process_puretext($s1, \$quote) : $s1);
+		$podcommand = "$s2<";
+		$rest       = $s4;
+
+		# find the matching '>'
+		$match = 1;
+		$bf = 0;
+		while ($match && !$bf) {
+		    $bf = 1;
+		    if ($rest =~ /\A([^<>]*[BCEIFLSZ]<)(.*)\Z/s) {
+			$bf = 0;
+			$match++;
+			$podcommand .= $1;
+			$rest        = $2;
+		    } elsif ($rest =~ /\A([^>]*>)(.*)\Z/s) {
+			$bf = 0;
+			$match--;
+			$podcommand .= $1;
+			$rest        = $2;
+		    }
+		}
+
+		if ($match != 0) {
+		    warn <<WARN;
+$0: $podfile: cannot find matching > for $s2 in paragraph $paragraph.
+WARN
+		    $result .= substr $podcommand, 0, 2;
+		    $rest = substr($podcommand, 2) . $rest;
+		    next;
+		}
+
+		# pull out the parameters to the pod-escape
+		$podcommand =~ /^([BCFEILSZ]?)<(.*)>$/s;
+		$tag    = $1;
+		$params = $2;
+
+		# process the text within the pod-escape so that any escapes
+		# which must occur do.
+		process_text(\$params, 0) unless $tag eq 'L';
+
+		$s1 = $params;
+		if (!$tag || $tag eq " ") {	#  <> : no tag
+		    $s1 = "&lt;$params&gt;";
+		} elsif ($tag eq "L") {		# L<> : link 
+		    $s1 = process_L($params);
+		} elsif ($tag eq "I" ||		# I<> : italicize text
+			 $tag eq "B" ||		# B<> : bold text
+			 $tag eq "F") {		# F<> : file specification
+		    $s1 = process_BFI($tag, $params);
+		} elsif ($tag eq "C") {		# C<> : literal code
+		    $s1 = process_C($params, 1);
+		} elsif ($tag eq "E") {		# E<> : escape
+		    $s1 = process_E($params);
+		} elsif ($tag eq "Z") {		# Z<> : zero-width character
+		    $s1 = process_Z($params);
+		} elsif ($tag eq "S") {		# S<> : non-breaking space
+		    $s1 = process_S($params);
+		} elsif ($tag eq "X") {		# S<> : non-breaking space
+		    $s1 = process_X($params);
+		} else {
+		    warn "$0: $podfile: unhandled tag '$tag' in paragraph $paragraph\n";
+		}
+
+		$result .= "$s1";
+	    } else {
+		# for pure text we must deal with implicit links and
+		# double-quotes among other things.
+		$result .= ($escapeQuotes ? process_puretext("$s1$s2$s3", \$quote) : "$s1$s2$s3");
+		$rest    = $s4;
+	    }
+	}
+    }
+    $$text = $result;
+}
+
+sub html_escape {
+    my $rest = $_[0];
+    $rest   =~ s/&/&amp;/g;
+    $rest   =~ s/</&lt;/g;
+    $rest   =~ s/>/&gt;/g;
+    $rest   =~ s/"/&quot;/g;
+    return $rest;
+} 
+
+#
+# process_puretext - process pure text (without pod-escapes) converting
+#  double-quotes and handling implicit C<> links.
+#
+sub process_puretext {
+    my($text, $quote) = @_;
+    my(@words, $result, $rest, $lead, $trail);
+
+    # convert double-quotes to single-quotes
+    $text =~ s/\A([^"]*)"/$1''/s if $$quote;
+    while ($text =~ s/\A([^"]*)["]([^"]*)["]/$1``$2''/sg) {}
+
+    $$quote = ($text =~ m/"/ ? 1 : 0);
+    $text =~ s/\A([^"]*)"/$1``/s if $$quote;
+
+    # keep track of leading and trailing white-space
+    $lead  = ($text =~ /\A(\s*)/s ? $1 : "");
+    $trail = ($text =~ /(\s*)\Z/s ? $1 : "");
+
+    # collapse all white space into a single space
+    $text =~ s/\s+/ /g;
+    @words = split(" ", $text);
+
+    # process each word individually
+    foreach my $word (@words) {
+	# see if we can infer a link
+	if ($word =~ /^\w+\(/) {
+	    # has parenthesis so should have been a C<> ref
+	    $word = process_C($word);
+#	    $word =~ /^[^()]*]\(/;
+#	    if (defined $items{$1} && $items{$1}) {
+#		$word =   "\n<CODE><A HREF=\"$htmlroot/$items{$1}#item_"
+#			. htmlify(0,$word)
+#			. "\">$word</A></CODE>";
+#	    } elsif (defined $items{$word} && $items{$word}) {
+#		$word =   "\n<CODE><A HREF=\"$htmlroot/$items{$word}#item_"
+#			. htmlify(0,$word)
+#			. "\">$word</A></CODE>";
+#	    } else {
+#		$word =   "\n<CODE><A HREF=\"#item_"
+#			. htmlify(0,$word)
+#			. "\">$word</A></CODE>";
+#	    }
+	} elsif ($word =~ /^[\$\@%&*]+\w+$/) {
+	    # perl variables, should be a C<> ref
+	    $word = process_C($word, 1);
+	} elsif ($word =~ m,^\w+://\w,) {
+	    # looks like a URL
+	    $word = qq(<A HREF="$word">$word</A>);
+	} elsif ($word =~ /[\w.-]+\@\w+\.\w/) {
+	    # looks like an e-mail address
+	    $word = qq(<A HREF="MAILTO:$word">$word</A>);
+	} elsif ($word !~ /[a-z]/ && $word =~ /[A-Z]/) {  # all uppercase?
+	    $word = html_escape($word) if $word =~ /[&<>]/;
+	    $word = "\n<FONT SIZE=-1>$word</FONT>" if $netscape;
+	} else { 
+	    $word = html_escape($word) if $word =~ /[&<>]/;
+	}
+    }
+
+    # build a new string based upon our conversion
+    $result = "";
+    $rest   = join(" ", @words);
+    while (length($rest) > 75) {
+	if ( $rest =~ m/^(.{0,75})\s(.*?)$/o ||
+	     $rest =~ m/^(\S*)\s(.*?)$/o) {
+
+	    $result .= "$1\n";
+	    $rest    = $2;
+	} else {
+	    $result .= "$rest\n";
+	    $rest    = "";
+	}
+    }
+    $result .= $rest if $rest;
+
+    # restore the leading and trailing white-space
+    $result = "$lead$result$trail";
+
+    return $result;
+}
+
+#
+# pre_escape - convert & in text to $amp;
+#
+sub pre_escape {
+    my($str) = @_;
+
+    $$str =~ s,&,&amp;,g;
+}
+
+#
+# process_L - convert a pod L<> directive to a corresponding HTML link.
+#  most of the links made are inferred rather than known about directly
+#  (i.e it's not known whether the =head\d section exists in the target file,
+#   or whether a .pod file exists in the case of split files).  however, the
+#  guessing usually works.
+#
+# Unlike the other directives, this should be called with an unprocessed
+# string, else tags in the link won't be matched.
+#
+sub process_L {
+    my($str) = @_;
+    my($s1, $s2, $linktext, $page, $section, $link);	# work strings
+
+    $str =~ s/\n/ /g;			# undo word-wrapped tags
+    $s1 = $str;
+    for ($s1) {
+	# a :: acts like a /
+	s,::,/,;
+
+	# make sure sections start with a /
+	s,^",/",g;
+	s,^,/,g if (!m,/, && / /);
+
+	# check if there's a section specified
+	if (m,^(.*?)/"?(.*?)"?$,) {	# yes
+	    ($page, $section) = ($1, $2);
+	} else {			# no
+	    ($page, $section) = ($str, "");
+	}
+
+	# check if we know that this is a section in this page
+	if (!defined $pages{$page} && defined $sections{$page}) {
+	    $section = $page;
+	    $page = "";
+	}
+    }
+
+    if ($page eq "") {
+	$link = "#" . htmlify(0,$section);
+	$linktext = $section;
+    } elsif (!defined $pages{$page}) {
+	warn "$0: $podfile: cannot resolve L<$str> in paragraph $paragraph: no such page '$page'\n";
+	$link = "";
+	$linktext = $page;
+    } else {
+	$linktext  = ($section ? "$section" : "the $page manpage");
+	$section = htmlify(0,$section) if $section ne "";
+
+	# if there is a directory by the name of the page, then assume that an
+	# appropriate section will exist in the subdirectory
+	if ($section ne "" && $pages{$page} =~ /([^:]*[^(\.pod|\.pm)]):/) {
+	    $link = "$htmlroot/$1/$section.html";
+
+	# since there is no directory by the name of the page, the section will
+	# have to exist within a .html of the same name.  thus, make sure there
+	# is a .pod or .pm that might become that .html
+	} else {
+	    $section = "#$section";
+	    # check if there is a .pod with the page name
+	    if ($pages{$page} =~ /([^:]*)\.pod:/) {
+		$link = "$htmlroot/$1.html$section";
+	    } elsif ($pages{$page} =~ /([^:]*)\.pm:/) {
+		$link = "$htmlroot/$1.html$section";
+	    } else {
+		warn "$0: $podfile: cannot resolve L$str in paragraph $paragraph: ".
+			     "no .pod or .pm found\n";
+		$link = "";
+		$linktext = $section;
+	    }
+	}
+    }
+
+    process_text(\$linktext, 0);
+    if ($link) {
+	$s1 = "<A HREF=\"$link\">$linktext</A>";
+    } else {
+	$s1 = "<EM>$linktext</EM>";
+    }
+    return $s1;
+}
+
+#
+# process_BFI - process any of the B<>, F<>, or I<> pod-escapes and
+# convert them to corresponding HTML directives.
+#
+sub process_BFI {
+    my($tag, $str) = @_;
+    my($s1);			# work string
+    my(%repltext) = (	'B' => 'STRONG',
+			'F' => 'EM',
+			'I' => 'EM');
+
+    # extract the modified text and convert to HTML
+    $s1 = "<$repltext{$tag}>$str</$repltext{$tag}>";
+    return $s1;
+}
+
+#
+# process_C - process the C<> pod-escape.
+#
+sub process_C {
+    my($str, $doref) = @_;
+    my($s1, $s2);
+
+    $s1 = $str;
+    $s1 =~ s/\([^()]*\)//g;	# delete parentheses
+    $s2 = $s1;
+    $s1 =~ s/\W//g;		# delete bogus characters
+
+    # if there was a pod file that we found earlier with an appropriate
+    # =item directive, then create a link to that page.
+    if ($doref && defined $items{$s1}) {
+	$s1 = ($items{$s1} ?
+	       "<A HREF=\"$htmlroot/$items{$s1}#item_" . htmlify(0,$s2) .  "\">$str</A>" :
+	       "<A HREF=\"#item_" . htmlify(0,$s2) .  "\">$str</A>");
+	$s1 =~ s,(perl\w+/(\S+)\.html)#item_\2\b,$1,; 
+	confess "s1 has space: $s1" if $s1 =~ /HREF="[^"]*\s[^"]*"/;
+    } else {
+	$s1 = "<CODE>$str</CODE>";
+	# warn "$0: $podfile: cannot resolve C<$str> in paragraph $paragraph\n" if $verbose
+    }
+
+
+    return $s1;
+}
+
+#
+# process_E - process the E<> pod directive which seems to escape a character.
+#
+sub process_E {
+    my($str) = @_;
+
+    for ($str) {
+	s,([^/].*),\&$1\;,g;
+    }
+
+    return $str;
+}
+
+#
+# process_Z - process the Z<> pod directive which really just amounts to
+# ignoring it.  this allows someone to start a paragraph with an =
+#
+sub process_Z {
+    my($str) = @_;
+
+    # there is no equivalent in HTML for this so just ignore it.
+    $str = "";
+    return $str;
+}
+
+#
+# process_S - process the S<> pod directive which means to convert all
+# spaces in the string to non-breaking spaces (in HTML-eze).
+#
+sub process_S {
+    my($str) = @_;
+
+    # convert all spaces in the text to non-breaking spaces in HTML.
+    $str =~ s/ /&nbsp;/g;
+    return $str;
+}
+
+#
+# process_X - this is supposed to make an index entry.  we'll just 
+# ignore it.
+#
+sub process_X {
+    return '';
+}
+
+
+#
+# finish_list - finish off any pending HTML lists.  this should be called
+# after the entire pod file has been read and converted.
+#
+sub finish_list {
+    while ($listlevel >= 0) {
+	print HTML "</DL>\n";
+	$listlevel--;
+    }
+}
+
+#
+# htmlify - converts a pod section specification to a suitable section
+# specification for HTML.  if first arg is 1, only takes 1st word.
+#
+sub htmlify {
+    my($compact, $heading) = @_;
+
+    if ($compact) {
+      $heading =~ /^(\w+)/;
+      $heading = $1;
+    } 
+
+  # $heading = lc($heading);
+  $heading =~ s/[^\w\s]/_/g;
+  $heading =~ s/(\s+)/ /g;
+  $heading =~ s/^\s*(.*?)\s*$/$1/s;
+  $heading =~ s/ /_/g;
+  $heading =~ s/\A(.{32}).*\Z/$1/s;
+  $heading =~ s/\s+\Z//;
+  $heading =~ s/_{2,}/_/g;
+
+  return $heading;
+}
+
+BEGIN {
+}
+
+1;
+
diff --git a/lib/Pod/Text.pm b/lib/Pod/Text.pm
index ac4f72b688..f723bb3500 100644
--- a/lib/Pod/Text.pm
+++ b/lib/Pod/Text.pm
@@ -1,7 +1,5 @@
 package Pod::Text;
 
-# Version 1.01
-
 =head1 NAME
 
 Pod::Text - convert POD data to formatted ASCII text
@@ -14,7 +12,7 @@ Pod::Text - convert POD data to formatted ASCII text
 
 Also:
 
-	pod2text < input.pod
+	pod2text [B<-a>] [B<->I<width>] < input.pod
 
 =head1 DESCRIPTION
 
@@ -27,14 +25,16 @@ will be used to simulate bold and underlined text.
 A separate F<pod2text> program is included that is primarily a wrapper for
 Pod::Text.
 
-The single function C<pod2text()> can take one or two arguments. The first
-should be the name of a file to read the pod from, or "<&STDIN" to read from
+The single function C<pod2text()> can take the optional options B<-a>
+for an alternative output format, then a B<->I<width> option with the
+max terminal width, followed by one or two arguments. The first
+should be the name of a file to read the pod from, or "E<lt>&STDIN" to read from
 STDIN. A second argument, if provided, should be a filehandle glob where
 output should be sent.
 
 =head1 AUTHOR
 
-Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
+Tom Christiansen E<lt>F<tchrist@mox.perl.com>E<gt>
 
 =head1 TODO
 
@@ -49,8 +49,13 @@ require Exporter;
 @ISA = Exporter;
 @EXPORT = qw(pod2text);
 
+use vars qw($VERSION);
+$VERSION = "1.0203";
+
 $termcap=0;
 
+$opt_alt_format = 0;
+
 #$use_format=1;
 
 $UNDL = "\x1b[4m";
@@ -59,8 +64,7 @@ $BOLD = "\x1b[1m";
 $NORM = "\x1b[0m";
 
 sub pod2text {
-local($file,*OUTPUT) = @_;
-*OUTPUT = *STDOUT if @_<2;
+shift if $opt_alt_format = ($_[0] eq '-a');
 
 if($termcap and !$setuptermcap) {
 	$setuptermcap=1;
@@ -73,11 +77,18 @@ if($termcap and !$setuptermcap) {
 }
 
 $SCREEN = ($_[0] =~ /^-(\d+)/ && (shift, $1))
-       || ($ENV{TERMCAP} =~ /co#(\d+)/)[0]
        ||  $ENV{COLUMNS}
+       || ($ENV{TERMCAP} =~ /co#(\d+)/)[0]
        || (`stty -a 2>/dev/null` =~ /(\d+) columns/)[0]
        || 72;
 
+@_ = ("<&STDIN") unless @_;
+local($file,*OUTPUT) = @_;
+*OUTPUT = *STDOUT if @_<2;
+
+local $: = $:;
+$: = " \n" if $opt_alt_format;	# Do not break ``-L/lib/'' into ``- L/lib/''.
+
 $/ = "";
 
 $FANCY = 0;
@@ -86,6 +97,7 @@ $cutting = 1;
 $DEF_INDENT = 4;
 $indent = $DEF_INDENT;
 $needspace = 0;
+$begun = "";
 
 open(IN, $file) || die "Couldn't open $file: $!";
 
@@ -94,6 +106,15 @@ POD_DIRECTIVE: while (<IN>) {
 	next unless /^=/;
 	$cutting = 0;
     }
+    if ($begun) {
+        if (/^=end\s+$begun/) {
+             $begun = "";
+        }
+        elsif ($begun eq "text") {
+            print OUTPUT $_;
+        }
+        next;
+    }
     1 while s{^(.*?)(\t+)(.*)$}{
 	$1
 	. (' ' x (length($2) * 8 - length($1) % 8))
@@ -101,11 +122,26 @@ POD_DIRECTIVE: while (<IN>) {
     }me;
     # Translate verbatim paragraph
     if (/^\s/) {
-	$needspace = 1;
 	output($_);
 	next;
     }
 
+    if (/^=for\s+(\S+)\s*(.*)/s) {
+        if ($1 eq "text") {
+            print OUTPUT $2,"";
+        } else {
+            # ignore unknown for
+        }
+        next;
+    }
+    elsif (/^=begin\s+(\S+)\s*(.*)/s) {
+        $begun = $1;
+        if ($1 eq "text") {
+            print OUTPUT $2."";
+        }
+        next;
+    }
+
 sub prepare_for_output {
 
     s/\s*$/\n/;
@@ -116,14 +152,19 @@ sub prepare_for_output {
     $maxnest = 10;
     while ($maxnest-- && /[A-Z]</) {
 	unless ($FANCY) {
-	    s/C<(.*?)>/`$1'/g;
+	    if ($opt_alt_format) {
+		s/[BC]<(.*?)>/``$1''/sg;
+		s/F<(.*?)>/"$1"/sg;
+	    } else {
+		s/C<(.*?)>/`$1'/sg;
+	    }
 	} else {
-	    s/C<(.*?)>/noremap("E<lchevron>${1}E<rchevron>")/ge;
+	    s/C<(.*?)>/noremap("E<lchevron>${1}E<rchevron>")/sge;
 	}
         # s/[IF]<(.*?)>/italic($1)/ge;
-        s/I<(.*?)>/*$1*/g;
+        s/I<(.*?)>/*$1*/sg;
         # s/[CB]<(.*?)>/bold($1)/ge;
-	s/X<.*?>//g;
+	s/X<.*?>//sg;
 	# LREF: a manpage(3f)
 	s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the $1$2 manpage:g;
 	# LREF: an =item on another manpage
@@ -167,9 +208,9 @@ sub prepare_for_output {
 		    ?  "the section on \"$2\" in the $1 manpage"
 		    :  "the section on \"$2\""
 	    }
-	}gex;
+	}sgex;
 
-        s/[A-Z]<(.*?)>/$1/g;
+        s/[A-Z]<(.*?)>/$1/sg;
     }
     clear_noremap(1);
 }
@@ -184,10 +225,18 @@ sub prepare_for_output {
 	if ($Cmd eq 'cut') {
 	    $cutting = 1;
 	}
+	elsif ($Cmd eq 'pod') {
+	    $cutting = 0;
+	}
 	elsif ($Cmd eq 'head1') {
 	    makespace();
+	    if ($opt_alt_format) {
+		print OUTPUT "\n";
+		s/^(.+?)[ \t]*$/==== $1 ====/;
+	    }
 	    print OUTPUT;
 	    # print OUTPUT uc($_);
+	    $needspace = $opt_alt_format;
 	}
 	elsif ($Cmd eq 'head2') {
 	    makespace();
@@ -195,7 +244,13 @@ sub prepare_for_output {
 	    #print ' ' x $DEF_INDENT, $_;
 	    # print "\xA7";
 	    s/(\w)/\xA7 $1/ if $FANCY;
-	    print OUTPUT ' ' x ($DEF_INDENT/2), $_, "\n";
+	    if ($opt_alt_format) {
+		s/^(.+?)[ \t]*$/==   $1   ==/;
+		print OUTPUT "\n", $_;
+	    } else {
+		print OUTPUT ' ' x ($DEF_INDENT/2), $_, "\n";
+	    }
+	    $needspace = $opt_alt_format;
 	}
 	elsif ($Cmd eq 'over') {
 	    push(@indent,$indent);
@@ -204,7 +259,6 @@ sub prepare_for_output {
 	elsif ($Cmd eq 'back') {
 	    $indent = pop(@indent);
 	    warn "Unmatched =back\n" unless defined $indent;
-	    $needspace = 1;
 	}
 	elsif ($Cmd eq 'item') {
 	    makespace();
@@ -223,7 +277,7 @@ sub prepare_for_output {
 		    IP_output($paratag, $_);
 		} else {
 		    local($indent) = $indent[$#index - 1] || $DEF_INDENT;
-		    output($_);
+		    output($_, 0);
 		}
 	    }
 	}
@@ -317,7 +371,9 @@ sub IP_output {
     s/\s+/ /g;
     s/^ //;
     $str = "format OUTPUT = \n"
-	. (" " x ($tag_indent))
+	. (($opt_alt_format && $tag_indent > 1)
+	   ? ":" . " " x ($tag_indent - 1)
+	   : " " x ($tag_indent))
 	. '@' . ('<' x ($indent - $tag_indent - 1))
 	. "^" .  ("<" x ($cols - 1)) . "\n"
 	. '$tag, $_'
@@ -345,6 +401,7 @@ sub output {
     } else {
 	s/^/' ' x $indent/gem;
 	s/^\s+\n$/\n/gm;
+	s/^  /: /s if defined($reformat) && $opt_alt_format;
 	print OUTPUT;
     }
 }
@@ -357,9 +414,8 @@ sub noremap {
 
 sub init_noremap {
     die "unmatched init" if $mapready++;
-    if ( /[\200-\377]/ ) {
-	warn "hit bit char in input stream";
-    }
+    #mask off high bit characters in input stream
+    s/([\200-\377])/"E<".ord($1).">"/ge;
 }
 
 sub clear_noremap {
@@ -370,15 +426,21 @@ sub clear_noremap {
     # otherwise the interative \w<> processing would have
     # been hosed by the E<gt>
     s {
-	    E<	
-	    ( [A-Za-z]+ )	
+	    E<
+	    (
+	    	( \d+ )
+	    	| ( [A-Za-z]+ )
+	    )
 	    >	
     } {
 	 do {
-	     defined $HTML_Escapes{$1}
-		? do { $HTML_Escapes{$1} }
+	 	defined $2
+	 	? chr($2)
+	 	:
+	     defined $HTML_Escapes{$3}
+		? do { $HTML_Escapes{$3} }
 		: do {
-		    warn "Unknown escape: $& in $_";
+		    warn "Unknown escape: E<$1> in $_";
 		    "E<$1>";
 		}
 	 }
diff --git a/lib/Search/Dict.pm b/lib/Search/Dict.pm
index 295da6b31d..9a229a7bc0 100644
--- a/lib/Search/Dict.pm
+++ b/lib/Search/Dict.pm
@@ -37,7 +37,7 @@ sub look {
     my($size, $blksize) = @stat[7,11];
     $blksize ||= 8192;
     $key =~ s/[^\w\s]//g if $dict;
-    $key =~ tr/A-Z/a-z/ if $fold;
+    $key = lc $key if $fold;
     my($min, $max, $mid) = (0, int($size / $blksize));
     while ($max - $min > 1) {
 	$mid = int(($max + $min) / 2);
@@ -47,7 +47,7 @@ sub look {
 	$_ = <FH>;
 	chop;
 	s/[^\w\s]//g if $dict;
-	tr/A-Z/a-z/ if $fold;
+	$_ = lc $_ if $fold;
 	if (defined($_) && $_ lt $key) {
 	    $min = $mid;
 	}
@@ -61,11 +61,11 @@ sub look {
     <FH> if $min;
     for (;;) {
 	$min = tell(FH);
-	$_ = <FH>
+	defined($_ = <FH>)
 	    or last;
 	chop;
 	s/[^\w\s]//g if $dict;
-	y/A-Z/a-z/ if $fold;
+	$_ = lc $_ if $fold;
 	last if $_ ge $key;
     }
     seek(FH,$min,0);
diff --git a/lib/SelectSaver.pm b/lib/SelectSaver.pm
index 4c764bedcf..5f569222fc 100644
--- a/lib/SelectSaver.pm
+++ b/lib/SelectSaver.pm
@@ -38,8 +38,10 @@ use Symbol;
 
 sub new {
     @_ >= 1 && @_ <= 2 or croak 'usage: new SelectSaver [FILEHANDLE]';
-    my $fh = (@_ > 1) ? (select qualify($_[1], caller)) : select;
-    bless [$fh], $_[0];
+    my $fh = select;
+    my $self = bless [$fh], $_[0];
+    select qualify($_[1], caller) if @_ > 1;
+    $self;
 }
 
 sub DESTROY {
diff --git a/lib/SelfLoader.pm b/lib/SelfLoader.pm
index e3da9ebadb..f93841c862 100644
--- a/lib/SelfLoader.pm
+++ b/lib/SelfLoader.pm
@@ -3,25 +3,26 @@ use Carp;
 require Exporter;
 @ISA = qw(Exporter);
 @EXPORT = qw(AUTOLOAD);
-$VERSION = 1.06; sub Version {$VERSION}
+$VERSION = 1.07; sub Version {$VERSION}
 $DEBUG = 0;
 
 my %Cache;      # private cache for all SelfLoader's client packages
 
 AUTOLOAD {
     print STDERR "SelfLoader::AUTOLOAD for $AUTOLOAD\n" if $DEBUG;
-    my $code = $Cache{$AUTOLOAD};
-    unless ($code) {
+    my $SL_code = $Cache{$AUTOLOAD};
+    unless ($SL_code) {
         # Maybe this pack had stubs before __DATA__, and never initialized.
         # Or, this maybe an automatic DESTROY method call when none exists.
         $AUTOLOAD =~ m/^(.*)::/;
         SelfLoader->_load_stubs($1) unless exists $Cache{"${1}::<DATA"};
-        $code = $Cache{$AUTOLOAD};
-        $code = "sub $AUTOLOAD { }" if (!$code and $AUTOLOAD =~ m/::DESTROY$/);
-        croak "Undefined subroutine $AUTOLOAD" unless $code;
+        $SL_code = $Cache{$AUTOLOAD};
+        $SL_code = "sub $AUTOLOAD { }"
+            if (!$SL_code and $AUTOLOAD =~ m/::DESTROY$/);
+        croak "Undefined subroutine $AUTOLOAD" unless $SL_code;
     }
-    print STDERR "SelfLoader::AUTOLOAD eval: $code\n" if $DEBUG;
-    eval $code;
+    print STDERR "SelfLoader::AUTOLOAD eval: $SL_code\n" if $DEBUG;
+    eval $SL_code;
     if ($@) {
         $@ =~ s/ at .*\n//;
         croak $@;
@@ -44,8 +45,8 @@ sub _load_stubs {
         unless fileno($fh);
     $Cache{"${currpack}::<DATA"} = 1;   # indicate package is cached
 
-    while($line = <$fh> and $line !~ m/^__END__/) {
-        if ($line =~ m/^sub\s+([\w:]+)\s*(\([\$\@\;\%\\]*\))?/) {       # A sub declared
+    while(defined($line = <$fh>) and $line !~ m/^__END__/) {
+        if ($line =~ m/^sub\s+([\w:]+)\s*(\([\\\$\@\%\&\*\;]*\))?/) {
             push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype));
             $protoype = $2;
             @lines = ($line);
@@ -119,117 +120,123 @@ SelfLoader - load functions only on demand
 =head1 DESCRIPTION
 
 This module tells its users that functions in the FOOBAR package are to be
-autoloaded from after the __DATA__ token.  See also L<perlsub/"Autoloading">.
+autoloaded from after the C<__DATA__> token.  See also
+L<perlsub/"Autoloading">.
 
 =head2 The __DATA__ token
 
-The __DATA__ token tells the perl compiler that the perl code
-for compilation is finished. Everything after the __DATA__ token
+The C<__DATA__> token tells the perl compiler that the perl code
+for compilation is finished. Everything after the C<__DATA__> token
 is available for reading via the filehandle FOOBAR::DATA,
-where FOOBAR is the name of the current package when the __DATA__
-token is reached. This works just the same as __END__ does in
-package 'main', but for other modules data after __END__ is not
-automatically retreivable , whereas data after __DATA__ is.
-The __DATA__ token is not recognized in versions of perl prior to
+where FOOBAR is the name of the current package when the C<__DATA__>
+token is reached. This works just the same as C<__END__> does in
+package 'main', but for other modules data after C<__END__> is not
+automatically retreivable , whereas data after C<__DATA__> is.
+The C<__DATA__> token is not recognized in versions of perl prior to
 5.001m.
 
-Note that it is possible to have __DATA__ tokens in the same package
-in multiple files, and that the last __DATA__ token in a given
+Note that it is possible to have C<__DATA__> tokens in the same package
+in multiple files, and that the last C<__DATA__> token in a given
 package that is encountered by the compiler is the one accessible
-by the filehandle. This also applies to __END__ and main, i.e. if
-the 'main' program has an __END__, but a module 'require'd (_not_ 'use'd)
-by that program has a 'package main;' declaration followed by an '__DATA__',
-then the DATA filehandle is set to access the data after the __DATA__
-in the module, _not_ the data after the __END__ token in the 'main'
+by the filehandle. This also applies to C<__END__> and main, i.e. if
+the 'main' program has an C<__END__>, but a module 'require'd (_not_ 'use'd)
+by that program has a 'package main;' declaration followed by an 'C<__DATA__>',
+then the C<DATA> filehandle is set to access the data after the C<__DATA__>
+in the module, _not_ the data after the C<__END__> token in the 'main'
 program, since the compiler encounters the 'require'd file later.
 
 =head2 SelfLoader autoloading
 
-The SelfLoader works by the user placing the __DATA__
-token _after_ perl code which needs to be compiled and
-run at 'require' time, but _before_ subroutine declarations
+The B<SelfLoader> works by the user placing the C<__DATA__>
+token I<after> perl code which needs to be compiled and
+run at 'require' time, but I<before> subroutine declarations
 that can be loaded in later - usually because they may never
 be called.
 
-The SelfLoader will read from the FOOBAR::DATA filehandle to
-load in the data after __DATA__, and load in any subroutine
+The B<SelfLoader> will read from the FOOBAR::DATA filehandle to
+load in the data after C<__DATA__>, and load in any subroutine
 when it is called. The costs are the one-time parsing of the
-data after __DATA__, and a load delay for the _first_
+data after C<__DATA__>, and a load delay for the _first_
 call of any autoloaded function. The benefits (hopefully)
 are a speeded up compilation phase, with no need to load
 functions which are never used.
 
-The SelfLoader will stop reading from __DATA__ if
-it encounters the __END__ token - just as you would expect.
-If the __END__ token is present, and is followed by the
-token DATA, then the SelfLoader leaves the FOOBAR::DATA
+The B<SelfLoader> will stop reading from C<__DATA__> if
+it encounters the C<__END__> token - just as you would expect.
+If the C<__END__> token is present, and is followed by the
+token DATA, then the B<SelfLoader> leaves the FOOBAR::DATA
 filehandle open on the line after that token.
 
-The SelfLoader exports the AUTOLOAD subroutine to the
-package using the SelfLoader, and this loads the called
+The B<SelfLoader> exports the C<AUTOLOAD> subroutine to the
+package using the B<SelfLoader>, and this loads the called
 subroutine when it is first called.
 
 There is no advantage to putting subroutines which will _always_
-be called after the __DATA__ token.
+be called after the C<__DATA__> token.
 
 =head2 Autoloading and package lexicals
 
 A 'my $pack_lexical' statement makes the variable $pack_lexical
-local _only_ to the file up to the __DATA__ token. Subroutines
+local _only_ to the file up to the C<__DATA__> token. Subroutines
 declared elsewhere _cannot_ see these types of variables,
 just as if you declared subroutines in the package but in another
 file, they cannot see these variables.
 
 So specifically, autoloaded functions cannot see package
-lexicals (this applies to both the SelfLoader and the Autoloader).
+lexicals (this applies to both the B<SelfLoader> and the Autoloader).
+The C<vars> pragma provides an alternative to defining package-level
+globals that will be visible to autoloaded routines. See the documentation
+on B<vars> in the pragma section of L<perlmod>.
 
 =head2 SelfLoader and AutoLoader
 
-The SelfLoader can replace the AutoLoader - just change 'use AutoLoader'
-to 'use SelfLoader' (though note that the SelfLoader exports
+The B<SelfLoader> can replace the AutoLoader - just change 'use AutoLoader'
+to 'use SelfLoader' (though note that the B<SelfLoader> exports
 the AUTOLOAD function - but if you have your own AUTOLOAD and
 are using the AutoLoader too, you probably know what you're doing),
-and the __END__ token to __DATA__. You will need perl version 5.001m
+and the C<__END__> token to C<__DATA__>. You will need perl version 5.001m
 or later to use this (version 5.001 with all patches up to patch m).
 
-There is no need to inherit from the SelfLoader.
+There is no need to inherit from the B<SelfLoader>.
 
-The SelfLoader works similarly to the AutoLoader, but picks up the
-subs from after the __DATA__ instead of in the 'lib/auto' directory.
+The B<SelfLoader> works similarly to the AutoLoader, but picks up the
+subs from after the C<__DATA__> instead of in the 'lib/auto' directory.
 There is a maintainance gain in not needing to run AutoSplit on the module
 at installation, and a runtime gain in not needing to keep opening and
 closing files to load subs. There is a runtime loss in needing
-to parse the code after the __DATA__.
+to parse the code after the C<__DATA__>. Details of the B<AutoLoader> and
+another view of these distinctions can be found in that module's
+documentation.
 
 =head2 __DATA__, __END__, and the FOOBAR::DATA filehandle.
 
 This section is only relevant if you want to use
-the FOOBAR::DATA together with the SelfLoader.
-
-Data after the __DATA__ token in a module is read using the
-FOOBAR::DATA filehandle. __END__ can still be used to denote the end
-of the __DATA__ section if followed by the token DATA - this is supported
-by the SelfLoader. The FOOBAR::DATA filehandle is left open if an __END__
-followed by a DATA is found, with the filehandle positioned at the start
-of the line after the __END__ token. If no __END__ token is present,
-or an __END__ token with no DATA token on the same line, then the filehandle
-is closed.
-
-The SelfLoader reads from wherever the current
-position of the FOOBAR::DATA filehandle is, until the
-EOF or __END__. This means that if you want to use
+the C<FOOBAR::DATA> together with the B<SelfLoader>.
+
+Data after the C<__DATA__> token in a module is read using the
+FOOBAR::DATA filehandle. C<__END__> can still be used to denote the end
+of the C<__DATA__> section if followed by the token DATA - this is supported
+by the B<SelfLoader>. The C<FOOBAR::DATA> filehandle is left open if an
+C<__END__> followed by a DATA is found, with the filehandle positioned at
+the start of the line after the C<__END__> token. If no C<__END__> token is
+present, or an C<__END__> token with no DATA token on the same line, then
+the filehandle is closed.
+
+The B<SelfLoader> reads from wherever the current
+position of the C<FOOBAR::DATA> filehandle is, until the
+EOF or C<__END__>. This means that if you want to use
 that filehandle (and ONLY if you want to), you should either
 
 1. Put all your subroutine declarations immediately after
-the __DATA__ token and put your own data after those
-declarations, using the __END__ token to mark the end
-of subroutine declarations. You must also ensure that the SelfLoader
-reads first by  calling 'SelfLoader->load_stubs();', or by using a
+the C<__DATA__> token and put your own data after those
+declarations, using the C<__END__> token to mark the end
+of subroutine declarations. You must also ensure that the B<SelfLoader>
+reads first by  calling 'SelfLoader-E<gt>load_stubs();', or by using a
 function which is selfloaded;
 
 or
 
-2. You should read the FOOBAR::DATA filehandle first, leaving
+2. You should read the C<FOOBAR::DATA> filehandle first, leaving
 the handle open and positioned at the first line of subroutine
 declarations.
 
@@ -252,11 +259,11 @@ need for stubs as far as autoloading is concerned.
 For modules which ARE classes, and need to handle inherited methods,
 stubs are needed to ensure that the method inheritance mechanism works
 properly. You can load the stubs into the module at 'require' time, by
-adding the statement 'SelfLoader->load_stubs();' to the module to do
+adding the statement 'SelfLoader-E<gt>load_stubs();' to the module to do
 this.
 
-The alternative is to put the stubs in before the __DATA__ token BEFORE
-releasing the module, and for this purpose the Devel::SelfStubber
+The alternative is to put the stubs in before the C<__DATA__> token BEFORE
+releasing the module, and for this purpose the C<Devel::SelfStubber>
 module is available.  However this does require the extra step of ensuring
 that the stubs are in the module. If this is done I strongly recommend
 that this is done BEFORE releasing the module - it should NOT be done
@@ -265,10 +272,10 @@ at install time in general.
 =head1 Multiple packages and fully qualified subroutine names
 
 Subroutines in multiple packages within the same file are supported - but you
-should note that this requires exporting the SelfLoader::AUTOLOAD to
+should note that this requires exporting the C<SelfLoader::AUTOLOAD> to
 every package which requires it. This is done automatically by the
-SelfLoader when it first loads the subs into the cache, but you should
-really specify it in the initialization before the __DATA__ by putting
+B<SelfLoader> when it first loads the subs into the cache, but you should
+really specify it in the initialization before the C<__DATA__> by putting
 a 'use SelfLoader' statement in each package.
 
 Fully qualified subroutine names are also supported. For example,
@@ -278,8 +285,9 @@ Fully qualified subroutine names are also supported. For example,
    package baz;
    sub dob {32}
 
-will all be loaded correctly by the SelfLoader, and the SelfLoader
+will all be loaded correctly by the B<SelfLoader>, and the B<SelfLoader>
 will ensure that the packages 'foo' and 'baz' correctly have the
-SelfLoader AUTOLOAD method when the data after __DATA__ is first parsed.
+B<SelfLoader> C<AUTOLOAD> method when the data after C<__DATA__> is first
+parsed.
 
 =cut
diff --git a/lib/Symbol.pm b/lib/Symbol.pm
index 67808af082..6807e74479 100644
--- a/lib/Symbol.pm
+++ b/lib/Symbol.pm
@@ -23,6 +23,10 @@ Symbol - manipulate Perl symbols and their names
     print qualify(\*x), "\n";              # returns \*x
     print qualify(\*x, "FOO"), "\n";       # returns \*x
 
+    use strict refs;
+    print { qualify_to_ref $fh } "foo!\n";
+    $ref = qualify_to_ref $name, $pkg;
+
 =head1 DESCRIPTION
 
 C<Symbol::gensym> creates an anonymous glob and returns a reference
@@ -34,7 +38,7 @@ support anonymous globs, C<Symbol::ungensym> is also provided.
 But it doesn't do anything.
 
 C<Symbol::qualify> turns unqualified symbol names into qualified
-variable names (e.g. "myvar" -> "MyPackage::myvar").  If it is given a
+variable names (e.g. "myvar" -E<gt> "MyPackage::myvar").  If it is given a
 second parameter, C<qualify> uses it as the default package;
 otherwise, it uses the package of its caller.  Regardless, global
 variable names (e.g. "STDOUT", "ENV", "SIG") are always qualfied with
@@ -44,29 +48,35 @@ Qualification applies only to symbol names (strings).  References are
 left unchanged under the assumption that they are glob references,
 which are qualified by their nature.
 
+C<Symbol::qualify_to_ref> is just like C<Symbol::qualify> except that it
+returns a glob ref rather than a symbol name, so you can use the result
+even if C<use strict 'refs'> is in effect.
+
 =cut
 
 BEGIN { require 5.002; }
 
 require Exporter;
 @ISA = qw(Exporter);
+@EXPORT = qw(gensym ungensym qualify qualify_to_ref);
 
-@EXPORT = qw(gensym ungensym qualify);
+$VERSION = 1.02;
 
 my $genpkg = "Symbol::";
 my $genseq = 0;
 
-my %global;
-while (<DATA>) {
-    chomp;
-    $global{$_} = 1;
-}
-close DATA;
+my %global = map {$_ => 1} qw(ARGV ARGVOUT ENV INC SIG STDERR STDIN STDOUT);
 
+#
+# Note that we never _copy_ the glob; we just make a ref to it.
+# If we did copy it, then SVf_FAKE would be set on the copy, and
+# glob-specific behaviors (e.g. C<*$ref = \&func>) wouldn't work.
+#
 sub gensym () {
     my $name = "GEN" . $genseq++;
-    local *{$genpkg . $name};
-    \delete ${$genpkg}{$name};
+    my $ref = \*{$genpkg . $name};
+    delete $$genpkg{$name};
+    $ref;
 }
 
 sub ungensym ($) {}
@@ -87,14 +97,8 @@ sub qualify ($;$) {
     $name;
 }
 
-1;
+sub qualify_to_ref ($;$) {
+    return \*{ qualify $_[0], @_ > 1 ? $_[1] : caller };
+}
 
-__DATA__
-ARGV
-ARGVOUT
-ENV
-INC
-SIG
-STDERR
-STDIN
-STDOUT
+1;
diff --git a/lib/Sys/Hostname.pm b/lib/Sys/Hostname.pm
index 2c40361b51..92207acb2b 100644
--- a/lib/Sys/Hostname.pm
+++ b/lib/Sys/Hostname.pm
@@ -25,7 +25,7 @@ All nulls, returns, and newlines are removed from the result.
 
 =head1 AUTHOR
 
-David Sundstrom <sunds@asictest.sc.ti.com>
+David Sundstrom E<lt>F<sunds@asictest.sc.ti.com>E<gt>
 
 Texas Instruments
 
@@ -39,7 +39,7 @@ sub hostname {
   if ($^O eq 'VMS') {
 
     # method 2 - no sockets ==> return DECnet node name
-    eval {gethostbyname('me')};
+    eval {my($test) = gethostbyname('me')}; # returns 'me' on most systems
     if ($@) { return $host = $ENV{'SYS$NODE'}; }
 
     # method 3 - has someone else done the job already?  It's common for the
@@ -60,6 +60,11 @@ sub hostname {
     Carp::croak "Cannot get host name of local machine";  
 
   }
+  elsif ($^O eq 'MSWin32') {
+    ($host) = gethostbyname('localhost');
+    chomp($host = `hostname 2> NUL`) unless defined $host;
+    return $host;
+  }
   else {  # Unix
 
     # method 2 - syscall is preferred since it avoids tainting problems
diff --git a/lib/Sys/Syslog.pm b/lib/Sys/Syslog.pm
index f02a2b516c..471be11fcd 100644
--- a/lib/Sys/Syslog.pm
+++ b/lib/Sys/Syslog.pm
@@ -7,6 +7,7 @@ use Carp;
 @EXPORT = qw(openlog closelog setlogmask syslog);
 
 use Socket;
+use Sys::Hostname;
 
 # adapted from syslog.pl
 #
@@ -23,7 +24,7 @@ Sys::Syslog, openlog, closelog, setlogmask, syslog - Perl interface to the UNIX
     use Sys::Syslog;
 
     openlog $ident, $logopt, $facility;
-    syslog $priority, $mask, $format, @args;
+    syslog $priority, $format, @args;
     $oldmask = setlogmask $mask_priority;
     closelog;
 
@@ -43,9 +44,9 @@ I<$ident> is prepended to every message.
 I<$logopt> contains one or more of the words I<pid>, I<ndelay>, I<cons>, I<nowait>.
 I<$facility> specifies the part of the system
 
-=item syslog $priority, $mask, $format, @args
+=item syslog $priority, $format, @args
 
-If I<$priority> and I<$mask> permit, logs I<($format, @args)>
+If I<$priority> permits, logs I<($format, @args)>
 printed as by C<printf(3V)>, with the addition that I<%m>
 is replaced with C<"$!"> (the latest error message).
 
@@ -85,12 +86,10 @@ L<syslog(3)>
 
 =head1 AUTHOR
 
-Tom Christiansen E<lt>F<tchrist@perl.com>E<gt> and Larry Wall E<lt>F<lwall@sems.com>E<gt>
+Tom Christiansen E<lt>F<tchrist@perl.com>E<gt> and Larry Wall E<lt>F<larry@wall.org>E<gt>
 
 =cut
 
-$host = hostname() unless $host;	# set $Syslog::host to change
-
 require 'syslog.ph';
 
 $maskpri = &LOG_UPTO(&LOG_DEBUG);
@@ -155,7 +154,7 @@ sub syslog {
 
     $whoami = $ident;
 
-    if (!$ident && $mask =~ /^(\S.*):\s?(.*)/) {
+    if (!$whoami && $mask =~ /^(\S.*?):\s?(.*)/) {
 	$whoami = $1;
 	$mask = $2;
     } 
@@ -192,16 +191,17 @@ sub syslog {
 
 sub xlate {
     local($name) = @_;
-    $name =~ y/a-z/A-Z/;
+    $name = uc $name;
     $name = "LOG_$name" unless $name =~ /^LOG_/;
     $name = "Sys::Syslog::$name";
-    eval(&$name) || -1;
+    defined &$name ? &$name : -1;
 }
 
 sub connect {
     unless ($host) {
 	require Sys::Hostname;
-	$host = Sys::Hostname::hostname();
+	my($host_uniq) = Sys::Hostname::hostname();
+	($host) = $host_uniq =~ /([\w\-]+)/;
     }
     my $udp = getprotobyname('udp');
     my $syslog = getservbyname('syslog','udp');
diff --git a/lib/Term/Cap.pm b/lib/Term/Cap.pm
index 656889591a..5703405c9d 100644
--- a/lib/Term/Cap.pm
+++ b/lib/Term/Cap.pm
@@ -104,8 +104,11 @@ as C<$self-E<gt>{TERMCAP}>.
 sub termcap_path { ## private
     my @termcap_path;
     # $TERMCAP, if it's a filespec
-    push(@termcap_path, $ENV{TERMCAP}) if ((exists $ENV{TERMCAP}) &&
-                                           ($ENV{TERMCAP} =~ /^\//));
+    push(@termcap_path, $ENV{TERMCAP})
+	if ((exists $ENV{TERMCAP}) &&
+	    (($^O eq 'os2' || $^O eq 'MSWin32')
+	     ? $ENV{TERMCAP} =~ /^[a-z]:[\\\/]/i
+	     : $ENV{TERMCAP} =~ /^\//));
     if ((exists $ENV{TERMPATH}) && ($ENV{TERMPATH})) {
 	# Add the users $TERMPATH
 	push(@termcap_path, split(/(:|\s+)/, $ENV{TERMPATH}))
@@ -185,16 +188,20 @@ sub Tgetent { ## public -- static method
 
     # This is eval'ed inside the while loop for each file
     $search = q{
-	while ($_ = <TERMCAP>) {
+	while (<TERMCAP>) {
 	    next if /^\\t/ || /^#/;
 	    if ($_ =~ m/(^|\\|)${termpat}[:|]/o) {
 		chomp;
 		s/^[^:]*:// if $first++;
 		$state = 0;
-		while ($_ =~ s/\\\\$//) { $_ .= <TERMCAP>; chomp; }
+		while ($_ =~ s/\\\\$//) {
+		    defined(my $x = <TERMCAP>) or last;
+		    $_ .= $x; chomp;
+		}
 		last;
 	    }
 	}
+	defined $entry or $entry = '';
 	$entry .= $_;
     };
 
diff --git a/lib/Term/Complete.pm b/lib/Term/Complete.pm
index 6faef2296e..275aadeb65 100644
--- a/lib/Term/Complete.pm
+++ b/lib/Term/Complete.pm
@@ -28,7 +28,8 @@ The following command characters are defined:
 
 =over 4
 
-=item <tab>
+=item E<lt>tabE<gt>
+
 Attempts word completion.
 Cannot be changed.
 
@@ -42,7 +43,7 @@ Defined by I<$Term::Complete::complete>.
 Erases the current input.
 Defined by I<$Term::Complete::kill>.
 
-=item <del>, <bs>
+=item E<lt>delE<gt>, E<lt>bsE<gt>
 
 Erases one character.
 Defined by I<$Term::Complete::erase1> and I<$Term::Complete::erase2>.
@@ -55,7 +56,7 @@ Bell sounds when word completion fails.
 
 =head1 BUGS
 
-The completion charater <tab> cannot be changed.
+The completion charater E<lt>tabE<gt> cannot be changed.
 
 =head1 AUTHOR
 
@@ -71,6 +72,8 @@ CONFIG: {
 }
 
 sub Complete {
+    my($prompt, @cmp_list, $return, @match, $l, $test, $cmp, $r);
+
     $prompt = shift;
     if (ref $_[0] || $_[0] =~ /^\*/) {
 	@cmp_lst = sort @{$_[0]};
@@ -110,7 +113,8 @@ sub Complete {
                 # (^U) kill
                 $_ eq $kill && do {
                     if ($r) {
-                        undef($r, $return);
+                        undef $r;
+			undef $return;
                         print("\r\n");
                         redo LOOP;
                     }
diff --git a/lib/Term/ReadLine.pm b/lib/Term/ReadLine.pm
index 2ce7423186..a52b558b22 100644
--- a/lib/Term/ReadLine.pm
+++ b/lib/Term/ReadLine.pm
@@ -33,7 +33,7 @@ or as
 
   $term->addhistory('row');
 
-where $term is a return value of Term::ReadLine->Init.
+where $term is a return value of Term::ReadLine-E<gt>Init.
 
 =over 12
 
@@ -74,7 +74,13 @@ history. Returns the old value.
 =item C<findConsole>
 
 returns an array with two strings that give most appropriate names for
-files for input and output using conventions C<"<$in">, C<"E<gt>out">.
+files for input and output using conventions C<"E<lt>$in">, C<"E<gt>out">.
+
+=item Attribs
+
+returns a reference to a hash which describes internal configuration
+of the package. Names of keys in this hash conform to standard
+conventions with the leading C<rl_> stripped.
 
 =item C<Features>
 
@@ -86,26 +92,60 @@ C<MinLine> method is not dummy.  C<autohistory> should be present if
 lines are put into history automatically (maybe subject to
 C<MinLine>), and C<addhistory> if C<addhistory> method is not dummy.
 
+If C<Features> method reports a feature C<attribs> as present, the
+method C<Attribs> is not dummy.
+
 =back
 
+=head1 Additional supported functions
+
 Actually C<Term::ReadLine> can use some other package, that will
 support reacher set of commands.
 
+All these commands are callable via method interface and have names
+which conform to standard conventions with the leading C<rl_> stripped.
+
+The stub package included with the perl distribution allows two
+additional methods: C<tkRunning> and C<ornaments>.  The first one
+makes Tk event loop run when waiting for user input (i.e., during
+C<readline> method), the second one makes the command line stand out
+by using termcap data.  The argument to C<ornaments> should be 0, 1,
+or a string of a form "aa,bb,cc,dd".  Four components of this string
+should be names of I<terminal capacities>, first two will be issued to
+make the prompt standout, last two to make the input line standout.
+
 =head1 EXPORTS
 
 None
 
+=head1 ENVIRONMENT
+
+The variable C<PERL_RL> governs which ReadLine clone is loaded. If the
+value is false, a dummy interface is used. If the value is true, it
+should be tail of the name of the package to use, such as C<Perl> or
+C<Gnu>. 
+
+If the variable is not set, the best available package is loaded.
+
 =cut
 
 package Term::ReadLine::Stub;
+@ISA = qw'Term::ReadLine::Tk Term::ReadLine::TermCap';
 
 $DB::emacs = $DB::emacs;	# To peacify -w
+*rl_term_set = \@Term::ReadLine::TermCap::rl_term_set;
 
 sub ReadLine {'Term::ReadLine::Stub'}
 sub readline {
-  my ($in,$out,$str) = @{shift()};
-  print $out shift; 
-  $str = scalar <$in>;
+  my $self = shift;
+  my ($in,$out,$str) = @$self;
+  print $out $rl_term_set[0], shift, $rl_term_set[1], $rl_term_set[2]; 
+  $self->register_Tk 
+     if not $Term::ReadLine::registered and $Term::ReadLine::toloop
+	and defined &Tk::DoOneEvent;
+  #$str = scalar <$in>;
+  $str = $self->get_line;
+  print $out $rl_term_set[3]; 
   # bug in 5.000: chomping empty string creats length -1:
   chomp $str if defined $str;
   $str;
@@ -123,7 +163,10 @@ sub findConsole {
 	$console = "sys\$command";
     }
 
-    if (defined $ENV{'OS2_SHELL'}) { # In OS/2
+    if ($^O eq 'amigaos') {
+	$console = undef;
+    }
+    elsif ($^O eq 'os2') {
       if ($DB::emacs) {
 	$console = undef;
       } else {
@@ -166,10 +209,27 @@ sub new {
 sub IN { shift->[0] }
 sub OUT { shift->[1] }
 sub MinLine { undef }
-sub Features { {} }
+sub Attribs { {} }
+
+my %features = (tkRunning => 1, ornaments => 1);
+sub Features { \%features }
 
 package Term::ReadLine;		# So late to allow the above code be defined?
-eval "use Term::ReadLine::Gnu;" or eval "use Term::ReadLine::Perl;";
+
+my $which = $ENV{PERL_RL};
+if ($which) {
+  if ($which =~ /\bgnu\b/i){
+    eval "use Term::ReadLine::Gnu;";
+  } elsif ($which =~ /\bperl\b/i) {
+    eval "use Term::ReadLine::Perl;";
+  } else {
+    eval "use Term::ReadLine::$which;";
+  }
+} elsif (defined $which) {	# Defined but false
+  # Do nothing fancy
+} else {
+  eval "use Term::ReadLine::Gnu; 1" or eval "use Term::ReadLine::Perl; 1";
+}
 
 #require FileHandle;
 
@@ -184,6 +244,71 @@ if (defined &Term::ReadLine::Gnu::readline) {
   @ISA = qw(Term::ReadLine::Stub);
 }
 
+package Term::ReadLine::TermCap;
+
+# Prompt-start, prompt-end, command-line-start, command-line-end
+#     -- zero-width beautifies to emit around prompt and the command line.
+@rl_term_set = ("","","","");
+# string encoded:
+$rl_term_set = ',,,';
+
+sub LoadTermCap {
+  return if defined $terminal;
+  
+  require Term::Cap;
+  $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning.
+}
+
+sub ornaments {
+  shift;
+  return $rl_term_set unless @_;
+  $rl_term_set = shift;
+  $rl_term_set ||= ',,,';
+  $rl_term_set = 'us,ue,md,me' if $rl_term_set == 1;
+  my @ts = split /,/, $rl_term_set, 4;
+  eval { LoadTermCap };
+  warn("Cannot find termcap: $@\n"), return unless defined $terminal;
+  @rl_term_set = map {$_ ? $terminal->Tputs($_,1) || '' : ''} @ts;
+  return $rl_term_set;
+}
+
+
+package Term::ReadLine::Tk;
+
+$count_handle = $count_DoOne = $count_loop = 0;
+
+sub handle {$giveup = 1; $count_handle++}
+
+sub Tk_loop {
+  # Tk->tkwait('variable',\$giveup);	# needs Widget
+  $count_DoOne++, Tk::DoOneEvent(0) until $giveup;
+  $count_loop++;
+  $giveup = 0;
+}
+
+sub register_Tk {
+  my $self = shift;
+  $Term::ReadLine::registered++ 
+    or Tk->fileevent($self->IN,'readable',\&handle);
+}
+
+sub tkRunning {
+  $Term::ReadLine::toloop = $_[1] if @_ > 1;
+  $Term::ReadLine::toloop;
+}
+
+sub get_c {
+  my $self = shift;
+  $self->Tk_loop if $Term::ReadLine::toloop && defined &Tk::DoOneEvent;
+  return getc $self->IN;
+}
+
+sub get_line {
+  my $self = shift;
+  $self->Tk_loop if $Term::ReadLine::toloop && defined &Tk::DoOneEvent;
+  my $in = $self->IN;
+  return scalar <$in>;
+}
 
 1;
 
diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm
index 7d899a69f9..6979a11549 100644
--- a/lib/Test/Harness.pm
+++ b/lib/Test/Harness.pm
@@ -1,18 +1,39 @@
 package Test::Harness;
 
+BEGIN {require 5.002;}
 use Exporter;
 use Benchmark;
 use Config;
 use FileHandle;
-use vars qw($VERSION $verbose $switches);
-require 5.002;
+use strict;
 
-$VERSION = "1.07";
+use vars qw($VERSION $verbose $switches $have_devel_corestack $curtest
+	    @ISA @EXPORT @EXPORT_OK);
+$have_devel_corestack = 0;
+
+$VERSION = "1.1502";
 
 @ISA=('Exporter');
 @EXPORT= qw(&runtests);
 @EXPORT_OK= qw($verbose $switches);
 
+format STDOUT_TOP =
+Failed Test  Status Wstat Total Fail  Failed  List of failed
+------------------------------------------------------------------------------
+.
+
+format STDOUT =
+@<<<<<<<<<<<<<< @>> @>>>> @>>>> @>>> ^##.##%  @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+{ $curtest->{name},
+                $curtest->{estat},
+                    $curtest->{wstat},
+                          $curtest->{max},
+                                $curtest->{failed},
+                                     $curtest->{percent},
+                                              $curtest->{canon}
+}
+.
+
 
 $verbose = 0;
 $switches = "-w";
@@ -20,100 +41,192 @@ $switches = "-w";
 sub runtests {
     my(@tests) = @_;
     local($|) = 1;
-    my($test,$te,$ok,$next,$max,$pct);
+    my($test,$te,$ok,$next,$max,$pct,$totok,@failed,%failedtests);
     my $totmax = 0;
     my $files = 0;
     my $bad = 0;
     my $good = 0;
     my $total = @tests;
-    local($ENV{'PERL5LIB'}) = join($Config{path_sep}, @INC); # pass -I flags to children
+
+    # pass -I flags to children
+    my $old5lib = $ENV{PERL5LIB};
+    local($ENV{'PERL5LIB'}) = join($Config{path_sep}, @INC);
+
+    if ($^O eq 'VMS') { $switches =~ s/-(\S*[A-Z]\S*)/"-$1"/g }
 
     my $t_start = new Benchmark;
     while ($test = shift(@tests)) {
 	$te = $test;
 	chop($te);
+	if ($^O eq 'VMS') { $te =~ s/^.*\.t\./[.t./; }
 	print "$te" . '.' x (20 - length($te));
 	my $fh = new FileHandle;
-	$fh->open("$^X $switches $test|") || (print "can't run. $!\n");
+	$fh->open($test) or print "can't open $test. $!\n";
+	my $first = <$fh>;
+	my $s = $switches;
+	$s .= q[ "-T"] if $first =~ /^#!.*\bperl.*-\w*T/;
+	$fh->close or print "can't close $test. $!\n";
+	my $cmd = "$^X $s $test|";
+	$cmd = "MCR $cmd" if $^O eq 'VMS';
+	$fh->open($cmd) or print "can't run $test. $!\n";
 	$ok = $next = $max = 0;
 	@failed = ();
 	while (<$fh>) {
 	    if( $verbose ){
 		print $_;
 	    }
-	    unless (/^\s*\#/) {
-		if (/^1\.\.([0-9]+)/) {
-		    $max = $1;
-		    $totmax += $max;
-		    $files++;
-		    $next = 1;
-		} elsif ($max && /^(not\s+)?ok\b/) {
-		    my $this = $next;
-		    if (/^not ok\s*(\d*)/){
-			$this = $1 if $1 > 0;
-			push @failed, $this;
-		    } elsif (/^ok\s*(\d*)/) {
-			$this = $1 if $1 > 0;
-			$ok++;
-			$totok++;
-		    }
-		    if ($this > $next) {
-			# warn "Test output counter mismatch [test $this]\n";
-			# no need to warn probably
-			push @failed, $next..$this-1;
-		    } elsif ($this < $next) {
-			#we have seen more "ok" lines than the number suggests
-			warn "Aborting test: output counter mismatch [test $this answered when test $next expected]\n";
-			last;
-		    }
-		    $next = $this + 1;
+	    if (/^1\.\.([0-9]+)/) {
+		$max = $1;
+		$totmax += $max;
+		$files++;
+		$next = 1;
+	    } elsif ($max && /^(not\s+)?ok\b/) {
+		my $this = $next;
+		if (/^not ok\s*(\d*)/){
+		    $this = $1 if $1 > 0;
+		    push @failed, $this;
+		} elsif (/^ok\s*(\d*)/) {
+		    $this = $1 if $1 > 0;
+		    $ok++;
+		    $totok++;
+		}
+		if ($this > $next) {
+		    # warn "Test output counter mismatch [test $this]\n";
+		    # no need to warn probably
+		    push @failed, $next..$this-1;
+		} elsif ($this < $next) {
+		    #we have seen more "ok" lines than the number suggests
+		    warn "Confused test output: test $this answered after test ", $next-1, "\n";
+		    $next = $this;
 		}
+		$next = $this + 1;
 	    }
 	}
 	$fh->close; # must close to reap child resource values
 	my $wstatus = $?;
-	my $estatus = $wstatus >> 8;
-	if ($ok == $max && $next == $max+1 && ! $estatus) {
-	    print "ok\n";
+	my $estatus = ($^O eq 'VMS'
+		       ? eval 'use vmsish "status"; $estatus = $?'
+		       : $wstatus >> 8);
+	if ($wstatus) {
+	    my ($failed, $canon, $percent) = ('??', '??');
+	    print "dubious\n\tTest returned status $estatus (wstat $wstatus)\n";
+	    print "\t\t(VMS status is $estatus)\n" if $^O eq 'VMS';
+	    if (corestatus($wstatus)) { # until we have a wait module
+		if ($have_devel_corestack) {
+		    Devel::CoreStack::stack($^X);
+		} else {
+		    print "\ttest program seems to have generated a core\n";
+		}
+	    }
+	    $bad++;
+	    if ($max) {
+	      if ($next == $max + 1 and not @failed) {
+		print "\tafter all the subtests completed successfully\n";
+		$percent = 0;
+		$failed = 0;	# But we do not set $canon!
+	      } else {
+		push @failed, $next..$max;
+		$failed = @failed;
+		(my $txt, $canon) = canonfailed($max,@failed);
+		$percent = 100*(scalar @failed)/$max;
+		print "DIED. ",$txt;
+	      }
+	    }
+	    $failedtests{$test} = { canon => $canon,  max => $max || '??',
+				    failed => $failed, 
+				    name => $test, percent => $percent,
+				    estat => $estatus, wstat => $wstatus,
+				  };
+	} elsif ($ok == $max && $next == $max+1) {
+	    if ($max) {
+		print "ok\n";
+	    } else {
+		print "skipping test on this platform\n";
+	    }
 	    $good++;
 	} elsif ($max) {
 	    if ($next <= $max) {
 		push @failed, $next..$max;
 	    }
 	    if (@failed) {
-		print canonfailed($max,@failed);
+		my ($txt, $canon) = canonfailed($max,@failed);
+		print $txt;
+		$failedtests{$test} = { canon => $canon,  max => $max,
+					failed => scalar @failed,
+					name => $test, percent => 100*(scalar @failed)/$max,
+					estat => '', wstat => '',
+				      };
 	    } else {
-		print "Don't know which tests failed for some reason\n";
+		print "Don't know which tests failed: got $ok ok, expected $max\n";
+		$failedtests{$test} = { canon => '??',  max => $max,
+					failed => '??', 
+					name => $test, percent => undef,
+					estat => '', wstat => '',
+				      };
 	    }
 	    $bad++;
 	} elsif ($next == 0) {
 	    print "FAILED before any test output arrived\n";
 	    $bad++;
-	}
-	if ($wstatus) {
-	    print "\tTest returned status $estatus (wstat $wstatus)\n";
+	    $failedtests{$test} = { canon => '??',  max => '??',
+				    failed => '??',
+				    name => $test, percent => undef,
+				    estat => '', wstat => '',
+				  };
 	}
     }
     my $t_total = timediff(new Benchmark, $t_start);
     
+    if ($^O eq 'VMS') {
+	if (defined $old5lib) {
+	    $ENV{PERL5LIB} = $old5lib;
+	} else {
+	    delete $ENV{PERL5LIB};
+	}
+    }
     if ($bad == 0 && $totmax) {
 	    print "All tests successful.\n";
     } elsif ($total==0){
 	die "FAILED--no tests were run for some reason.\n";
     } elsif ($totmax==0) {
 	my $blurb = $total==1 ? "script" : "scripts";
-	die "FAILED--$total test $blurb could be run, alas -- no output ever seen\n";
+	die "FAILED--$total test $blurb could be run, alas--no output ever seen\n";
     } else {
 	$pct = sprintf("%.2f", $good / $total * 100);
 	my $subpct = sprintf " %d/%d subtests failed, %.2f%% okay.",
 	$totmax - $totok, $totmax, 100*$totok/$totmax;
-	if ($bad == 1) {
-	    die "Failed 1 test script, $pct% okay.$subpct\n";
-	} else {
+	my $script;
+	for $script (sort keys %failedtests) {
+	  $curtest = $failedtests{$script};
+	  write;
+	}
+	if ($bad) {
 	    die "Failed $bad/$total test scripts, $pct% okay.$subpct\n";
 	}
     }
     printf("Files=%d,  Tests=%d, %s\n", $files, $totmax, timestr($t_total, 'nop'));
+
+    return ($bad == 0 && $totmax) ;
+}
+
+my $tried_devel_corestack;
+sub corestatus {
+    my($st) = @_;
+    my($ret);
+
+    eval {require 'wait.ph'};
+    if ($@) {
+      SWITCH: {
+	    $ret = ($st & 0200); # Tim says, this is for 90%
+	}
+    } else {
+	$ret = WCOREDUMP($st);
+    }
+
+    eval { require Devel::CoreStack; $have_devel_corestack++ } 
+      unless $tried_devel_corestack++;
+
+    $ret;
 }
 
 sub canonfailed ($@) {
@@ -125,6 +238,7 @@ sub canonfailed ($@) {
     my @canon = ();
     my $min;
     my $last = $min = shift @failed;
+    my $canon;
     if (@failed) {
 	for (@failed, $failed[-1]) { # don't forget the last one
 	    if ($_ > $last+1 || $_ == $last) {
@@ -139,13 +253,16 @@ sub canonfailed ($@) {
 	}
 	local $" = ", ";
 	push @result, "FAILED tests @canon\n";
+	$canon = "@canon";
     } else {
 	push @result, "FAILED test $last\n";
+	$canon = $last;
     }
 
     push @result, "\tFailed $failed/$max tests, ";
     push @result, sprintf("%.2f",100*(1-$failed/$max)), "% okay\n";
-    join "", @result;
+    my $txt = join "", @result;
+    ($txt, $canon);
 }
 
 1;
@@ -165,22 +282,21 @@ runtests(@tests);
 
 Perl test scripts print to standard output C<"ok N"> for each single
 test, where C<N> is an increasing sequence of integers. The first line
-output by a standard test scxript is C<"1..M"> with C<M> being the
+output by a standard test script is C<"1..M"> with C<M> being the
 number of tests that should be run within the test
-script. Test::Harness::runscripts(@tests) runs all the testscripts
+script. Test::Harness::runtests(@tests) runs all the testscripts
 named as arguments and checks standard output for the expected
 C<"ok N"> strings.
 
-After all tests have been performed, runscripts() prints some
+After all tests have been performed, runtests() prints some
 performance statistics that are computed by the Benchmark module.
 
 =head2 The test script output
 
 Any output from the testscript to standard error is ignored and
 bypassed, thus will be seen by the user. Lines written to standard
-output that look like perl comments (start with C</^\s*\#/>) are
-discarded. Lines containing C</^(not\s+)?ok\b/> are interpreted as
-feedback for runtests().
+output containing C</^(not\s+)?ok\b/> are interpreted as feedback for
+runtests().  All other lines are discarded.
 
 It is tolerated if the test numbers after C<ok> are omitted. In this
 case Test::Harness maintains temporarily its own counter until the
@@ -201,12 +317,12 @@ will generate
     Failed 3/6 tests, 50.00% okay
 
 The global variable $Test::Harness::verbose is exportable and can be
-used to let runscripts() display the standard output of the script
+used to let runtests() display the standard output of the script
 without altering the behavior otherwise.
 
 =head1 EXPORT
 
-C<&runscripts> is exported by Test::Harness per default.
+C<&runtests> is exported by Test::Harness per default.
 
 =head1 DIAGNOSTICS
 
@@ -224,7 +340,7 @@ above are printed.
 
 =item C<Test returned status %d (wstat %d)>
 
-Scripts that return a non-zero exit status, both $?>>8 and $? are
+Scripts that return a non-zero exit status, both C<$? E<gt>E<gt> 8> and C<$?> are
 printed in a message similar to the above.
 
 =item C<Failed 1 test, %.2f%% okay. %s>
@@ -244,8 +360,8 @@ See L<Benchmark> for the underlying timing routines.
 
 Either Tim Bunce or Andreas Koenig, we don't know. What we know for
 sure is, that it was inspired by Larry Wall's TEST script that came
-with perl distributions for ages. Current maintainer is Andreas
-Koenig.
+with perl distributions for ages. Numerous anonymous contributors
+exist. Current maintainer is Andreas Koenig.
 
 =head1 BUGS
 
diff --git a/lib/Text/Abbrev.pm b/lib/Text/Abbrev.pm
index d12dfb36a6..ae6797c81a 100644
--- a/lib/Text/Abbrev.pm
+++ b/lib/Text/Abbrev.pm
@@ -8,19 +8,25 @@ abbrev - create an abbreviation table from a list
 
 =head1 SYNOPSIS
 
-    use Abbrev;
-    abbrev *HASH, LIST
+    use Text::Abbrev;
+    abbrev $hashref, LIST
 
 
 =head1 DESCRIPTION
 
 Stores all unambiguous truncations of each element of LIST
-as keys key in the associative array indicated by C<*hash>.
+as keys key in the associative array referenced to by C<$hashref>.
 The values are the original list elements.
 
 =head1 EXAMPLE
 
-    abbrev(*hash,qw("list edit send abort gripe"));
+    $hashref = abbrev qw(list edit send abort gripe);
+
+    %hash = abbrev qw(list edit send abort gripe);
+
+    abbrev $hashref, qw(list edit send abort gripe);
+
+    abbrev(*hash, qw(list edit send abort gripe));
 
 =cut
 
@@ -33,17 +39,26 @@ The values are the original list elements.
 #	$long = $foo{$short};
 
 sub abbrev {
-    local(*domain) = shift;
-    @cmp = @_;
-    %domain = ();
+    my (%domain);
+    my ($name, $ref, $glob);
+
+    if (ref($_[0])) {           # hash reference preferably
+      $ref = shift;
+    } elsif ($_[0] =~ /^\*/) {  # looks like a glob (deprecated)
+      $glob = shift;
+    } 
+    my @cmp = @_;
+
     foreach $name (@_) {
-	@extra = split(//,$name);
-	$abbrev = shift(@extra);
-	$len = 1;
-	foreach $cmp (@cmp) {
+	my @extra = split(//,$name);
+	my $abbrev = shift(@extra);
+	my $len = 1;
+        my $cmp;
+	WORD: foreach $cmp (@cmp) {
 	    next if $cmp eq $name;
 	    while (substr($cmp,0,$len) eq $abbrev) {
-		$abbrev .= shift(@extra);
+                last WORD unless @extra;
+                $abbrev .= shift(@extra);
 		++$len;
 	    }
 	}
@@ -53,6 +68,19 @@ sub abbrev {
 	    $domain{$abbrev} = $name;
 	}
     }
+    if ($ref) {
+      %$ref = %domain;
+      return;
+    } elsif ($glob) {           # old style
+      local (*hash) = $glob;
+      %hash = %domain;
+      return;
+    }
+    if (wantarray) {
+      %domain;
+    } else {
+      \%domain;
+    }
 }
 
 1;
diff --git a/lib/Text/ParseWords.pm b/lib/Text/ParseWords.pm
index 89951387ef..62da1d273f 100644
--- a/lib/Text/ParseWords.pm
+++ b/lib/Text/ParseWords.pm
@@ -1,11 +1,13 @@
 package Text::ParseWords;
 
 require 5.000;
-require Exporter;
-require AutoLoader;
 use Carp;
 
-@ISA = qw(Exporter AutoLoader);
+require AutoLoader;
+*AUTOLOAD = \&AutoLoader::AUTOLOAD;
+
+require Exporter;
+@ISA = qw(Exporter);
 @EXPORT = qw(shellwords quotewords);
 @EXPORT_OK = qw(old_shellwords);
 
@@ -35,7 +37,6 @@ This version differs from the original in that it will _NOT_ default
 to using $_ if no arguments are given.  I personally find the old behavior
 to be a mis-feature.
 
-
 &quotewords() works by simply jamming all of @lines into a single
 string in $_ and then pulling off words a bit at a time until $_
 is exhausted.
@@ -88,43 +89,49 @@ sub quotewords {
 # at a time behavior was necessary if the delimiter was going to be a
 # regexp (love to hear it if you can figure out a better way).
 
-    local($delim, $keep, @lines) = @_;
-    local(@words,$snippet,$field,$_);
+    my ($delim, $keep, @lines) = @_;
+    my (@words, $snippet, $field);
+
+    local $_ = join ('', @lines);
 
-    $_ = join('', @lines);
-    while ($_) {
+    while (length) {
 	$field = '';
+
 	for (;;) {
-            $snippet = '';
-	    if (s/^"(([^"\\]|\\[\\"])*)"//) {
+	    $snippet = '';
+
+	    if (s/^"([^"\\]*(\\.[^"\\]*)*)"//) {
 		$snippet = $1;
-                $snippet = "\"$snippet\"" if ($keep);
+		$snippet = qq|"$snippet"| if $keep;
 	    }
-	    elsif (s/^'(([^'\\]|\\[\\'])*)'//) {
+	    elsif (s/^'([^'\\]*(\\.[^'\\]*)*)'//) {
 		$snippet = $1;
-                $snippet = "'$snippet'" if ($keep);
+		$snippet = "'$snippet'" if $keep;
 	    }
 	    elsif (/^["']/) {
-		croak "Unmatched quote";
+		croak 'Unmatched quote';
 	    }
-            elsif (s/^\\(.)//) {
-                $snippet = $1;
-                $snippet = "\\$snippet" if ($keep);
-            }
-	    elsif (!$_ || s/^$delim//) {
-               last;
+	    elsif (s/^\\(.)//) {
+		$snippet = $1;
+		$snippet = "\\$snippet" if $keep;
+	    }
+	    elsif (!length || s/^$delim//) {
+	       last;
 	    }
 	    else {
-                while ($_ && !(/^$delim/ || /^['"\\]/)) {
-		   $snippet .=  substr($_, 0, 1);
-                   substr($_, 0, 1) = '';
-                }
+		while (length && !(/^$delim/ || /^['"\\]/)) {
+		   $snippet .= substr ($_, 0, 1);
+		   substr($_, 0, 1) = '';
+		}
 	    }
+
 	    $field .= $snippet;
 	}
-	push(@words, $field);
+
+	push @words, $field;
     }
-    @words;
+
+    return @words;
 }
 
 
diff --git a/lib/Text/Soundex.pm b/lib/Text/Soundex.pm
index a334404667..ddc758c94e 100644
--- a/lib/Text/Soundex.pm
+++ b/lib/Text/Soundex.pm
@@ -48,7 +48,7 @@ sub soundex
 
   foreach (@s)
   {
-    tr/a-z/A-Z/;
+    $_ = uc $_;
     tr/A-Z//cd;
 
     if ($_ eq '')
diff --git a/lib/Text/Tabs.pm b/lib/Text/Tabs.pm
index 2481d81ec6..acd7afb7d6 100644
--- a/lib/Text/Tabs.pm
+++ b/lib/Text/Tabs.pm
@@ -1,43 +1,3 @@
-#
-# expand and unexpand tabs as per the unix expand and 
-# unexpand programs.
-#
-# expand and unexpand operate on arrays of lines.  Do not
-# feed strings that contain newlines to them.
-#
-# David Muir Sharnoff <muir@idiom.com>
-# 
-# Version: 9/21/95
-#
-
-=head1 NAME
-
-Text::Tabs -- expand and unexpand tabs
-
-=head1 SYNOPSIS
-
-	use Text::Tabs;
-	
-	#$tabstop = 8; # Defaults
-	print expand("Hello\tworld");
-	print unexpand("Hello,        world");
-	$tabstop = 4;
-	print join("\n",expand(split(/\n/,
-		"Hello\tworld,\nit's a nice day.\n"
-		)));
-
-=head1 DESCRIPTION
-
-This module expands and unexpands tabs into spaces, as per the unix expand
-and unexpand programs. Either function should be passed an array of strings
-(newlines may I<not> be included, and should be used to split an incoming
-string into separate elements.) which will be processed and returned.
-
-=head1 AUTHOR
-
-David Muir Sharnoff <muir@idiom.com>
-
-=cut
 
 package Text::Tabs;
 
@@ -46,35 +6,92 @@ require Exporter;
 @ISA = (Exporter);
 @EXPORT = qw(expand unexpand $tabstop);
 
-$tabstop = 8;
+use vars qw($VERSION $tabstop $debug);
+$VERSION = 96.121201;
+
+use strict;
+
+BEGIN	{
+	$tabstop = 8;
+	$debug = 0;
+}
 
 sub expand
 {
 	my @l = @_;
 	for $_ (@l) {
-		1 while s/^([^\t]*)(\t+)/
-			$1 . (" " x 
-				($tabstop * length($2)
-				- (length($1) % $tabstop)))
-			/e;
+		1 while s/(^|\n)([^\t\n]*)(\t+)/
+			$1. $2 . (" " x 
+				($tabstop * length($3)
+				- (length($2) % $tabstop)))
+			/sex;
 	}
 	return @l if wantarray;
-	return @l[0];
+	return $l[0];
 }
 
 sub unexpand
 {
-	my @l = &expand(@_);
+	my @l = @_;
 	my @e;
+	my $x;
+	my $line;
+	my @lines;
+	my $lastbit;
 	for $x (@l) {
-		@e = split(/(.{$tabstop})/,$x);
-		for $_ (@e) {
-			s/  +$/\t/;
+		@lines = split("\n", $x, -1);
+		for $line (@lines) {
+			$line = expand($line);
+			@e = split(/(.{$tabstop})/,$line,-1);
+			$lastbit = pop(@e);
+			$lastbit = '' unless defined $lastbit;
+			$lastbit = "\t"
+				if $lastbit eq " "x$tabstop;
+			for $_ (@e) {
+				if ($debug) {
+					my $x = $_;
+					$x =~ s/\t/^I\t/gs;
+					print "sub on '$x'\n";
+				}
+				s/  +$/\t/;
+			}
+			$line = join('',@e, $lastbit);
 		}
-		$x = join('',@e);
+		$x = join("\n", @lines);
 	}
 	return @l if wantarray;
-	return @l[0];
+	return $l[0];
 }
 
 1;
+__END__
+
+
+=head1 NAME
+
+Text::Tabs -- expand and unexpand tabs per the unix expand(1) and unexpand(1)
+
+=head1 SYNOPSIS
+
+use Text::Tabs;
+
+$tabstop = 4;
+@lines_without_tabs = expand(@lines_with_tabs);
+@lines_with_tabs = unexpand(@lines_without_tabs);
+
+=head1 DESCRIPTION
+
+Text::Tabs does about what the unix utilities expand(1) and unexpand(1)
+do.  Given a line with tabs in it, expand will replace the tabs with
+the appropriate number of spaces.  Given a line with or without tabs in
+it, unexpand will add tabs when it can save bytes by doing so.  Invisible
+compression with plain ascii!
+
+=head1 BUGS
+
+expand doesn't handle newlines very quickly -- do not feed it an
+entire document in one string.  Instead feed it an array of lines.
+
+=head1 AUTHOR
+
+David Muir Sharnoff <muir@idiom.com>
diff --git a/lib/Text/Wrap.pm b/lib/Text/Wrap.pm
index b665752f94..0910a2ab34 100644
--- a/lib/Text/Wrap.pm
+++ b/lib/Text/Wrap.pm
@@ -1,93 +1,145 @@
-
 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
-#
-
-=head1 NAME
-
-Text::Wrap -- wrap text into a paragraph
-
-=head1 SYNOPSIS
-
-	use Text::Wrap;
-	
-	$Text::Wrap::columns = 20; # Default
-	print wrap("\t","",Hello, world, it's a nice day, isn't it?");
-
-=head1 DESCRIPTION
-
-This module is a simple paragraph formatter that wraps text into a paragraph
-and indents each line. The single exported function, wrap(), takes three
-arguments. The first is included before the first output line, and the
-second argument is included before each subsequest output line. The third
-argument is the text to be wrapped.
-
-=head1 AUTHOR
-
-David Muir Sharnoff <muir@idiom.com>
-
-=cut
-
 require Exporter;
 
 @ISA = (Exporter);
 @EXPORT = qw(wrap);
 @EXPORT_OK = qw($columns);
 
+$VERSION = 97.011701;
+
+use vars qw($VERSION $columns $debug);
+use strict;
+
 BEGIN	{
-	$Text::Wrap::columns = 76;  # <= screen width
+	$columns = 76;  # <= screen width
+	$debug = 0;
 }
 
-use Text::Tabs;
-use strict;
+use Text::Tabs qw(expand unexpand);
 
 sub wrap
 {
 	my ($ip, $xp, @t) = @_;
 
-	my $r;
+	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");
+	my $ll = $columns - length(expand($lead)) - 1;
+	my $nl = "";
+
+	# remove up to a line length of things that aren't
+	# new lines and tabs.
+
+	if ($t =~ s/^([^\n]{0,$ll})(\s|\Z(?!\n))//xm) {
+
+		# accept it.
+		$r .= unexpand($lead . $1);
+
+		# recompute the leader
 		$lead = $xp;
-		my $ll = $Text::Wrap::columns - length(expand($lead)) - 1;
-		while ($t =~ s/^([^\n]{0,$ll})\s//) {
-			$r .= unexpand($lead . $1 . "\n");
+		$ll = $columns - length(expand($lead)) - 1;
+		$nl = $2;
+
+		# repeat the above until there's none left
+		while ($t) {
+			if ( $t =~ s/^([^\n]{0,$ll})(\s|\Z(?!\n))//xm ) {
+				print "\$2 is '$2'\n" if $debug;
+				$nl = $2;
+				$r .= unexpand("\n" . $lead . $1);
+			} elsif ($t =~ s/^([^\n]{$ll})//) {
+				$nl = "\n";
+				$r .= unexpand("\n" . $lead . $1);
+			}
 		}
+		$r .= $nl;
 	} 
+
 	die "couldn't wrap '$t'" 
 		if length($t) > $ll;
-	$r .= $t;
+
+	print "-----------$r---------\n" if $debug;
+
+	print "Finish up with '$lead', '$t'\n" if $debug;
+
+	$r .= $lead . $t if $t ne "";
+
+	print "-----------$r---------\n" if $debug;;
 	return $r;
 }
 
 1;
+__END__
+
+=head1 NAME
+
+Text::Wrap - line wrapping to form simple paragraphs
+
+=head1 SYNOPSIS 
+
+	use Text::Wrap
+
+	print wrap($initial_tab, $subsequent_tab, @text);
+
+	use Text::Wrap qw(wrap $columns);
+
+	$columns = 132;
+
+=head1 DESCRIPTION
+
+Text::Wrap::wrap() is a very simple paragraph formatter.  It formats a
+single paragraph at a time by breaking lines at word boundries.
+Indentation is controlled for the first line ($initial_tab) and
+all subsquent lines ($subsequent_tab) independently.  $Text::Wrap::columns
+should be set to the full width of your output device.
+
+=head1 EXAMPLE
+
+	print wrap("\t","","This is a bit of text that forms 
+		a normal book-style paragraph");
+
+=head1 BUGS
+
+It's not clear what the correct behavior should be when Wrap() is
+presented with a word that is longer than a line.  The previous 
+behavior was to die.  Now the word is split at line-length.
+
+=head1 AUTHOR
+
+David Muir Sharnoff <muir@idiom.com> with help from Tim Pierce and
+others.
+
+=cut
+
+Latest change by Andreas Koenig <k@anna.in-berlin.de> - 1/17/97
+
+	print fill($initial_tab, $subsequent_tab, @text);
+
+	print fill("", "", `cat book`);
+
+Text::Wrap::fill() is a simple multi-paragraph formatter.  It formats
+each paragraph separately and then joins them together when it's done.  It
+will destory any whitespace in the original text.  It breaks text into
+paragraphs by looking for whitespace after a newline.  In other respects
+it acts like wrap().
+
+# Tim Pierce did a faster version of this:
+
+sub fill 
+{
+	my ($ip, $xp, @raw) = @_;
+	my @para;
+	my $pp;
+
+	for $pp (split(/\n\s+/, join("\n",@raw))) {
+		$pp =~ s/\s+/ /g;
+		my $x = wrap($ip, $xp, $pp);
+		push(@para, $x);
+	}
+
+	# if paragraph_indent is the same as line_indent, 
+	# separate paragraphs with blank lines
+
+	return join ($ip eq $xp ? "\n\n" : "\n", @para);
+}
+
diff --git a/lib/Tie/Hash.pm b/lib/Tie/Hash.pm
index 9a9d059a7f..2117c54c18 100644
--- a/lib/Tie/Hash.pm
+++ b/lib/Tie/Hash.pm
@@ -26,8 +26,8 @@ Tie::Hash, Tie::StdHash - base class definitions for tied hashes
     
     package main;
     
-    tie %new_hash, NewHash;
-    tie %new_std_hash, NewStdHash;
+    tie %new_hash, 'NewHash';
+    tie %new_std_hash, 'NewStdHash';
 
 =head1 DESCRIPTION
 
@@ -98,7 +98,7 @@ L<Config> module. While these do not utilize B<Tie::Hash>, they serve as
 good working examples.
 
 =cut
-    
+
 use Carp;
 
 sub new {
diff --git a/lib/Tie/RefHash.pm b/lib/Tie/RefHash.pm
new file mode 100644
index 0000000000..66de2572fc
--- /dev/null
+++ b/lib/Tie/RefHash.pm
@@ -0,0 +1,123 @@
+package Tie::RefHash;
+
+=head1 NAME
+
+Tie::RefHash - use references as hash keys
+
+=head1 SYNOPSIS
+
+    require 5.004;
+    use Tie::RefHash;
+    tie HASHVARIABLE, 'Tie::RefHash', LIST;
+
+    untie HASHVARIABLE;
+
+=head1 DESCRIPTION
+
+This module provides the ability to use references as hash keys if
+you first C<tie> the hash variable to this module.
+
+It is implemented using the standard perl TIEHASH interface.  Please
+see the C<tie> entry in perlfunc(1) and perltie(1) for more information.
+
+=head1 EXAMPLE
+
+    use Tie::RefHash;
+    tie %h, 'Tie::RefHash';
+    $a = [];
+    $b = {};
+    $c = \*main;
+    $d = \"gunk";
+    $e = sub { 'foo' };
+    %h = ($a => 1, $b => 2, $c => 3, $d => 4, $e => 5);
+    $a->[0] = 'foo';
+    $b->{foo} = 'bar';
+    for (keys %h) {
+       print ref($_), "\n";
+    }
+
+
+=head1 AUTHOR
+
+Gurusamy Sarathy        gsar@umich.edu
+
+=head1 VERSION
+
+Version 1.2    15 Dec 1996
+
+=head1 SEE ALSO
+
+perl(1), perlfunc(1), perltie(1)
+
+=cut
+
+require 5.003_11;
+use Tie::Hash;
+@ISA = qw(Tie::Hash);
+use strict;
+
+sub TIEHASH {
+  my $c = shift;
+  my $s = [];
+  bless $s, $c;
+  while (@_) {
+    $s->STORE(shift, shift);
+  }
+  return $s;
+}
+
+sub FETCH {
+  my($s, $k) = @_;
+  (ref $k) ? $s->[0]{"$k"}[1] : $s->[1]{$k};
+}
+
+sub STORE {
+  my($s, $k, $v) = @_;
+  if (ref $k) {
+    $s->[0]{"$k"} = [$k, $v];
+  }
+  else {
+    $s->[1]{$k} = $v;
+  }
+  $v;
+}
+
+sub DELETE {
+  my($s, $k) = @_;
+  (ref $k) ? delete($s->[0]{"$k"}) : delete($s->[1]{$k});
+}
+
+sub EXISTS {
+  my($s, $k) = @_;
+  (ref $k) ? exists($s->[0]{"$k"}) : exists($s->[1]{$k});
+}
+
+sub FIRSTKEY {
+  my $s = shift;
+  my $a = scalar(keys %{$s->[0]}) + scalar(keys %{$s->[1]});
+  $s->[2] = 0;
+  $s->NEXTKEY;
+}
+
+sub NEXTKEY {
+  my $s = shift;
+  my ($k, $v);
+  if (!$s->[2]) {
+    if (($k, $v) = each %{$s->[0]}) {
+      return $s->[0]{"$k"}[0];
+    }
+    else {
+      $s->[2] = 1;
+    }
+  }
+  return each %{$s->[1]};
+}
+
+sub CLEAR {
+  my $s = shift;
+  $s->[2] = 0;
+  %{$s->[0]} = ();
+  %{$s->[1]} = ();
+}
+
+1;
diff --git a/lib/Tie/Scalar.pm b/lib/Tie/Scalar.pm
index 2db02ae1da..ef27dc1398 100644
--- a/lib/Tie/Scalar.pm
+++ b/lib/Tie/Scalar.pm
@@ -26,8 +26,8 @@ Tie::Scalar, Tie::StdScalar - base class definitions for tied scalars
     
     package main;
     
-    tie $new_scalar, NewScalar;
-    tie $new_std_scalar, NewStdScalar;
+    tie $new_scalar, 'NewScalar';
+    tie $new_std_scalar, 'NewStdScalar';
 
 =head1 DESCRIPTION
 
diff --git a/lib/Tie/SubstrHash.pm b/lib/Tie/SubstrHash.pm
index a01c66ef8d..44c2140c7b 100644
--- a/lib/Tie/SubstrHash.pm
+++ b/lib/Tie/SubstrHash.pm
@@ -8,7 +8,7 @@ Tie::SubstrHash - Fixed-table-size, fixed-key-length hashing
 
     require Tie::SubstrHash;
 
-    tie %myhash, Tie::SubstrHash, $key_len, $value_len, $table_size;
+    tie %myhash, 'Tie::SubstrHash', $key_len, $value_len, $table_size;
 
 =head1 DESCRIPTION
 
@@ -144,13 +144,17 @@ sub hashkey {
     $hash = 2;
     for (unpack('C*', $key)) {
 	$hash = $hash * 33 + $_;
+	&_hashwrap if $hash >= 1e13;
     }
-    $hash = $hash - int($hash / $tsize) * $tsize
-	if $hash >= $tsize;
+    &_hashwrap if $hash >= $tsize;
     $hash = 1 unless $hash;
     $hashbase = $hash;
 }
 
+sub _hashwrap {
+    $hash -= int($hash / $tsize) * $tsize;
+}
+
 sub rehash {
     $hash += $hashbase;
     $hash -= $tsize if $hash >= $tsize;
diff --git a/lib/Time/Local.pm b/lib/Time/Local.pm
index 451c7fa20c..0119f9ddb8 100644
--- a/lib/Time/Local.pm
+++ b/lib/Time/Local.pm
@@ -8,7 +8,7 @@ use Carp;
 
 =head1 NAME
 
-Time::Local - efficiently compute tome from local and GMT time
+Time::Local - efficiently compute time from local and GMT time
 
 =head1 SYNOPSIS
 
@@ -39,29 +39,45 @@ after the 1st of January, 2038 on most machines.
 
 =cut
 
-@epoch = localtime(0);
-$tzmin = $epoch[2] * 60 + $epoch[1];	# minutes east of GMT
-if ($tzmin > 0) {
-    $tzmin = 24 * 60 - $tzmin;		# minutes west of GMT
-    $tzmin -= 24 * 60 if $epoch[5] == 70;	# account for the date line
-}
+BEGIN {
+    $SEC  = 1;
+    $MIN  = 60 * $SEC;
+    $HR   = 60 * $MIN;
+    $DAY  = 24 * $HR;
+    $epoch = (localtime(2*$DAY))[5];	# Allow for bugs near localtime == 0.
+
+    $YearFix = ((gmtime(946684800))[5] == 100) ? 100 : 0;
+
+    my $t = time;
+    my @lt = localtime($t);
+    my @gt = gmtime($t);
 
-$SEC = 1;
-$MIN = 60 * $SEC;
-$HR = 60 * $MIN;
-$DAYS = 24 * $HR;
-$YearFix = ((gmtime(946684800))[5] == 100) ? 100 : 0;
+    $tzsec = ($gt[1] - $lt[1]) * $MIN + ($gt[2] - $lt[2]) * $HR;
+
+    my($lday,$gday) = ($lt[7],$gt[7]);
+    if($lt[5] > $gt[5]) {
+	$tzsec -= $DAY;
+    }
+    elsif($gt[5] > $lt[5]) {
+	$tzsec += $DAY;
+    }
+    else {
+	$tzsec += ($gt[7] - $lt[7]) * $DAY;
+    }
+
+  $tzsec += $HR if($lt[8]);
+}
 
 sub timegm {
     $ym = pack(C2, @_[5,4]);
     $cheat = $cheat{$ym} || &cheat;
-    return -1 if $cheat<0;
-    $cheat + $_[0] * $SEC + $_[1] * $MIN + $_[2] * $HR + ($_[3]-1) * $DAYS;
+    return -1 if $cheat<0 and $^O ne 'VMS';
+    $cheat + $_[0] * $SEC + $_[1] * $MIN + $_[2] * $HR + ($_[3]-1) * $DAY;
 }
 
 sub timelocal {
-    $time = &timegm + $tzmin*$MIN;
-    return -1 if $cheat<0;
+    $time = &timegm + $tzsec;
+    return -1 if $cheat<0 and $^O ne 'VMS';
     @test = localtime($time);
     $time -= $HR if $test[2] != $_[2];
     $time;
@@ -69,23 +85,20 @@ sub timelocal {
 
 sub cheat {
     $year = $_[5];
+    $year -= 1900
+    	if $year > 1900;
     $month = $_[4];
-    croak "Month out of range 0..11 in timelocal.pl" 
-	if $month > 11 || $month < 0;
-    croak "Day out of range 1..31 in timelocal.pl" 
-	if $_[3] > 31 || $_[3] < 1;
-    croak "Hour out of range 0..23 in timelocal.pl"
-	if $_[2] > 23 || $_[2] < 0;
-    croak "Minute out of range 0..59 in timelocal.pl"
-	if $_[1] > 59 || $_[1] < 0;
-    croak "Second out of range 0..59 in timelocal.pl"
-	if $_[0] > 59 || $_[0] < 0;
+    croak "Month '$month' out of range 0..11"	if $month > 11 || $month < 0;
+    croak "Day '$_[3]' out of range 1..31"	if $_[3] > 31 || $_[3] < 1;
+    croak "Hour '$_[2]' out of range 0..23"	if $_[2] > 23 || $_[2] < 0;
+    croak "Minute '$_[1]' out of range 0..59"	if $_[1] > 59 || $_[1] < 0;
+    croak "Second '$_[0]' out of range 0..59"	if $_[0] > 59 || $_[0] < 0;
     $guess = $^T;
     @g = gmtime($guess);
-    $year += $YearFix if $year < $epoch[5];
+    $year += $YearFix if $year < $epoch;
     $lastguess = "";
     while ($diff = $year - $g[5]) {
-	$guess += $diff * (363 * $DAYS);
+	$guess += $diff * (363 * $DAY);
 	@g = gmtime($guess);
 	if (($thisguess = "@g") eq $lastguess){
 	    return -1; #date beyond this machine's integer limit
@@ -93,7 +106,7 @@ sub cheat {
 	$lastguess = $thisguess;
     }
     while ($diff = $month - $g[4]) {
-	$guess += $diff * (27 * $DAYS);
+	$guess += $diff * (27 * $DAY);
 	@g = gmtime($guess);
 	if (($thisguess = "@g") eq $lastguess){
 	    return -1; #date beyond this machine's integer limit
@@ -105,7 +118,7 @@ sub cheat {
 	return -1; #date beyond this machine's integer limit
     }
     $g[3]--;
-    $guess -= $g[0] * $SEC + $g[1] * $MIN + $g[2] * $HR + $g[3] * $DAYS;
+    $guess -= $g[0] * $SEC + $g[1] * $MIN + $g[2] * $HR + $g[3] * $DAY;
     $cheat{$ym} = $guess;
 }
 
diff --git a/lib/Time/gmtime.pm b/lib/Time/gmtime.pm
new file mode 100644
index 0000000000..c1d11d74db
--- /dev/null
+++ b/lib/Time/gmtime.pm
@@ -0,0 +1,88 @@
+package Time::gmtime;
+use strict;
+use Time::tm;
+
+BEGIN { 
+    use Exporter   ();
+    use vars       qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
+    @ISA         = qw(Exporter Time::tm);
+    @EXPORT      = qw(gmtime gmctime);
+    @EXPORT_OK   = qw(  
+			$tm_sec $tm_min $tm_hour $tm_mday 
+			$tm_mon $tm_year $tm_wday $tm_yday 
+			$tm_isdst
+		    );
+    %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
+    $VERSION     = 1.01;
+}
+use vars      @EXPORT_OK;
+
+sub populate (@) {
+    return unless @_;
+    my $tmob = Time::tm->new();
+    @$tmob = (
+		$tm_sec, $tm_min, $tm_hour, $tm_mday, 
+		$tm_mon, $tm_year, $tm_wday, $tm_yday, 
+		$tm_isdst )
+	    = @_;
+    return $tmob;
+} 
+
+sub gmtime (;$)    { populate CORE::gmtime(@_ ? shift : time)}
+sub gmctime (;$)   { scalar   CORE::gmtime(@_ ? shift : time)} 
+
+1;
+__END__
+
+=head1 NAME
+
+Time::gmtime - by-name interface to Perl's built-in gmtime() function
+
+=head1 SYNOPSIS
+
+ use Time::gmtime;
+ $gm = gmtime();
+ printf "The day in Greenwich is %s\n", 
+    (qw(Sun Mon Tue Wed Thu Fri Sat Sun))[ gm->wday() ];
+
+ use Time::gmtime w(:FIELDS;
+ printf "The day in Greenwich is %s\n", 
+    (qw(Sun Mon Tue Wed Thu Fri Sat Sun))[ gm_wday() ];
+
+ $now = gmctime();
+
+ use Time::gmtime;
+ use File::stat;
+ $date_string = gmctime(stat($file)->mtime);
+
+=head1 DESCRIPTION
+
+This module's default exports override the core gmtime() function,
+replacing it with a version that returns "Time::tm" objects.
+This object has methods that return the similarly named structure field
+name from the C's tm structure from F<time.h>; namely sec, min, hour,
+mday, mon, year, wday, yday, and isdst.
+
+You may also import all the structure fields directly into your namespace
+as regular variables using the :FIELDS import tag.  (Note that this
+still overrides your core functions.)  Access these fields as variables
+named with a preceding C<tm_> in front their method names.  Thus,
+C<$tm_obj-E<gt>mday()> corresponds to $tm_mday if you import the fields.
+
+The gmctime() funtion provides a way of getting at the 
+scalar sense of the original CORE::gmtime() function.
+
+To access this functionality without the core overrides,
+pass the C<use> an empty import list, and then access
+function functions with their full qualified names.
+On the other hand, the built-ins are still available
+via the C<CORE::> pseudo-package.
+
+=head1 NOTE
+
+While this class is currently implemented using the Class::Struct
+module to build a struct-like class, you shouldn't rely upon this.
+
+=head1 AUTHOR
+
+Tom Christiansen
diff --git a/lib/Time/localtime.pm b/lib/Time/localtime.pm
new file mode 100644
index 0000000000..9437752597
--- /dev/null
+++ b/lib/Time/localtime.pm
@@ -0,0 +1,84 @@
+package Time::localtime;
+use strict;
+use Time::tm;
+
+BEGIN { 
+    use Exporter   ();
+    use vars       qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
+    @ISA         = qw(Exporter Time::tm);
+    @EXPORT      = qw(localtime ctime);
+    @EXPORT_OK   = qw(  
+			$tm_sec $tm_min $tm_hour $tm_mday 
+			$tm_mon $tm_year $tm_wday $tm_yday 
+			$tm_isdst
+		    );
+    %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
+    $VERSION     = 1.01;
+}
+use vars      @EXPORT_OK;
+
+sub populate (@) {
+    return unless @_;
+    my $tmob = Time::tm->new();
+    @$tmob = (
+		$tm_sec, $tm_min, $tm_hour, $tm_mday, 
+		$tm_mon, $tm_year, $tm_wday, $tm_yday, 
+		$tm_isdst )
+	    = @_;
+    return $tmob;
+} 
+
+sub localtime (;$) { populate CORE::localtime(@_ ? shift : time)}
+sub ctime (;$)     { scalar   CORE::localtime(@_ ? shift : time) } 
+
+1;
+
+__END__
+
+=head1 NAME
+
+Time::localtime - by-name interface to Perl's built-in localtime() function
+
+=head1 SYNOPSIS
+
+ use Time::localtime;
+ printf "Year is %d\n", localtime->year() + 1900;
+
+ $now = ctime();
+
+ use Time::localtime;
+ use File::stat;
+ $date_string = ctime(stat($file)->mtime);
+
+=head1 DESCRIPTION
+
+This module's default exports override the core localtime() function,
+replacing it with a version that returns "Time::tm" objects.
+This object has methods that return the similarly named structure field
+name from the C's tm structure from F<time.h>; namely sec, min, hour,
+mday, mon, year, wday, yday, and isdst.
+
+You may also import all the structure fields directly into your namespace
+as regular variables using the :FIELDS import tag.  (Note that this still
+overrides your core functions.)  Access these fields as
+variables named with a preceding C<tm_> in front their method names.
+Thus, C<$tm_obj-E<gt>mday()> corresponds to $tm_mday if you import
+the fields.
+
+The ctime() funtion provides a way of getting at the 
+scalar sense of the original CORE::localtime() function.
+
+To access this functionality without the core overrides,
+pass the C<use> an empty import list, and then access
+function functions with their full qualified names.
+On the other hand, the built-ins are still available
+via the C<CORE::> pseudo-package.
+
+=head1 NOTE
+
+While this class is currently implemented using the Class::Struct
+module to build a struct-like class, you shouldn't rely upon this.
+
+=head1 AUTHOR
+
+Tom Christiansen
diff --git a/lib/Time/tm.pm b/lib/Time/tm.pm
new file mode 100644
index 0000000000..fd47ad19a9
--- /dev/null
+++ b/lib/Time/tm.pm
@@ -0,0 +1,31 @@
+package Time::tm;
+use strict;
+
+use Class::Struct qw(struct);
+struct('Time::tm' => [
+     map { $_ => '$' } qw{ sec min hour mday mon year wday yday isdst }
+]);
+
+1;
+__END__
+
+=head1 NAME
+
+Time::tm - internal object used by Time::gmtime and Time::localtime
+
+=head1 SYNOPSIS
+
+Don't use this module directly.
+
+=head1 DESCRIPTION
+
+This module is used internally as a base class by Time::localtime And
+Time::gmtime functions.  It creates a Time::tm struct object which is
+addressable just like's C's tm structure from F<time.h>; namely with sec,
+min, hour, mday, mon, year, wday, yday, and isdst.
+
+This class is an internal interface only. 
+
+=head1 AUTHOR
+
+Tom Christiansen
diff --git a/lib/UNIVERSAL.pm b/lib/UNIVERSAL.pm
new file mode 100644
index 0000000000..6d832c4bea
--- /dev/null
+++ b/lib/UNIVERSAL.pm
@@ -0,0 +1,88 @@
+package UNIVERSAL;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(isa can);
+
+1;
+__END__
+
+=head1 NAME
+
+UNIVERSAL - base class for ALL classes (blessed references)
+
+=head1 SYNOPSIS
+
+    use UNIVERSAL qw(isa);
+
+    $yes = isa($ref, "HASH");
+    $io = $fd->isa("IO::Handle");
+    $sub = $obj->can('print');
+
+=head1 DESCRIPTION
+
+C<UNIVERSAL> is the base class which all bless references will inherit from,
+see L<perlobj>
+
+C<UNIVERSAL> provides the following methods
+
+=over 4
+
+=item isa ( TYPE )
+
+C<isa> returns I<true> if C<REF> is blessed into package C<TYPE>
+or inherits from package C<TYPE>.
+
+C<isa> can be called as either a static or object method call.
+
+=item can ( METHOD )
+
+C<can> checks if the object has a method called C<METHOD>. If it does
+then a reference to the sub is returned. If it does not then I<undef>
+is returned.
+
+C<can> can be called as either a static or object method call.
+
+=item VERSION ( [ REQUIRE ] )
+
+C<VERSION> will return the value of the variable C<$VERSION> in the
+package the object is blessed into. If C<REQUIRE> is given then
+it will do a comparison and die if the package version is not
+greater than or equal to C<REQUIRE>.
+
+C<VERSION> can be called as either a static or object method call.
+
+=back
+
+C<UNIVERSAL> also optionally exports the following subroutines
+
+=over 4
+
+=item isa ( VAL, TYPE )
+
+C<isa> returns I<true> if the first argument is a reference and either
+of the following statements is true.
+
+=over 8
+
+=item
+
+C<VAL> is a blessed reference and is blessed into package C<TYPE>
+or inherits from package C<TYPE>
+
+=item
+
+C<VAL> is a reference to a C<TYPE> of perl variable (er 'HASH')
+
+=back
+
+=item can ( VAL, METHOD )
+
+If C<VAL> is a blessed reference which has a method called C<METHOD>,
+C<can> returns a reference to the subroutine.   If C<VAL> is not
+a blessed reference, or if it does not have a method C<METHOD>,
+I<undef> is returned.
+
+=back
+
+=cut
diff --git a/lib/User/grent.pm b/lib/User/grent.pm
new file mode 100644
index 0000000000..deb0a8d1be
--- /dev/null
+++ b/lib/User/grent.pm
@@ -0,0 +1,93 @@
+package User::grent;
+use strict;
+
+BEGIN { 
+    use Exporter   ();
+    use vars       qw(@EXPORT @EXPORT_OK %EXPORT_TAGS);
+    @EXPORT      = qw(getgrent getgrgid getgrnam getgr);
+    @EXPORT_OK   = qw($gr_name $gr_gid $gr_passwd $gr_mem @gr_members);
+    %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
+}
+use vars      @EXPORT_OK;
+
+# Class::Struct forbids use of @ISA
+sub import { goto &Exporter::import }
+
+use Class::Struct qw(struct);
+struct 'User::grent' => [
+    name    => '$',
+    passwd  => '$',
+    gid	    => '$',
+    members => '@',
+];
+
+sub populate (@) {
+    return unless @_;
+    my $gob = new();
+    ($gr_name, $gr_passwd, $gr_gid) = @$gob[0,1,2] = @_[0,1,2];
+    @gr_members = @{$gob->[3]} = split ' ', $_[3];
+    return $gob;
+} 
+
+sub getgrent ( ) { populate(CORE::getgrent()) } 
+sub getgrnam ($) { populate(CORE::getgrnam(shift)) } 
+sub getgrgid ($) { populate(CORE::getgrgid(shift)) } 
+sub getgr    ($) { ($_[0] =~ /^\d+/) ? &getgrgid : &getgrnam } 
+
+1;
+__END__
+
+=head1 NAME
+
+User::grent - by-name interface to Perl's built-in getgr*() functions
+
+=head1 SYNOPSIS
+
+ use User::grent;
+ $gr = getgrgid(0) or die "No group zero";
+ if ( $gr->name eq 'wheel' && @{$gr->members} > 1 ) {
+     print "gid zero name wheel, with other members";
+ } 
+
+ use User::grent qw(:FIELDS;
+ getgrgid(0) or die "No group zero";
+ if ( $gr_name eq 'wheel' && @gr_members > 1 ) {
+     print "gid zero name wheel, with other members";
+ } 
+
+ $gr = getgr($whoever);
+
+=head1 DESCRIPTION
+
+This module's default exports override the core getgrent(), getgruid(),
+and getgrnam() functions, replacing them with versions that return
+"User::grent" objects.  This object has methods that return the similarly
+named structure field name from the C's passwd structure from F<grp.h>; 
+namely name, passwd, gid, and members (not mem).  The first three
+return scalars, the last an array reference.
+
+You may also import all the structure fields directly into your namespace
+as regular variables using the :FIELDS import tag.  (Note that this still
+overrides your core functions.)  Access these fields as variables named
+with a preceding C<gr_>.  Thus, C<$group_obj-E<gt>gid()> corresponds
+to $gr_gid if you import the fields.  Array references are available as
+regular array variables, so C<@{ $group_obj-E<gt>members() }> would be
+simply @gr_members.
+
+The getpw() funtion is a simple front-end that forwards
+a numeric argument to getpwuid() and the rest to getpwnam().
+
+To access this functionality without the core overrides,
+pass the C<use> an empty import list, and then access
+function functions with their full qualified names.
+On the other hand, the built-ins are still available
+via the C<CORE::> pseudo-package.
+
+=head1 NOTE
+
+While this class is currently implemented using the Class::Struct
+module to build a struct-like class, you shouldn't rely upon this.
+
+=head1 AUTHOR
+
+Tom Christiansen
diff --git a/lib/User/pwent.pm b/lib/User/pwent.pm
new file mode 100644
index 0000000000..32301cadfc
--- /dev/null
+++ b/lib/User/pwent.pm
@@ -0,0 +1,103 @@
+package User::pwent;
+use strict;
+
+BEGIN { 
+    use Exporter   ();
+    use vars       qw(@EXPORT @EXPORT_OK %EXPORT_TAGS);
+    @EXPORT      = qw(getpwent getpwuid getpwnam getpw);
+    @EXPORT_OK   = qw(
+			$pw_name   $pw_passwd 	$pw_uid	 
+			$pw_gid	   $pw_quota    $pw_comment
+			$pw_gecos  $pw_dir	$pw_shell
+		   );
+    %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
+}
+use vars      @EXPORT_OK;
+
+# Class::Struct forbids use of @ISA
+sub import { goto &Exporter::import }
+
+use Class::Struct qw(struct);
+struct 'User::pwent' => [
+    name    => '$',
+    passwd  => '$',
+    uid	    => '$',
+    gid	    => '$',
+    quota   => '$',
+    comment => '$',
+    gecos   => '$',
+    dir	    => '$',
+    shell   => '$',
+];
+
+sub populate (@) {
+    return unless @_;
+    my $pwob = new();
+
+    ( $pw_name,   $pw_passwd,   $pw_uid,  
+      $pw_gid,    $pw_quota,    $pw_comment,
+      $pw_gecos,  $pw_dir,      $pw_shell,   ) 	= @$pwob = @_;
+
+    return $pwob;
+} 
+
+sub getpwent ( ) { populate(CORE::getpwent()) } 
+sub getpwnam ($) { populate(CORE::getpwnam(shift)) } 
+sub getpwuid ($) { populate(CORE::getpwuid(shift)) } 
+sub getpw    ($) { ($_[0] =~ /^\d+/) ? &getpwuid : &getpwnam } 
+
+1;
+__END__
+
+=head1 NAME
+
+User::pwent - by-name interface to Perl's built-in getpw*() functions
+
+=head1 SYNOPSIS
+
+ use User::pwent;
+ $pw = getpwnam('daemon') or die "No daemon user";
+ if ( $pw->uid == 1 && $pw->dir =~ m#^/(bin|tmp)?$# ) {
+     print "gid 1 on root dir";
+ } 
+
+ use User::pwent qw(:FIELDS);
+ getpwnam('daemon') or die "No daemon user";
+ if ( $pw_uid == 1 && $pw_dir =~ m#^/(bin|tmp)?$# ) {
+     print "gid 1 on root dir";
+ } 
+
+ $pw = getpw($whoever);
+
+=head1 DESCRIPTION
+
+This module's default exports override the core getpwent(), getpwuid(),
+and getpwnam() functions, replacing them with versions that return
+"User::pwent" objects.  This object has methods that return the similarly
+named structure field name from the C's passwd structure from F<pwd.h>; 
+namely name, passwd, uid, gid, quota, comment, gecos, dir, and shell.
+
+You may also import all the structure fields directly into your namespace
+as regular variables using the :FIELDS import tag.  (Note that this still
+overrides your core functions.)  Access these fields as
+variables named with a preceding C<pw_> in front their method names.
+Thus, C<$passwd_obj-E<gt>shell()> corresponds to $pw_shell if you import
+the fields.
+
+The getpw() funtion is a simple front-end that forwards
+a numeric argument to getpwuid() and the rest to getpwnam().
+
+To access this functionality without the core overrides,
+pass the C<use> an empty import list, and then access
+function functions with their full qualified names.
+On the other hand, the built-ins are still available
+via the C<CORE::> pseudo-package.
+
+=head1 NOTE
+
+While this class is currently implemented using the Class::Struct
+module to build a struct-like class, you shouldn't rely upon this.
+
+=head1 AUTHOR
+
+Tom Christiansen
diff --git a/lib/abbrev.pl b/lib/abbrev.pl
index c233d4af7e..62975e66f3 100644
--- a/lib/abbrev.pl
+++ b/lib/abbrev.pl
@@ -17,7 +17,7 @@ sub main'abbrev {
 	$len = 1;
 	foreach $cmp (@cmp) {
 	    next if $cmp eq $name;
-	    while (substr($cmp,0,$len) eq $abbrev) {
+	    while (@extra && substr($cmp,0,$len) eq $abbrev) {
 		$abbrev .= shift(@extra);
 		++$len;
 	    }
diff --git a/lib/autouse.pm b/lib/autouse.pm
new file mode 100644
index 0000000000..a15d08abc5
--- /dev/null
+++ b/lib/autouse.pm
@@ -0,0 +1,166 @@
+package autouse;
+
+#use strict;		# debugging only
+use 5.003_90;		# ->can, for my $var
+
+$autouse::VERSION = '1.01';
+
+$autouse::DEBUG ||= 0;
+
+sub vet_import ($);
+
+sub croak {
+    require Carp;
+    Carp::croak(@_);
+}
+
+sub import {
+    my $class = @_ ? shift : 'autouse';
+    croak "usage: use $class MODULE [,SUBS...]" unless @_;
+    my $module = shift;
+
+    (my $pm = $module) =~ s{::}{/}g;
+    $pm .= '.pm';
+    if (exists $INC{$pm}) {
+	vet_import $module;
+	local $Exporter::ExportLevel = $Exporter::ExportLevel + 1;
+	# $Exporter::Verbose = 1;
+	return $module->import(map { (my $f = $_) =~ s/\(.*?\)$// } @_);
+    }
+
+    # It is not loaded: need to do real work.
+    my $callpkg = caller(0);
+    print "autouse called from $callpkg\n" if $autouse::DEBUG;
+
+    my $index;
+    for my $f (@_) {
+	my $proto;
+	$proto = $1 if (my $func = $f) =~ s/\((.*)\)$//;
+
+	my $closure_import_func = $func;	# Full name
+	my $closure_func = $func;		# Name inside package
+	my $index = index($func, '::');
+	if ($index == -1) {
+	    $closure_import_func = "${callpkg}::$func";
+	} else {
+	    $closure_func = substr $func, $index + 2;
+	    croak "autouse into different package attempted"
+		unless substr($func, 0, $index) eq $module;
+	}
+
+	my $load_sub = sub {
+	    unless ($INC{pm}) {
+		require $pm;
+		die $@ if $@;
+		vet_import $module;
+	    }
+	    *$closure_import_func = \&{"${module}::$closure_func"};
+	    print "autousing $module; "
+		  ."imported $closure_func as $closure_import_func\n"
+		if $autouse::DEBUG;
+	    goto &$closure_import_func;
+	};
+
+	if (defined $proto) {
+	    *$closure_import_func = eval "sub ($proto) { &\$load_sub }";
+	} else {
+	    *$closure_import_func = $load_sub;
+	}
+    }
+}
+
+sub vet_import ($) {
+    my $module = shift;
+    if (my $import = $module->can('import')) {
+	croak "autoused module has unique import() method"
+	    unless defined(\&Exporter::import)
+		   && $import == \&Exporter::import;
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+autouse - postpone load of modules until a function is used
+
+=head1 SYNOPSIS
+
+  use autouse 'Carp' => qw(carp croak);
+  carp "this carp was predeclared and autoused ";
+
+=head1 DESCRIPTION
+
+If the module C<Module> is already loaded, then the declaration
+
+  use autouse 'Module' => qw(func1 func2($;$) Module::func3);
+
+is equivalent to
+
+  use Module qw(func1 func2);
+
+if C<Module> defines func2() with prototype C<($;$)>, and func1() and
+func3() have no prototypes.  (At least if C<Module> uses C<Exporter>'s
+C<import>, otherwise it is a fatal error.)
+
+If the module C<Module> is not loaded yet, then the above declaration
+declares functions func1() and func2() in the current package, and
+declares a function Module::func3().  When these functions are called,
+they load the package C<Module> if needed, and substitute themselves
+with the correct definitions.
+
+=head1 WARNING
+
+Using C<autouse> will move important steps of your program's execution
+from compile time to runtime.  This can
+
+=over
+
+=item *
+
+Break the execution of your program if the module you C<autouse>d has
+some initialization which it expects to be done early.
+
+=item *
+
+hide bugs in your code since important checks (like correctness of
+prototypes) is moved from compile time to runtime.  In particular, if
+the prototype you specified on C<autouse> line is wrong, you will not
+find it out until the corresponding function is executed.  This will be
+very unfortunate for functions which are not always called (note that
+for such functions C<autouse>ing gives biggest win, for a workaround
+see below).
+
+=back
+
+To alleviate the second problem (partially) it is advised to write
+your scripts like this:
+
+  use Module;
+  use autouse Module => qw(carp($) croak(&$));
+  carp "this carp was predeclared and autoused ";
+
+The first line ensures that the errors in your argument specification
+are found early.  When you ship your application you should comment
+out the first line, since it makes the second one useless.
+
+=head1 BUGS
+
+If Module::func3() is autoused, and the module is loaded between the
+C<autouse> directive and a call to Module::func3(), warnings about
+redefinition would appear if warnings are enabled.
+
+If Module::func3() is autoused, warnings are disabled when loading the
+module via autoused functions.
+
+=head1 AUTHOR
+
+Ilya Zakharevich (ilya@math.ohio-state.edu)
+
+=head1 SEE ALSO
+
+perl(1).
+
+=cut
diff --git a/lib/bigfloat.pl b/lib/bigfloat.pl
index 9ad171f295..d687c784f1 100644
--- a/lib/bigfloat.pl
+++ b/lib/bigfloat.pl
@@ -41,8 +41,10 @@ $rnd_mode = 'even';
 sub main'fnorm { #(string) return fnum_str
     local($_) = @_;
     s/\s+//g;                               # strip white space
-    if (/^([+-]?)(\d*)(\.(\d*))?([Ee]([+-]?\d+))?$/ && "$2$4" ne '') {
-	&norm(($1 ? "$1$2$4" : "+$2$4"),(($4 ne '') ? $6-length($4) : $6));
+    if (/^([+-]?)(\d*)(\.(\d*))?([Ee]([+-]?\d+))?$/
+	  && ($2 ne '' || defined($4))) {
+	my $x = defined($4) ? $4 : '';
+	&norm(($1 ? "$1$2$x" : "+$2$x"), (($x ne '') ? $6-length($x) : $6));
     } else {
 	'NaN';
     }
diff --git a/lib/bigint.pl b/lib/bigint.pl
index e6ba644e3b..bfd2efa88c 100644
--- a/lib/bigint.pl
+++ b/lib/bigint.pl
@@ -103,13 +103,23 @@ sub main'bcmp { #(num_str, num_str) return cond_code
 
 sub cmp { # post-normalized compare for internal use
     local($cx, $cy) = @_;
-    $cx cmp $cy
-    &&
-    (
-	ord($cy) <=> ord($cx)
-	||
-	($cx cmp ',') * (length($cy) <=> length($cx) || $cy cmp $cx)
-    );
+    return 0 if ($cx eq $cy);
+
+    local($sx, $sy) = (substr($cx, 0, 1), substr($cy, 0, 1));
+    local($ld);
+
+    if ($sx eq '+') {
+      return  1 if ($sy eq '-' || $cy eq '+0');
+      $ld = length($cx) - length($cy);
+      return $ld if ($ld);
+      return $cx cmp $cy;
+    } else { # $sx eq '-'
+      return -1 if ($sy eq '+');
+      $ld = length($cy) - length($cx);
+      return $ld if ($ld);
+      return $cy cmp $cx;
+    }
+
 }
 
 sub main'badd { #(num_str, num_str) return num_str
@@ -158,11 +168,11 @@ sub add { #(int_num_array, int_num_array) return int_num_array
     $car = 0;
     for $x (@x) {
 	last unless @y || $car;
-	$x -= 1e5 if $car = (($x += shift(@y) + $car) >= 1e5);
+	$x -= 1e5 if $car = (($x += shift(@y) + $car) >= 1e5) ? 1 : 0;
     }
     for $y (@y) {
 	last unless $car;
-	$y -= 1e5 if $car = (($y += $car) >= 1e5);
+	$y -= 1e5 if $car = (($y += $car) >= 1e5) ? 1 : 0;
     }
     (@x, @y, $car);
 }
diff --git a/lib/blib.pm b/lib/blib.pm
new file mode 100644
index 0000000000..8af1727d8f
--- /dev/null
+++ b/lib/blib.pm
@@ -0,0 +1,70 @@
+package blib;
+
+=head1 NAME
+
+blib - Use MakeMaker's uninstalled version of a package
+
+=head1 SYNOPSIS
+
+ perl -Mblib script [args...]
+
+ perl -Mblib=dir script [args...]
+
+=head1 DESCRIPTION
+
+Looks for MakeMaker-like I<'blib'> directory structure starting in 
+I<dir> (or current directory) and working back up to five levels of '..'.
+
+Intended for use on command line with B<-M> option as a way of testing
+arbitary scripts against an uninstalled version of a package.
+
+However it is possible to : 
+
+ use blib; 
+ or 
+ use blib '..';
+
+etc. if you really must.
+
+=head1 BUGS
+
+Pollutes global name space for development only task.
+
+=head1 AUTHOR
+
+Nick Ing-Simmons nik@tiuk.ti.com
+
+=cut 
+
+use Cwd;
+
+
+sub import
+{
+ my $package = shift;
+ my $dir = getcwd;
+ if (@_)
+  {
+   print join(',',@_),"\n";
+   $dir = shift;
+   $dir =~ s/blib$//;
+   $dir =~ s,/+$,,;
+   $dir = '.' unless ($dir);
+   die "$dir is not a directory\n" unless (-d $dir);
+  }
+ my $i   = 5;
+ while ($i--)
+  {
+   my $blib = "${dir}/blib";
+   if (-d $blib && -d "$blib/arch" && -d "$blib/lib")
+    {
+     unshift(@INC,"$blib/arch","$blib/lib");
+     warn "Using $blib\n";
+     return;
+    }
+   $dir .= "/..";
+  }
+ die "Cannot find blib even in $dir\n";
+}
+
+1;
diff --git a/lib/cacheout.pl b/lib/cacheout.pl
index 48d594bf82..64378cffc6 100644
--- a/lib/cacheout.pl
+++ b/lib/cacheout.pl
@@ -35,7 +35,7 @@ $seq = 0;
 $numopen = 0;
 
 if (open(PARAM,'/usr/include/sys/param.h')) {
-    local($.);
+    local($_, $.);
     while (<PARAM>) {
 	$maxopen = $1 - 4 if /^\s*#\s*define\s+NOFILE\s+(\d+)/;
     }
diff --git a/lib/chat2.inter b/lib/chat2.inter
deleted file mode 100644
index 6934f1cc28..0000000000
--- a/lib/chat2.inter
+++ /dev/null
@@ -1,495 +0,0 @@
-Article 20992 of comp.lang.perl:
-Path: netlabs!news.cerf.net!mvb.saic.com!MathWorks.Com!europa.eng.gtefsd.com!howland.reston.ans.net!cs.utexas.edu!swrinde!ihnp4.ucsd.edu!ames!koriel!male.EBay.Sun.COM!jethro.Corp.Sun.COM!eric
-From: eric.arnold@sun.com (Eric Arnold)
-Newsgroups: comp.lang.perl
-Subject: Re: Need a bidirectional filter for interactive Unix applications
-Date: 15 Apr 94 21:24:03 GMT
-Organization: Sun Microsystems
-Lines: 478
-Sender: news@sun.com
-Message-ID: <ERIC.94Apr15212403@sun.com>
-References: <dgfCo9F2J.Jzw@netcom.com> <1994Apr15.110134.4581@chemabs.uucp>
-NNTP-Posting-Host: animus.corp.sun.com
-X-Newsreader: prn Ver 1.09
-In-reply-to: btf64@cas.org's message of Fri, 15 Apr 1994 11:01:34 GMT
-
-In article <1994Apr15.110134.4581@chemabs.uucp>
-	btf64@cas.org (Bernard T. French) writes:
-
->In article <dgfCo9F2J.Jzw@netcom.com> dgf@netcom.com (David Feldman) writes:
->>I need to write a bidirectional filter that would (ideally) sit between a
-..
->>program's stdin & stdout to point to a pty pair known to perl. The perl app-
->>lication would talk to the user's crt/keyboard, translate (application-specific)
->>the input & output streams, and pass these as appropriate to/from the pty pair,
-..
->
->     I'm afraid I can't offer you a perl solution, but err..... there is a
->Tcl solution.  There is a Tcl extension called "expect" that is designed to
-
-There *is* an old, established Perl solution:  "chat2.pl" which does
-everything (well, basically) "expect" does but you get it in the
-expressive Perl environment.  "chat2.pl" is delivered with the Perl
-source.
-
-Randal:  "interact()" still hasn't made it into Perl5alpha8
-"chat2.pl", so I've included a version which does.
-
--Eric
-
-
-## chat.pl: chat with a server
-## V2.01.alpha.7 91/06/16
-## Randal L. Schwartz
-
-package chat;
-
-$sockaddr = 'S n a4 x8';
-chop($thishost = `hostname`); $thisaddr = (gethostbyname($thishost))[4];
-$thisproc = pack($sockaddr, 2, 0, $thisaddr);
-
-# *S = symbol for current I/O, gets assigned *chatsymbol....
-$next = "chatsymbol000000"; # next one
-$nextpat = "^chatsymbol"; # patterns that match next++, ++, ++, ++
-
-
-## $handle = &chat'open_port("server.address",$port_number);
-## opens a named or numbered TCP server
-
-sub open_port { ## public
-	local($server, $port) = @_;
-
-	local($serveraddr,$serverproc);
-
-	*S = ++$next;
-	if ($server =~ /^(\d+)+\.(\d+)\.(\d+)\.(\d+)$/) {
-		$serveraddr = pack('C4', $1, $2, $3, $4);
-	} else {
-		local(@x) = gethostbyname($server);
-		return undef unless @x;
-		$serveraddr = $x[4];
-	}
-	$serverproc = pack($sockaddr, 2, $port, $serveraddr);
-	unless (socket(S, 2, 1, 6)) {
-		# XXX hardwired $AF_SOCKET, $SOCK_STREAM, 'tcp'
-		# but who the heck would change these anyway? (:-)
-		($!) = ($!, close(S)); # close S while saving $!
-		return undef;
-	}
-	unless (bind(S, $thisproc)) {
-		($!) = ($!, close(S)); # close S while saving $!
-		return undef;
-	}
-	unless (connect(S, $serverproc)) {
-		($!) = ($!, close(S)); # close S while saving $!
-		return undef;
-	}
-	select((select(S), $| = 1)[0]);
-	$next; # return symbol for switcharound
-}
-
-## ($host, $port, $handle) = &chat'open_listen([$port_number]);
-## opens a TCP port on the current machine, ready to be listened to
-## if $port_number is absent or zero, pick a default port number
-## process must be uid 0 to listen to a low port number
-
-sub open_listen { ## public
-
-	*S = ++$next;
-	local($thisport) = shift || 0;
-	local($thisproc_local) = pack($sockaddr, 2, $thisport, $thisaddr);
-	local(*NS) = "__" . time;
-	unless (socket(NS, 2, 1, 6)) {
-		# XXX hardwired $AF_SOCKET, $SOCK_STREAM, 'tcp'
-		# but who the heck would change these anyway? (:-)
-		($!) = ($!, close(NS));
-		return undef;
-	}
-	unless (bind(NS, $thisproc_local)) {
-		($!) = ($!, close(NS));
-		return undef;
-	}
-	unless (listen(NS, 1)) {
-		($!) = ($!, close(NS));
-		return undef;
-	}
-	select((select(NS), $| = 1)[0]);
-	local($family, $port, @myaddr) =
-		unpack("S n C C C C x8", getsockname(NS));
-	$S{"needs_accept"} = *NS; # so expect will open it
-	(@myaddr, $port, $next); # returning this
-}
-
-## $handle = &chat'open_proc("command","arg1","arg2",...);
-## opens a /bin/sh on a pseudo-tty
-
-sub open_proc { ## public
-	local(@cmd) = @_;
-
-	*S = ++$next;
-	local(*TTY) = "__TTY" . time;
-	local($pty,$tty,$pty_handle) = &_getpty(S,TTY);
-
-	#local($pty,$tty,$pty_handle) = &getpty(S,TTY);
-	#$Tty = $tty;
-
-	die "Cannot find a new pty" unless defined $pty;
-	local($pid) = fork;
-	die "Cannot fork: $!" unless defined $pid;
-	unless ($pid) {
-		close STDIN; close STDOUT; close STDERR;
-		#close($pty_handle);
-		setpgrp(0,$$);
-		if (open(DEVTTY, "/dev/tty")) {
-		    ioctl(DEVTTY,0x20007471,0);		# XXX s/b &TIOCNOTTY
-		    close DEVTTY;
-		}
-		open(STDIN,"<&TTY");
-		open(STDOUT,">&TTY");
-		open(STDERR,">&STDOUT");
-		die "Oops" unless fileno(STDERR) == 2;	# sanity
-		close(S);
-
-		exec @cmd;
-		die "Cannot exec @cmd: $!";
-	}
-	close(TTY);
-	$PID{$next} = $pid;
-	$next; # return symbol for switcharound
-
-}
-
-# $S is the read-ahead buffer
-
-## $return = &chat'expect([$handle,] $timeout_time,
-## 	$pat1, $body1, $pat2, $body2, ... )
-## $handle is from previous &chat'open_*().
-## $timeout_time is the time (either relative to the current time, or
-## absolute, ala time(2)) at which a timeout event occurs.
-## $pat1, $pat2, and so on are regexs which are matched against the input
-## stream.  If a match is found, the entire matched string is consumed,
-## and the corresponding body eval string is evaled.
-##
-## Each pat is a regular-expression (probably enclosed in single-quotes
-## in the invocation).  ^ and $ will work, respecting the current value of $*.
-## If pat is 'TIMEOUT', the body is executed if the timeout is exceeded.
-## If pat is 'EOF', the body is executed if the process exits before
-## the other patterns are seen.
-##
-## Pats are scanned in the order given, so later pats can contain
-## general defaults that won't be examined unless the earlier pats
-## have failed.
-##
-## The result of eval'ing body is returned as the result of
-## the invocation.  Recursive invocations are not thought
-## through, and may work only accidentally. :-)
-##
-## undef is returned if either a timeout or an eof occurs and no
-## corresponding body has been defined.
-## I/O errors of any sort are treated as eof.
-
-$nextsubname = "expectloop000000"; # used for subroutines
-
-sub expect { ## public
-	if ($_[0] =~ /$nextpat/) {
-		*S = shift;
-	}
-	local($endtime) = shift;
-
-	local($timeout,$eof) = (1,1);
-	local($caller) = caller;
-	local($rmask, $nfound, $timeleft, $thisbuf);
-	local($cases, $pattern, $action, $subname);
-	$endtime += time if $endtime < 600_000_000;
-
-	if (defined $S{"needs_accept"}) { # is it a listen socket?
-		local(*NS) = $S{"needs_accept"};
-		delete $S{"needs_accept"};
-		$S{"needs_close"} = *NS;
-		unless(accept(S,NS)) {
-			($!) = ($!, close(S), close(NS));
-			return undef;
-		}
-		select((select(S), $| = 1)[0]);
-	}
-
-	# now see whether we need to create a new sub:
-
-	unless ($subname = $expect_subname{$caller,@_}) {
-		# nope.  make a new one:
-		$expect_subname{$caller,@_} = $subname = $nextsubname++;
-
-		$cases .= <<"EDQ"; # header is funny to make everything elsif's
-sub $subname {
-	LOOP: {
-		if (0) { ; }
-EDQ
-		while (@_) {
-			($pattern,$action) = splice(@_,0,2);
-			if ($pattern =~ /^eof$/i) {
-				$cases .= <<"EDQ";
-		elsif (\$eof) {
-	 		package $caller;
-			$action;
-		}
-EDQ
-				$eof = 0;
-			} elsif ($pattern =~ /^timeout$/i) {
-			$cases .= <<"EDQ";
-		elsif (\$timeout) {
-		 	package $caller;
-			$action;
-		}
-EDQ
-				$timeout = 0;
-			} else {
-				$pattern =~ s#/#\\/#g;
-			$cases .= <<"EDQ";
-		elsif (\$S =~ /$pattern/) {
-			\$S = \$';
-		 	package $caller;
-			$action;
-		}
-EDQ
-			}
-		}
-		$cases .= <<"EDQ" if $eof;
-		elsif (\$eof) {
-			undef;
-		}
-EDQ
-		$cases .= <<"EDQ" if $timeout;
-		elsif (\$timeout) {
-			undef;
-		}
-EDQ
-		$cases .= <<'ESQ';
-		else {
-			$rmask = "";
-			vec($rmask,fileno(S),1) = 1;
-			($nfound, $rmask) =
-		 		select($rmask, undef, undef, $endtime - time);
-			if ($nfound) {
-				$nread = sysread(S, $thisbuf, 1024);
-				if ($nread > 0) {
-					$S .= $thisbuf;
-				} else {
-					$eof++, redo LOOP; # any error is also eof
-				}
-			} else {
-				$timeout++, redo LOOP; # timeout
-			}
-			redo LOOP;
-		}
-	}
-}
-ESQ
-		eval $cases; die "$cases:\n$@" if $@;
-	}
-	$eof = $timeout = 0;
-	do $subname();
-}
-
-## &chat'print([$handle,] @data)
-## $handle is from previous &chat'open().
-## like print $handle @data
-
-sub print { ## public
-	if ($_[0] =~ /$nextpat/) {
-		*S = shift;
-	}
-	print S @_;
-}
-
-## &chat'close([$handle,])
-## $handle is from previous &chat'open().
-## like close $handle
-
-sub close { ## public
-	local($pid);
-	if ($_[0] =~ /$nextpat/) {
-		$pid = $PID{$_[0]};
-	 	*S = shift;
-	} else {
-		$pid = $PID{$next};
-	}
-	close(S);
-	waitpid($pid,0);
-	if (defined $S{"needs_close"}) { # is it a listen socket?
-		local(*NS) = $S{"needs_close"};
-		delete $S{"needs_close"};
-		close(NS);
-	}
-}
-
-## @ready_handles = &chat'select($timeout, @handles)
-## select()'s the handles with a timeout value of $timeout seconds.
-## Returns an array of handles that are ready for I/O.
-## Both user handles and chat handles are supported (but beware of
-## stdio's buffering for user handles).
-
-sub select { ## public
-	local($timeout) = shift;
-	local(@handles) = @_;
-	local(%handlename) = ();
-	local(%ready) = ();
-	local($caller) = caller;
-	local($rmask) = "";
-	for (@handles) {
-		if (/$nextpat/o) { # one of ours... see if ready
-			local(*SYM) = $_;
-			if (length($SYM)) {
-				$timeout = 0; # we have a winner
-				$ready{$_}++;
-			}
-			$handlename{fileno($_)} = $_;
-		} else {
-			$handlename{fileno(/'/ ? $_ : "$caller\'$_")} = $_;
-		}
-	}
-	for (sort keys %handlename) {
-		vec($rmask, $_, 1) = 1;
-	}
-	select($rmask, undef, undef, $timeout);
-	for (sort keys %handlename) {
-		$ready{$handlename{$_}}++ if vec($rmask,$_,1);
-	}
-	sort keys %ready;
-}
-
-# ($pty,$tty) = $chat'_getpty(PTY,TTY):
-# internal procedure to get the next available pty.
-# opens pty on handle PTY, and matching tty on handle TTY.
-# returns undef if can't find a pty.
-
-sub _getpty { ## private
-	local($_PTY,$_TTY) = @_;
-	$_PTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
-	$_TTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
-	local($pty,$tty);
-	for $bank (112..127) {
-		next unless -e sprintf("/dev/pty%c0", $bank);
-		for $unit (48..57) {
-			$pty = sprintf("/dev/pty%c%c", $bank, $unit);
-			open($_PTY,"+>$pty") || next;
-			select((select($_PTY), $| = 1)[0]);
-			($tty = $pty) =~ s/pty/tty/;
-			open($_TTY,"+>$tty") || next;
-			select((select($_TTY), $| = 1)[0]);
-			system "stty nl>$tty";
-			return ($pty,$tty,$_PTY);
-		}
-	}
-	undef;
-}
-
-
-sub getpty {
-  local( $pty_handle, $tty_handle ) = @_;
-
-print "--------in getpty----------\n";
-  $pty_handle =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
-  $pty_handle =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
-
-  #$pty_handle = ++$next_handle;
-  chop( @ptys = `ls /dev/pty*` );
-
-  for $pty ( @ptys )
-  {
-    open($pty_handle,"+>$pty") || next;
-    select((select($pty_handle), $| = 1)[0]);
-    ($tty = $pty) =~ s/pty/tty/;
-
-    open($tty_handle,"+>$tty") || next;
-    select((select($tty_handle), $| = 1)[0]);
-    ($tty = $pty) =~ s/pty/tty/;
-
-    return ($pty, $tty, $pty_handle );
-  }
-  return undef;
-}
-
-
-
-# from: Randal L. Schwartz
-
-# Usage:
-#
-# ($chathandle = &chat'open_proc("/bin/sh")) || die "cannot open shell";
-# system("stty cbreak raw -echo >/dev/tty\n");
-# &chat'interact($chathandle);
-# &chat'close($chathandle);
-# system("stty -cbreak -raw echo >/dev/tty\n");
-
-sub interact
-{
-  local( $chathandle ) = @_;
-
-  &chat'print($chathandle, "stty sane\n");
-  select(STDOUT) ; $| = 1; # unbuffer STDOUT
-
-  #print "tty=$Tty,whoami=",`whoami`,"\n";
-  #&change_utmp( "", $Tty, "eric", "", time() );
-
-  {
-    @ready = &chat'select(30, STDIN,$chathandle);
-    print "after select, ready=",join(",",@ready),"\n";
-    #(warn "[waiting]"), redo unless @ready;
-    if (grep($_ eq $chathandle, @ready)) {
-	    print "checking $chathandle\n";
-	    last unless $text = &chat'expect($chathandle,0,'[\s\S]+','$&');
-	    print "$chathandle OK\n";
-	    print "got=($text)";
-	    #print $text;
-    }
-    if (grep($_ eq STDIN, @ready)) {
-	    print "checking STDIN\n";
-	    last unless sysread(STDIN,$buf,1024) > 0;
-	    print "STDIN OK\n";
-	    &chat'print($chathandle,$buf);
-    }
-    redo;
-  }
-  #&change_utmp( $Tty, "$Tty", "", "", 0 );
-  print "leaving interact, \$!=$!\n";
-}
-
-## $handle = &chat'open_duphandle(handle);
-## duplicates an input file handle to conform to chat format
-
-sub open_duphandle { ## public
-    *S = ++$next;
-    open(S,"<&$_[0]");
-    $next; # return symbol for switcharound
-}
-
-#Here is an example which uses this routine.
-#
-#    # The following lines makes stdin unbuffered
-#    
-#    $BSD = -f '/vmunix';
-#    
-#    if ($BSD) {
-#        system "stty cbreak </dev/tty >/dev/tty 2>&1";
-#    }
-#    else {
-#        system "stty", '-icanon';
-#        system "stty", 'eol', '^A';
-#    }
-#
-#    require 'mychat2.pl';
-#    
-#    &chat'open_duphandle(STDIN);
-#    
-#    print 
-#    &chat'expect(3,
-#      '[A-Z]', '" :-)"',
-#      '.', '" :-("',
-#      TIMEOUT,  '"-o-"',
-#      EOF, '"\$\$"'),
-#    "\n";
-
-
-1;
-
-
diff --git a/lib/chat2.pl b/lib/chat2.pl
deleted file mode 100644
index 0d9a7d3d50..0000000000
--- a/lib/chat2.pl
+++ /dev/null
@@ -1,368 +0,0 @@
-# chat.pl: chat with a server
-# Based on: V2.01.alpha.7 91/06/16
-# Randal L. Schwartz (was <merlyn@stonehenge.com>)
-# multihome additions by A.Macpherson@bnr.co.uk
-# allow for /dev/pts based systems by Joe Doupnik <JRD@CC.USU.EDU>
-
-package chat;
-
-require 'sys/socket.ph';
-
-if( defined( &main'PF_INET ) ){
-	$pf_inet = &main'PF_INET;
-	$sock_stream = &main'SOCK_STREAM;
-	local($name, $aliases, $proto) = getprotobyname( 'tcp' );
-	$tcp_proto = $proto;
-}
-else {
-	# XXX hardwired $PF_INET, $SOCK_STREAM, 'tcp'
-	# but who the heck would change these anyway? (:-)
-	$pf_inet = 2;
-	$sock_stream = 1;
-	$tcp_proto = 6;
-}
-
-
-$sockaddr = 'S n a4 x8';
-chop($thishost = `hostname`);
-
-# *S = symbol for current I/O, gets assigned *chatsymbol....
-$next = "chatsymbol000000"; # next one
-$nextpat = "^chatsymbol"; # patterns that match next++, ++, ++, ++
-
-
-## $handle = &chat'open_port("server.address",$port_number);
-## opens a named or numbered TCP server
-
-sub open_port { ## public
-	local($server, $port) = @_;
-
-	local($serveraddr,$serverproc);
-
-	# We may be multi-homed, start with 0, fixup once connexion is made
-	$thisaddr = "\0\0\0\0" ;
-	$thisproc = pack($sockaddr, 2, 0, $thisaddr);
-
-	*S = ++$next;
-	if ($server =~ /^(\d+)+\.(\d+)\.(\d+)\.(\d+)$/) {
-		$serveraddr = pack('C4', $1, $2, $3, $4);
-	} else {
-		local(@x) = gethostbyname($server);
-		return undef unless @x;
-		$serveraddr = $x[4];
-	}
-	$serverproc = pack($sockaddr, 2, $port, $serveraddr);
-	unless (socket(S, $pf_inet, $sock_stream, $tcp_proto)) {
-		($!) = ($!, close(S)); # close S while saving $!
-		return undef;
-	}
-	unless (bind(S, $thisproc)) {
-		($!) = ($!, close(S)); # close S while saving $!
-		return undef;
-	}
-	unless (connect(S, $serverproc)) {
-		($!) = ($!, close(S)); # close S while saving $!
-		return undef;
-	}
-# We opened with the local address set to ANY, at this stage we know
-# which interface we are using.  This is critical if our machine is
-# multi-homed, with IP forwarding off, so fix-up.
-	local($fam,$lport);
-	($fam,$lport,$thisaddr) = unpack($sockaddr, getsockname(S));
-	$thisproc = pack($sockaddr, 2, 0, $thisaddr);
-# end of post-connect fixup
-	select((select(S), $| = 1)[0]);
-	$next; # return symbol for switcharound
-}
-
-## ($host, $port, $handle) = &chat'open_listen([$port_number]);
-## opens a TCP port on the current machine, ready to be listened to
-## if $port_number is absent or zero, pick a default port number
-## process must be uid 0 to listen to a low port number
-
-sub open_listen { ## public
-
-	*S = ++$next;
-	local($thisport) = shift || 0;
-	local($thisproc_local) = pack($sockaddr, 2, $thisport, $thisaddr);
-	local(*NS) = "__" . time;
-	unless (socket(NS, $pf_inet, $sock_stream, $tcp_proto)) {
-		($!) = ($!, close(NS));
-		return undef;
-	}
-	unless (bind(NS, $thisproc_local)) {
-		($!) = ($!, close(NS));
-		return undef;
-	}
-	unless (listen(NS, 1)) {
-		($!) = ($!, close(NS));
-		return undef;
-	}
-	select((select(NS), $| = 1)[0]);
-	local($family, $port, @myaddr) =
-		unpack("S n C C C C x8", getsockname(NS));
-	$S{"needs_accept"} = *NS; # so expect will open it
-	(@myaddr, $port, $next); # returning this
-}
-
-## $handle = &chat'open_proc("command","arg1","arg2",...);
-## opens a /bin/sh on a pseudo-tty
-
-sub open_proc { ## public
-	local(@cmd) = @_;
-
-	*S = ++$next;
-	local(*TTY) = "__TTY" . time;
-	local($pty,$tty) = &_getpty(S,TTY);
-	die "Cannot find a new pty" unless defined $pty;
-	$pid = fork;
-	die "Cannot fork: $!" unless defined $pid;
-	unless ($pid) {
-		close STDIN; close STDOUT; close STDERR;
-		setpgrp(0,$$);
-		if (open(DEVTTY, "/dev/tty")) {
-		    ioctl(DEVTTY,0x20007471,0);		# XXX s/b &TIOCNOTTY
-		    close DEVTTY;
-		}
-		open(STDIN,"<&TTY");
-		open(STDOUT,">&TTY");
-		open(STDERR,">&STDOUT");
-		die "Oops" unless fileno(STDERR) == 2;	# sanity
-		close(S);
-		exec @cmd;
-		die "Cannot exec @cmd: $!";
-	}
-	close(TTY);
-	$next; # return symbol for switcharound
-}
-
-# $S is the read-ahead buffer
-
-## $return = &chat'expect([$handle,] $timeout_time,
-## 	$pat1, $body1, $pat2, $body2, ... )
-## $handle is from previous &chat'open_*().
-## $timeout_time is the time (either relative to the current time, or
-## absolute, ala time(2)) at which a timeout event occurs.
-## $pat1, $pat2, and so on are regexs which are matched against the input
-## stream.  If a match is found, the entire matched string is consumed,
-## and the corresponding body eval string is evaled.
-##
-## Each pat is a regular-expression (probably enclosed in single-quotes
-## in the invocation).  ^ and $ will work, respecting the current value of $*.
-## If pat is 'TIMEOUT', the body is executed if the timeout is exceeded.
-## If pat is 'EOF', the body is executed if the process exits before
-## the other patterns are seen.
-##
-## Pats are scanned in the order given, so later pats can contain
-## general defaults that won't be examined unless the earlier pats
-## have failed.
-##
-## The result of eval'ing body is returned as the result of
-## the invocation.  Recursive invocations are not thought
-## through, and may work only accidentally. :-)
-##
-## undef is returned if either a timeout or an eof occurs and no
-## corresponding body has been defined.
-## I/O errors of any sort are treated as eof.
-
-$nextsubname = "expectloop000000"; # used for subroutines
-
-sub expect { ## public
-	if ($_[0] =~ /$nextpat/) {
-		*S = shift;
-	}
-	local($endtime) = shift;
-
-	local($timeout,$eof) = (1,1);
-	local($caller) = caller;
-	local($rmask, $nfound, $timeleft, $thisbuf);
-	local($cases, $pattern, $action, $subname);
-	$endtime += time if $endtime < 600_000_000;
-
-	if (defined $S{"needs_accept"}) { # is it a listen socket?
-		local(*NS) = $S{"needs_accept"};
-		delete $S{"needs_accept"};
-		$S{"needs_close"} = *NS;
-		unless(accept(S,NS)) {
-			($!) = ($!, close(S), close(NS));
-			return undef;
-		}
-		select((select(S), $| = 1)[0]);
-	}
-
-	# now see whether we need to create a new sub:
-
-	unless ($subname = $expect_subname{$caller,@_}) {
-		# nope.  make a new one:
-		$expect_subname{$caller,@_} = $subname = $nextsubname++;
-
-		$cases .= <<"EDQ"; # header is funny to make everything elsif's
-sub $subname {
-	LOOP: {
-		if (0) { ; }
-EDQ
-		while (@_) {
-			($pattern,$action) = splice(@_,0,2);
-			if ($pattern =~ /^eof$/i) {
-				$cases .= <<"EDQ";
-		elsif (\$eof) {
-	 		package $caller;
-			$action;
-		}
-EDQ
-				$eof = 0;
-			} elsif ($pattern =~ /^timeout$/i) {
-			$cases .= <<"EDQ";
-		elsif (\$timeout) {
-		 	package $caller;
-			$action;
-		}
-EDQ
-				$timeout = 0;
-			} else {
-				$pattern =~ s#/#\\/#g;
-			$cases .= <<"EDQ";
-		elsif (\$S =~ /$pattern/) {
-			\$S = \$';
-		 	package $caller;
-			$action;
-		}
-EDQ
-			}
-		}
-		$cases .= <<"EDQ" if $eof;
-		elsif (\$eof) {
-			undef;
-		}
-EDQ
-		$cases .= <<"EDQ" if $timeout;
-		elsif (\$timeout) {
-			undef;
-		}
-EDQ
-		$cases .= <<'ESQ';
-		else {
-			$rmask = "";
-			vec($rmask,fileno(S),1) = 1;
-			($nfound, $rmask) =
-		 		select($rmask, undef, undef, $endtime - time);
-			if ($nfound) {
-				$nread = sysread(S, $thisbuf, 1024);
-				if ($nread > 0) {
-					$S .= $thisbuf;
-				} else {
-					$eof++, redo LOOP; # any error is also eof
-				}
-			} else {
-				$timeout++, redo LOOP; # timeout
-			}
-			redo LOOP;
-		}
-	}
-}
-ESQ
-		eval $cases; die "$cases:\n$@" if $@;
-	}
-	$eof = $timeout = 0;
-	do $subname();
-}
-
-## &chat'print([$handle,] @data)
-## $handle is from previous &chat'open().
-## like print $handle @data
-
-sub print { ## public
-	if ($_[0] =~ /$nextpat/) {
-		*S = shift;
-	}
-	print S @_;
-	if( $chat'debug ){
-		print STDERR "printed:";
-		print STDERR @_;
-	}
-}
-
-## &chat'close([$handle,])
-## $handle is from previous &chat'open().
-## like close $handle
-
-sub close { ## public
-	if ($_[0] =~ /$nextpat/) {
-	 	*S = shift;
-	}
-	close(S);
-	if (defined $S{"needs_close"}) { # is it a listen socket?
-		local(*NS) = $S{"needs_close"};
-		delete $S{"needs_close"};
-		close(NS);
-	}
-}
-
-## @ready_handles = &chat'select($timeout, @handles)
-## select()'s the handles with a timeout value of $timeout seconds.
-## Returns an array of handles that are ready for I/O.
-## Both user handles and chat handles are supported (but beware of
-## stdio's buffering for user handles).
-
-sub select { ## public
-	local($timeout) = shift;
-	local(@handles) = @_;
-	local(%handlename) = ();
-	local(%ready) = ();
-	local($caller) = caller;
-	local($rmask) = "";
-	for (@handles) {
-		if (/$nextpat/o) { # one of ours... see if ready
-			local(*SYM) = $_;
-			if (length($SYM)) {
-				$timeout = 0; # we have a winner
-				$ready{$_}++;
-			}
-			$handlename{fileno($_)} = $_;
-		} else {
-			$handlename{fileno(/'/ ? $_ : "$caller\'$_")} = $_;
-		}
-	}
-	for (sort keys %handlename) {
-		vec($rmask, $_, 1) = 1;
-	}
-	select($rmask, undef, undef, $timeout);
-	for (sort keys %handlename) {
-		$ready{$handlename{$_}}++ if vec($rmask,$_,1);
-	}
-	sort keys %ready;
-}
-
-# ($pty,$tty) = $chat'_getpty(PTY,TTY):
-# internal procedure to get the next available pty.
-# opens pty on handle PTY, and matching tty on handle TTY.
-# returns undef if can't find a pty.
-# Modify "/dev/pty" to "/dev/pts" for Dell Unix v2.2 (aka SVR4.04). Joe Doupnik.
-
-sub _getpty { ## private
-	local($_PTY,$_TTY) = @_;
-	$_PTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
-	$_TTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
-	local($pty, $tty, $kind);
-	if( -e "/dev/pts000" ){		## mods by Joe Doupnik Dec 1992
-		$kind = "pts";		## SVR4 Streams
-	} else {
-		$kind = "pty";		## BSD Clist stuff
-	}
-	for $bank (112..127) {
-		next unless -e sprintf("/dev/$kind%c0", $bank);
-		for $unit (48..57) {
-			$pty = sprintf("/dev/$kind%c%c", $bank, $unit);
-			open($_PTY,"+>$pty") || next;
-			select((select($_PTY), $| = 1)[0]);
-			($tty = $pty) =~ s/pty/tty/;
-			open($_TTY,"+>$tty") || next;
-			select((select($_TTY), $| = 1)[0]);
-			system "stty nl>$tty";
-			return ($pty,$tty);
-		}
-	}
-	undef;
-}
-
-1;
diff --git a/lib/complete.pl b/lib/complete.pl
index 1e08f9145a..539f2f7798 100644
--- a/lib/complete.pl
+++ b/lib/complete.pl
@@ -35,7 +35,7 @@ CONFIG: {
 sub Complete {
     package Complete;
 
-    local($[,$return) = 0;
+    local($prompt, @cmp_list, $return, @match, $l, $test, $cmp, $r);
     if ($_[1] =~ /^StB\0/) {
         ($prompt, *_) = @_;
     }
@@ -75,7 +75,8 @@ sub Complete {
                 # (^U) kill
                 $_ eq $kill && do {
                     if ($r) {
-                        undef($r, $return);
+                        undef $r;
+			undef $return;
                         print("\r\n");
                         redo LOOP;
                     }
diff --git a/lib/constant.pm b/lib/constant.pm
new file mode 100644
index 0000000000..a0d4f9d5cd
--- /dev/null
+++ b/lib/constant.pm
@@ -0,0 +1,163 @@
+package constant;
+
+$VERSION = '1.00';
+
+=head1 NAME
+
+constant - Perl pragma to declare constants
+
+=head1 SYNOPSIS
+
+    use constant BUFFER_SIZE	=> 4096;
+    use constant ONE_YEAR	=> 365.2425 * 24 * 60 * 60;
+    use constant PI		=> 4 * atan2 1, 1;
+    use constant DEBUGGING	=> 0;
+    use constant ORACLE		=> 'oracle@cs.indiana.edu';
+    use constant USERNAME	=> scalar getpwuid($<);
+    use constant USERINFO	=> getpwuid($<);
+
+    sub deg2rad { PI * $_[0] / 180 }
+
+    print "This line does nothing"		unless DEBUGGING;
+
+=head1 DESCRIPTION
+
+This will declare a symbol to be a constant with the given scalar
+or list value.
+
+When you declare a constant such as C<PI> using the method shown
+above, each machine your script runs upon can have as many digits
+of accuracy as it can use. Also, your program will be easier to
+read, more likely to be maintained (and maintained correctly), and
+far less likely to send a space probe to the wrong planet because
+nobody noticed the one equation in which you wrote C<3.14195>.
+
+=head1 NOTES
+
+The value or values are evaluated in a list context. You may override
+this with C<scalar> as shown above.
+
+These constants do not directly interpolate into double-quotish
+strings, although you may do so indirectly. (See L<perlref> for
+details about how this works.)
+
+    print "The value of PI is @{[ PI ]}.\n";
+
+List constants are returned as lists, not as arrays.
+
+    $homedir = USERINFO[7];		# WRONG
+    $homedir = (USERINFO)[7];		# Right
+
+The use of all caps for constant names is merely a convention,
+although it is recommended in order to make constants stand out
+and to help avoid collisions with other barewords, keywords, and
+subroutine names. Constant names must begin with a letter.
+
+Constant symbols are package scoped (rather than block scoped, as
+C<use strict> is). That is, you can refer to a constant from package
+Other as C<Other::CONST>.
+
+As with all C<use> directives, defining a constant happens at
+compile time. Thus, it's probably not correct to put a constant
+declaration inside of a conditional statement (like C<if ($foo)
+{ use constant ... }>).
+
+Omitting the value for a symbol gives it the value of C<undef> in
+a scalar context or the empty list, C<()>, in a list context. This
+isn't so nice as it may sound, though, because in this case you
+must either quote the symbol name, or use a big arrow, (C<=E<gt>>),
+with nothing to point to. It is probably best to declare these
+explicitly.
+
+    use constant UNICORNS	=> ();
+    use constant LOGFILE	=> undef;
+
+The result from evaluating a list constant in a scalar context is
+not documented, and is B<not> guaranteed to be any particular value
+in the future. In particular, you should not rely upon it being
+the number of elements in the list, especially since it is not
+B<necessarily> that value in the current implementation.
+
+Magical values, tied values, and references can be made into
+constants at compile time, allowing for way cool stuff like this.
+(These error numbers aren't totally portable, alas.)
+
+    use constant E2BIG => ($! = 7);
+    print   E2BIG, "\n";	# something like "Arg list too long"
+    print 0+E2BIG, "\n";	# "7"
+
+=head1 TECHNICAL NOTE
+
+In the current implementation, scalar constants are actually
+inlinable subroutines. As of version 5.004 of Perl, the appropriate
+scalar constant is inserted directly in place of some subroutine
+calls, thereby saving the overhead of a subroutine call. See
+L<perlsub/"Constant Functions"> for details about how and when this
+happens.
+
+=head1 BUGS
+
+In the current version of Perl, list constants are not inlined
+and some symbols may be redefined without generating a warning.
+
+It is not possible to have a subroutine or keyword with the same
+name as a constant. This is probably a Good Thing.
+
+Unlike constants in some languages, these cannot be overridden
+on the command line or via environment variables.
+
+=head1 AUTHOR
+
+Tom Phoenix, E<lt>F<rootbeer@teleport.com>E<gt>, with help from
+many other folks.
+
+=head1 COPYRIGHT
+
+Copyright (C) 1997, Tom Phoenix
+
+This module is free software; you can redistribute it or modify it
+under the same terms as Perl itself.
+
+=cut
+
+use strict;
+use Carp;
+use vars qw($VERSION);
+
+#=======================================================================
+
+# Some of this stuff didn't work in version 5.003, alas.
+require 5.003_96;
+
+#=======================================================================
+# import() - import symbols into user's namespace
+#
+# What we actually do is define a function in the caller's namespace
+# which returns the value. The function we create will normally
+# be inlined as a constant, thereby avoiding further sub calling 
+# overhead.
+#=======================================================================
+sub import {
+    my $class = shift;
+    my $name = shift or return;			# Ignore 'use constant;'
+    croak qq{Can't define "$name" as constant} .
+	    qq{ (name contains invalid characters or is empty)}
+	unless $name =~ /^[^\W_0-9]\w*$/;
+
+    my $pkg = caller;
+    {
+	no strict 'refs';
+	if (@_ == 1) {
+	    my $scalar = $_[0];
+	    *{"${pkg}::$name"} = sub () { $scalar };
+	} elsif (@_) {
+	    my @list = @_;
+	    *{"${pkg}::$name"} = sub () { @list };
+	} else {
+	    *{"${pkg}::$name"} = sub () { };
+	}
+    }
+
+}
+
+1;
diff --git a/lib/diagnostics.pm b/lib/diagnostics.pm
index 3560f2d708..10016f3bb7 100755
--- a/lib/diagnostics.pm
+++ b/lib/diagnostics.pm
@@ -1,18 +1,4 @@
-#!/usr/local/bin/perl
-eval 'exec perl -S $0  ${1+"$@"}'
-    if 0;
-
-use Config;
-if ($^O eq 'VMS') {
-   $diagnostics::PODFILE = VMS::Filespec::unixify($Config{'privlib'}) .
-                           '/pod/perldiag.pod';
-}
-else { $diagnostics::PODFILE= $Config{privlib} . "/pod/perldiag.pod"; }
-
 package diagnostics;
-require 5.001;
-use English;
-use Carp;
 
 =head1 NAME
 
@@ -41,9 +27,9 @@ Aa a program:
 =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
+perl compiler and the perl interpeter, augmenting them with the more
 explicative and endearing descriptions found in L<perldiag>.  Like the
-other pragmata, it affects to compilation phase of your program rather
+other pragmata, it affects the compilation phase of your program rather
 than merely the execution phase.
 
 To use in your program as a pragma, merely invoke
@@ -62,8 +48,8 @@ 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.
+any other diagnostics.  The $diagnostics::PRETTY variable can generate nicer
+escape sequences for pagers.
 
 =head2 The I<splain> Program
 
@@ -98,7 +84,7 @@ afterwards, do this:
     ./splain < test.out
 
 Note that this is not in general possible in shells of more dubious heritage, 
-as the theorectical 
+as the theoretical 
 
     (perl -w test.pl >/dev/tty) >& test.out
     ./splain < test.out
@@ -143,7 +129,7 @@ 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 
+to be honored, but only after the diagnostics::splainthis() function 
 (the module's $SIG{__WARN__} interceptor) has had its way with your
 warnings.
 
@@ -159,27 +145,42 @@ 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.
+You have to do 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.  
+needed, but this gets a "panic: top_level" when using the pragma form
+in Perl 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.
+Tom Christiansen <F<tchrist@mox.perl.com>>, 25 June 1995.
 
 =cut
 
+require 5.001;
+use Carp;
+
+use Config;
+($privlib, $archlib) = @Config{qw(privlibexp archlibexp)};
+if ($^O eq 'VMS') {
+    require VMS::Filespec;
+    $privlib = VMS::Filespec::unixify($privlib);
+    $archlib = VMS::Filespec::unixify($archlib);
+}
+@trypod = ("$archlib/pod/perldiag.pod",
+	   "$privlib/pod/perldiag-$].pod",
+	   "$privlib/pod/perldiag.pod");
+($PODFILE) = ((grep { -e } @trypod), $trypod[$#trypod])[0];
+
 $DEBUG ||= 0;
 my $WHOAMI = ref bless [];  # nobody's business, prolly not even mine
 
-$OUTPUT_AUTOFLUSH = 1;
+$| = 1;
 
 local $_;
 
@@ -191,7 +192,8 @@ CONFIG: {
     unless (caller) { 
 	$standalone++;
 	require Getopt::Std;
-	Getopt::Std::getopts('pdvf:') || die "Usage: $0 [-v] [-p] [-f splainpod]";
+	Getopt::Std::getopts('pdvf:')
+	    or die "Usage: $0 [-v] [-p] [-f splainpod]";
 	$PODFILE = $opt_f if $opt_f;
 	$DEBUG = 2 if $opt_d;
 	$VERBOSE = $opt_v;
@@ -315,7 +317,9 @@ EOFUNC
 	    }
 	    next;
 	}
-	$header = $1;
+
+	# strip formatting directives in =item line
+	($header = $1) =~ s/[A-Z]<(.*?)>/$1/g;
 
 	if ($header =~ /%[sd]/) {
 	    $rhs = $lhs = $header;
@@ -328,13 +332,15 @@ EOFUNC
 		#$lhs =~ s/\377([^\377]*)$/\Q$1\E\$/;
 		$lhs =~ s/\377([^\377]*)$/\Q$1\E/;
 		$lhs =~ s/\377//g;
+		$lhs =~ s/\.\*\?$/.*/; # Allow %s at the end to eat it all
 	    } 
-	    $transmo .= "    s{^$lhs}\n     {\Q$rhs\E}\n\t&& return 1;\n";
+	    $transmo .= "    s{^$lhs}\n     {\Q$rhs\E}s\n\t&& return 1;\n";
 	} else {
 	    $transmo .= "    m{^\Q$header\E} && return 1;\n";
 	} 
 
-	print STDERR "Already saw $header" if $msg{$header};
+	print STDERR "$WHOAMI: Duplicate entry: \"$header\"\n"
+	    if $msg{$header};
 
 	$msg{$header} = '';
     } 
@@ -353,7 +359,7 @@ EOFUNC
 
 if ($standalone) {
     if (!@ARGV and -t STDIN) { print STDERR "$0: Reading from STDIN\n" } 
-    while ($error = <>) {
+    while (defined ($error = <>)) {
 	splainthis($error) || print THITHER $error;
     } 
     exit;
@@ -415,10 +421,27 @@ sub warn_trap {
 
 sub death_trap {
     my $exception = $_[0];
-    splainthis($exception);
+
+    # See if we are coming from anywhere within an eval. If so we don't
+    # want to explain the exception because it's going to get caught.
+    my $in_eval = 0;
+    my $i = 0;
+    while (1) {
+      my $caller = (caller($i++))[3] or last;
+      if ($caller eq '(eval)') {
+	$in_eval = 1;
+	last;
+      }
+    }
+
+    splainthis($exception) unless $in_eval;
     if (caller eq $WHOAMI) { print STDERR "INTERNAL EXCEPTION: $exception"; } 
     &$olddie if defined $olddie and $olddie and $olddie ne \&death_trap;
-    $SIG{__DIE__} = $SIG{__WARN__} = '';
+
+    # We don't want to unset these if we're coming from an eval because
+    # then we've turned off diagnostics. (Actually what does this next
+    # line do?  -PSeibel)
+    $SIG{__DIE__} = $SIG{__WARN__} = '' unless $in_eval;
     local($Carp::CarpLevel) = 1;
     confess "Uncaught exception from user code:\n\t$exception";
 	# up we go; where we stop, nobody knows, but i think we die now
@@ -428,6 +451,7 @@ sub death_trap {
 
 sub splainthis {
     local $_ = shift;
+    local $\;
     ### &finish_compilation unless %msg;
     s/\.?\n+$//;
     my $orig = $_;
@@ -481,7 +505,7 @@ sub unescape {
              exists $HTML_Escapes{$1}
                 ? do { $HTML_Escapes{$1} }
                 : do {
-                    warn "Unknown escape: $& in $_";
+                    warn "Unknown escape: E<$1> in $_";
                     "E<$1>";
                 } 
          } 
@@ -490,7 +514,7 @@ sub unescape {
 
 sub shorten {
     my $line = $_[0];
-    if (length $line > 79) {
+    if (length($line) > 79 and index($line, "\n") == -1) {
 	my $space_place = rindex($line, ' ', 79);
 	if ($space_place != -1) {
 	    substr($line, $space_place, 1) = "\n\t";
diff --git a/lib/dotsh.pl b/lib/dotsh.pl
index 8e9d9620e5..877467eb96 100644
--- a/lib/dotsh.pl
+++ b/lib/dotsh.pl
@@ -53,8 +53,8 @@ sub dotsh {
    open (_SH_ENV, "/tmp/_sh_env$$") || die "Could not open /tmp/_sh_env$$!\n";
    while (<_SH_ENV>) {
        chop;
-       /=/;
-       $ENV{$`} = $';
+       m/^([^=]*)=(.*)/s;
+       $ENV{$1} = $2;
    }
    close (_SH_ENV);
    system "rm -f /tmp/_sh_env$$";
diff --git a/lib/dumpvar.pl b/lib/dumpvar.pl
index 06c0930581..1fa8246da7 100644
--- a/lib/dumpvar.pl
+++ b/lib/dumpvar.pl
@@ -25,6 +25,7 @@ $subdump = 1;
 
 sub main::dumpValue {
   local %address;
+  local $^W=0;
   (print "undef\n"), return unless defined $_[0];
   (print &stringify($_[0]), "\n"), return unless ref $_[0];
   dumpvar::unwrap($_[0],0);
@@ -222,8 +223,8 @@ sub unwrap {
 
 sub matchvar {
   $_[0] eq $_[1] or 
-    ($_[1] =~ /^([!~])(.)/) and 
-      ($1 eq '!') ^ (eval {($_[2] . "::" . $_[0]) =~ /$2$'/});
+    ($_[1] =~ /^([!~])(.)([\x00-\xff]*)/) and 
+      ($1 eq '!') ^ (eval {($_[2] . "::" . $_[0]) =~ /$2$3/});
 }
 
 sub compactDump {
@@ -319,7 +320,7 @@ sub findsubs {
 
 sub main::dumpvar {
     my ($package,@vars) = @_;
-    local(%address,$key,$val);
+    local(%address,$key,$val,$^W);
     $package .= "::" unless $package =~ /::$/;
     *stab = *{"main::"};
     while ($package =~ /(\w+?::)/g){
diff --git a/lib/find.pl b/lib/find.pl
index 40e613e97e..ee5dc5d150 100644
--- a/lib/find.pl
+++ b/lib/find.pl
@@ -29,80 +29,19 @@
 #
 # Set the variable $dont_use_nlink if you're using AFS, since AFS cheats.
 
-sub find {
-    chop($cwd = `pwd`);
-    foreach $topdir (@_) {
-	(($topdev,$topino,$topmode,$topnlink) = stat($topdir))
-	  || (warn("Can't stat $topdir: $!\n"), next);
-	if (-d _) {
-	    if (chdir($topdir)) {
-		($dir,$_) = ($topdir,'.');
-		$name = $topdir;
-		&wanted;
-		($fixtopdir = $topdir) =~ s,/$,, ;
-		&finddir($fixtopdir,$topnlink);
-	    }
-	    else {
-		warn "Can't cd to $topdir: $!\n";
-	    }
-	}
-	else {
-	    unless (($dir,$_) = $topdir =~ m#^(.*/)(.*)$#) {
-		($dir,$_) = ('.', $topdir);
-	    }
-	    $name = $topdir;
-	    chdir $dir && &wanted;
-	}
-	chdir $cwd;
-    }
-}
-
-sub finddir {
-    local($dir,$nlink) = @_;
-    local($dev,$ino,$mode,$subcount);
-    local($name);
-
-    # Get the list of files in the current directory.
-
-    opendir(DIR,'.') || (warn "Can't open $dir: $!\n", return);
-    local(@filenames) = readdir(DIR);
-    closedir(DIR);
+use File::Find ();
 
-    if ($nlink == 2 && !$dont_use_nlink) {  # This dir has no subdirectories.
-	for (@filenames) {
-	    next if $_ eq '.';
-	    next if $_ eq '..';
-	    $name = "$dir/$_";
-	    $nlink = 0;
-	    &wanted;
-	}
-    }
-    else {                    # This dir has subdirectories.
-	$subcount = $nlink - 2;
-	for (@filenames) {
-	    next if $_ eq '.';
-	    next if $_ eq '..';
-	    $nlink = $prune = 0;
-	    $name = "$dir/$_";
-	    &wanted;
-	    if ($subcount > 0 || $dont_use_nlink) {    # Seen all the subdirs?
+*name		= *File::Find::name;
+*prune		= *File::Find::prune;
+*dir		= *File::Find::dir;
+*topdir		= *File::Find::topdir;
+*topdev		= *File::Find::topdev;
+*topino		= *File::Find::topino;
+*topmode	= *File::Find::topmode;
+*topnlink	= *File::Find::topnlink;
 
-		# Get link count and check for directoriness.
-
-		($dev,$ino,$mode,$nlink) = lstat($_) unless $nlink;
-		
-		if (-d _) {
-
-		    # It really is a directory, so do it recursively.
-
-		    if (!$prune && chdir $_) {
-			&finddir($name,$nlink);
-			chdir '..';
-		    }
-		    --$subcount;
-		}
-	    }
-	}
-    }
+sub find {
+    &File::Find::find(\&wanted, @_);
 }
+
 1;
diff --git a/lib/finddepth.pl b/lib/finddepth.pl
index 1fe6a375b6..bfa44bb1bc 100644
--- a/lib/finddepth.pl
+++ b/lib/finddepth.pl
@@ -27,79 +27,20 @@
 #	    ($prune = 1);
 #	}
 
-sub finddepth {
-    chop($cwd = `pwd`);
-    foreach $topdir (@_) {
-	(($topdev,$topino,$topmode,$topnlink) = stat($topdir))
-	  || (warn("Can't stat $topdir: $!\n"), next);
-	if (-d _) {
-	    if (chdir($topdir)) {
-		($fixtopdir = $topdir) =~ s,/$,, ;
-		&finddepthdir($fixtopdir,$topnlink);
-		($dir,$_) = ($fixtopdir,'.');
-		$name = $fixtopdir;
-		&wanted;
-	    }
-	    else {
-		warn "Can't cd to $topdir: $!\n";
-	    }
-	}
-	else {
-	    unless (($dir,$_) = $topdir =~ m#^(.*/)(.*)$#) {
-		($dir,$_) = ('.', $topdir);
-	    }
-	    chdir $dir && &wanted;
-	}
-	chdir $cwd;
-    }
-}
-
-sub finddepthdir {
-    local($dir,$nlink) = @_;
-    local($dev,$ino,$mode,$subcount);
-    local($name);
-
-    # Get the list of files in the current directory.
-
-    opendir(DIR,'.') || warn "Can't open $dir: $!\n";
-    local(@filenames) = readdir(DIR);
-    closedir(DIR);
 
-    if ($nlink == 2) {        # This dir has no subdirectories.
-	for (@filenames) {
-	    next if $_ eq '.';
-	    next if $_ eq '..';
-	    $name = "$dir/$_";
-	    $nlink = 0;
-	    &wanted;
-	}
-    }
-    else {                    # This dir has subdirectories.
-	$subcount = $nlink - 2;
-	for (@filenames) {
-	    next if $_ eq '.';
-	    next if $_ eq '..';
-	    $nlink = $prune = 0;
-	    $name = "$dir/$_";
-	    if ($subcount > 0) {    # Seen all the subdirs?
+use File::Find ();
 
-		# Get link count and check for directoriness.
+*name		= *File::Find::name;
+*prune		= *File::Find::prune;
+*dir		= *File::Find::dir;
+*topdir		= *File::Find::topdir;
+*topdev		= *File::Find::topdev;
+*topino		= *File::Find::topino;
+*topmode	= *File::Find::topmode;
+*topnlink	= *File::Find::topnlink;
 
-		($dev,$ino,$mode,$nlink) = lstat($_) unless $nlink;
-		
-		if (-d _) {
-
-		    # It really is a directory, so do it recursively.
-
-		    if (!$prune && chdir $_) {
-			&finddepthdir($name,$nlink);
-			chdir '..';
-		    }
-		    --$subcount;
-		}
-	    }
-	    &wanted;
-	}
-    }
+sub finddepth {
+    &File::Find::finddepth(\&wanted, @_);
 }
+
 1;
diff --git a/lib/ftp.pl b/lib/ftp.pl
index f366cdb6fd..9528360da2 100644
--- a/lib/ftp.pl
+++ b/lib/ftp.pl
@@ -140,7 +140,7 @@ $real_site = "";
 $ftp_show = 0;
 sub ftp'debug
 {
-	$ftp_show = @_[0];
+	$ftp_show = $_[0];
 #	if( $ftp_show ){
 #		print STDERR "ftp debugging on\n";
 #	}
@@ -148,7 +148,7 @@ sub ftp'debug
 
 sub ftp'set_timeout
 {
-	$timeout = @_[0];
+	$timeout = $_[0];
 	$timeout_open = $timeout;
 	$timeout_read = 20 * $timeout;
 	if( $ftp_show ){
@@ -245,7 +245,7 @@ sub ftp'login
 	local( $remote_user, $remote_password ) = @_;
 
 	if( $proxy ){
-		&ftp'send( "USER $remote_user@$site" );
+		&ftp'send( "USER $remote_user\@$site" );
 	}
 	else {
 		&ftp'send( "USER $remote_user" );
diff --git a/lib/getcwd.pl b/lib/getcwd.pl
index 8db8e20c06..9dd694500c 100644
--- a/lib/getcwd.pl
+++ b/lib/getcwd.pl
@@ -44,9 +44,9 @@ sub getcwd
 		}
 		unless (@tst = lstat("$dotdots/$dir"))
 		{
-		    warn "lstat($dotdots/$dir): $!";
-		    closedir(getcwd'PARENT);				#');
-		    return '';
+		    # warn "lstat($dotdots/$dir): $!";
+		    # closedir(getcwd'PARENT);				#');
+		    # return '';
 		}
 	    }
 	    while ($dir eq '.' || $dir eq '..' || $tst[$[] != $pst[$[] ||
@@ -54,7 +54,7 @@ sub getcwd
 	}
 	$cwd = "$dir/$cwd";
 	closedir(getcwd'PARENT);					#');
-    } while ($dir);
+    } while ($dir ne '');
     chop($cwd);
     $cwd;
 }
diff --git a/lib/getopts.pl b/lib/getopts.pl
index a0818d1e3a..852aae89b1 100644
--- a/lib/getopts.pl
+++ b/lib/getopts.pl
@@ -8,23 +8,22 @@ sub Getopts {
     local($argumentative) = @_;
     local(@args,$_,$first,$rest);
     local($errs) = 0;
-    local($[) = 0;
 
     @args = split( / */, $argumentative );
     while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
 	($first,$rest) = ($1,$2);
 	$pos = index($argumentative,$first);
-	if($pos >= $[) {
-	    if($args[$pos+1] eq ':') {
+	if($pos >= 0) {
+	    if($pos < $#args && $args[$pos+1] eq ':') {
 		shift(@ARGV);
 		if($rest eq '') {
 		    ++$errs unless @ARGV;
 		    $rest = shift(@ARGV);
 		}
-		eval "\$opt_$first = \$rest;";
+		${"opt_$first"} = $rest;
 	    }
 	    else {
-		eval "\$opt_$first = 1";
+		${"opt_$first"} = 1;
 		if($rest eq '') {
 		    shift(@ARGV);
 		}
diff --git a/lib/importenv.pl b/lib/importenv.pl
index d56f32633b..c28ffd054d 100644
--- a/lib/importenv.pl
+++ b/lib/importenv.pl
@@ -8,7 +8,7 @@
 
 local($tmp,$key) = '';
 
-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 546ae87b89..4d32f96355 100644
--- a/lib/lib.pm
+++ b/lib/lib.pm
@@ -1,20 +1,30 @@
 package lib;
 
+use vars qw(@ORIG_INC);
 use Config;
 
 my $archname = $Config{'archname'};
 
-@ORIG_INC = ();		# (avoid typo warning)
 @ORIG_INC = @INC;	# take a handy copy of 'original' value
 
 
 sub import {
     shift;
     foreach (reverse @_) {
+	## Ignore this if not defined.
+	next unless defined($_);
+	if ($_ eq '') {
+	    require Carp;
+	    Carp::carp("Empty compile time value given to use lib");
+							# at foo.pl line ...
+	}
 	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";
+	if (-d "$_/$archname") {
+	    unshift(@INC, "$_/$archname")    if -d "$_/$archname/auto";
+	    unshift(@INC, "$_/$archname/$]") if -d "$_/$archname/$]/auto";
+	}
     }
 }
 
@@ -60,7 +70,6 @@ It is typically used to add extra directories to perl's search path so
 that later C<use> or C<require> statements will find modules which are
 not located on perl's default search path.
 
-
 =head2 ADDING DIRECTORIES TO @INC
 
 The parameters to C<use lib> are added to the start of the perl search
@@ -80,7 +89,6 @@ 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
 
 You should normally only add directories to @INC.  If you need to
@@ -106,7 +114,6 @@ 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
@@ -118,7 +125,7 @@ can say
 
 =head1 SEE ALSO
 
-AddINC - optional module which deals with paths relative to the source file.
+FindBin - optional module which deals with paths relative to the source file.
 
 =head1 AUTHOR
 
diff --git a/lib/locale.pm b/lib/locale.pm
new file mode 100644
index 0000000000..48213ab86c
--- /dev/null
+++ b/lib/locale.pm
@@ -0,0 +1,33 @@
+package locale;
+
+=head1 NAME
+
+locale - Perl pragma to use and avoid POSIX locales for built-in operations
+
+=head1 SYNOPSIS
+
+    @x = sort @y;	# ASCII sorting order
+    {
+        use locale;
+        @x = sort @y;   # Locale-defined sorting order
+    }
+    @x = sort @y;	# ASCII sorting order again
+
+=head1 DESCRIPTION
+
+This pragma tells the compiler to enable (or disable) the use of POSIX
+locales for built-in operations (LC_CTYPE for regular expressions, and
+LC_COLLATE for string comparison).  Each "use locale" or "no locale"
+affects statements to the end of the enclosing BLOCK.
+
+=cut
+
+sub import {
+    $^H |= 0x800;
+}
+
+sub unimport {
+    $^H &= ~0x800;
+}
+
+1;
diff --git a/lib/look.pl b/lib/look.pl
index 4c14e64727..e8dc8aacb6 100644
--- a/lib/look.pl
+++ b/lib/look.pl
@@ -10,7 +10,7 @@ sub look {
        $blksize,$blocks) = stat(FH);
     $blksize = 8192 unless $blksize;
     $key =~ s/[^\w\s]//g if $dict;
-    $key =~ y/A-Z/a-z/ if $fold;
+    $key = lc $key if $fold;
     $max = int($size / $blksize);
     while ($max - $min > 1) {
 	$mid = int(($max + $min) / 2);
@@ -19,7 +19,7 @@ sub look {
 	$_ = <FH>;
 	chop;
 	s/[^\w\s]//g if $dict;
-	y/A-Z/a-z/ if $fold;
+	$_ = lc $_ if $fold;
 	if ($_ lt $key) {
 	    $min = $mid;
 	}
@@ -33,7 +33,7 @@ sub look {
     while (<FH>) {
 	chop;
 	s/[^\w\s]//g if $dict;
-	y/A-Z/a-z/ if $fold;
+	$_ = lc $_ if $fold;
 	last if $_ ge $key;
 	$min = tell(FH);
     }
diff --git a/lib/newgetopt.pl b/lib/newgetopt.pl
index 38cad59c73..0b7eed8bfe 100644
--- a/lib/newgetopt.pl
+++ b/lib/newgetopt.pl
@@ -1,6 +1,6 @@
 # newgetopt.pl -- new options parsing.
 # Now just a wrapper around the Getopt::Long module.
-# $Id: newgetopt.pl,v 1.15 1995/12/26 14:57:33 jv Exp $
+# $Id: newgetopt.pl,v 1.17 1996-10-02 11:17:16+02 jv Exp $
 
 {   package newgetopt;
 
@@ -15,12 +15,16 @@
 	$getopt_compat = 0;	# disallow '+' to start options
 	$option_start = "(--|-)";
 	$order = $REQUIRE_ORDER;
+	$bundling = 0;
+	$passthrough = 0;
     }
     else {
 	$autoabbrev = 1;	# automatic abbrev of options
 	$getopt_compat = 1;	# allow '+' to start options
 	$option_start = "(--|-|\\+)";
 	$order = $PERMUTE;
+	$bundling = 0;
+	$passthrough = 0;
     }
 
     # Other configurable settings.
@@ -45,8 +49,14 @@ sub NGetOpt {
 	if defined $newgetopt::option_start;
     $Getopt::Long::order = $newgetopt::order 
 	if defined $newgetopt::order;
+    $Getopt::Long::bundling = $newgetopt::bundling 
+	if defined $newgetopt::bundling;
     $Getopt::Long::ignorecase = $newgetopt::ignorecase 
 	if defined $newgetopt::ignorecase;
+    $Getopt::Long::ignorecase = $newgetopt::ignorecase 
+	if defined $newgetopt::ignorecase;
+    $Getopt::Long::passthrough = $newgetopt::passthrough 
+	if defined $newgetopt::passthrough;
 
     &GetOptions;
 }
diff --git a/lib/open2.pl b/lib/open2.pl
index dcd68a8cd3..8cf08c2e8b 100644
--- a/lib/open2.pl
+++ b/lib/open2.pl
@@ -1,54 +1,12 @@
-# &open2: tom christiansen, <tchrist@convex.com>
+# This is a compatibility interface to IPC::Open2.  New programs should
+# do
 #
-# usage: $pid = &open2('rdr', 'wtr', 'some cmd and args');
-#    or  $pid = &open2('rdr', 'wtr', 'some', 'cmd', 'and', 'args');
+#     use IPC::Open2;
 #
-# spawn the given $cmd and connect $rdr for
-# reading and $wtr for writing.  return pid
-# of child, or 0 on failure.  
-# 
-# WARNING: this is dangerous, as you may block forever
-# unless you are very careful.  
-# 
-# $wtr is left unbuffered.
-# 
-# abort program if
-#	rdr or wtr are null
-# 	pipe or fork or exec fails
-
-package open2;
-$fh = 'FHOPEN000';  # package static in case called more than once
-
-sub main'open2 {
-    local($kidpid);
-    local($dad_rdr, $dad_wtr, @cmd) = @_;
-
-    $dad_rdr ne '' 		|| die "open2: rdr should not be null";
-    $dad_wtr ne '' 		|| die "open2: wtr should not be null";
-
-    # force unqualified filehandles into callers' package
-    local($package) = caller;
-    $dad_rdr =~ s/^[^']+$/$package'$&/;
-    $dad_wtr =~ s/^[^']+$/$package'$&/;
-
-    local($kid_rdr) = ++$fh;
-    local($kid_wtr) = ++$fh;
-
-    pipe($dad_rdr, $kid_wtr) 	|| die "open2: pipe 1 failed: $!";
-    pipe($kid_rdr, $dad_wtr) 	|| die "open2: pipe 2 failed: $!";
+# instead of
+#
+#     require 'open2.pl';
 
-    if (($kidpid = fork) < 0) {
-	die "open2: fork failed: $!";
-    } elsif ($kidpid == 0) {
-	close $dad_rdr; close $dad_wtr;
-	open(STDIN,  "<&$kid_rdr");
-	open(STDOUT, ">&$kid_wtr");
-	warn "execing @cmd\n" if $debug;
-	exec @cmd;
-	die "open2: exec of @cmd failed";   
-    } 
-    close $kid_rdr; close $kid_wtr;
-    select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe
-    $kidpid;
-}
-1; # so require is happy
+package main;
+use IPC::Open2 'open2';
+1
diff --git a/lib/open3.pl b/lib/open3.pl
index 7c8b6ae288..7fcc931861 100644
--- a/lib/open3.pl
+++ b/lib/open3.pl
@@ -1,106 +1,12 @@
-# &open3: Marc Horowitz <marc@mit.edu>
-# derived mostly from &open2 by tom christiansen, <tchrist@convex.com>
+# This is a compatibility interface to IPC::Open3.  New programs should
+# do
 #
-# $Id: open3.pl,v 1.1 1993/11/23 06:26:15 marc Exp $
+#     use IPC::Open3;
 #
-# usage: $pid = open3('wtr', 'rdr', 'err' 'some cmd and args', 'optarg', ...);
+# instead of
 #
-# spawn the given $cmd and connect rdr for
-# reading, wtr for writing, and err for errors.
-# if err is '', or the same as rdr, then stdout and
-# stderr of the child are on the same fh.  returns pid
-# of child, or 0 on failure.
+#     require 'open3.pl';
 
-
-# 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.
-
-
-# WARNING: this is dangerous, as you may block forever
-# unless you are very careful.
-#
-# $wtr is left unbuffered.
-#
-# abort program if
-#   rdr or wtr are null
-#   pipe or fork or exec fails
-
-package open3;
-
-$fh = 'FHOPEN000';  # package static in case called more than once
-
-sub main'open3 {
-    local($kidpid);
-    local($dad_wtr, $dad_rdr, $dad_err, @cmd) = @_;
-    local($dup_wtr, $dup_rdr, $dup_err);
-
-    $dad_wtr			|| die "open3: wtr should not be null";
-    $dad_rdr			|| die "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/^\>\&//);
-
-    # force unqualified filehandles into callers' package
-    local($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;
-
-    if (!$dup_wtr) {
-	pipe($kid_rdr, $dad_wtr)    || die "open3: pipe 1 (stdin) failed: $!";
-    }
-    if (!$dup_rdr) {
-	pipe($dad_rdr, $kid_wtr)    || die "open3: pipe 2 (stdout) failed: $!";
-    }
-    if ($dad_err ne $dad_rdr && !$dup_err) {
-	pipe($dad_err, $kid_err)    || die "open3: pipe 3 (stderr) failed: $!";
-    }
-
-    if (($kidpid = fork) < 0) {
-        die "open2: fork failed: $!";
-    } elsif ($kidpid == 0) {
-	if ($dup_wtr) {
-	    open(STDIN,  ">&$dad_wtr") if (fileno(STDIN) != fileno($dad_wtr));
-	} else {
-	    close($dad_wtr);
-	    open(STDIN,  ">&$kid_rdr");
-	}
-	if ($dup_rdr) {
-	    open(STDOUT, ">&$dad_rdr") if (fileno(STDOUT) != fileno($dad_rdr));
-	} else {
-	    close($dad_rdr);
-	    open(STDOUT, ">&$kid_wtr");
-	}
-	if ($dad_rdr ne $dad_err) {
-	    if ($dup_err) {
-		open(STDERR, ">&$dad_err")
-		    if (fileno(STDERR) != fileno($dad_err));
-	    } else {
-		close($dad_err);
-		open(STDERR, ">&$kid_err");
-	    }
-	} else {
-	    open(STDERR, ">&STDOUT") if (fileno(STDERR) != fileno(STDOUT));
-	}
-	local($")=(" ");
-	exec @cmd;
-        die "open2: exec of @cmd failed";
-    }
-
-    close $kid_rdr; close $kid_wtr; close $kid_err;
-    if ($dup_wtr) {
-	close($dad_wtr);
-    }
-
-    select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe
-    $kidpid;
-}
-1; # so require is happy
+package main;
+use IPC::Open3 'open3';
+1
diff --git a/lib/overload.pm b/lib/overload.pm
index 54d2cbb441..c9044db0dc 100644
--- a/lib/overload.pm
+++ b/lib/overload.pm
@@ -1,12 +1,27 @@
 package overload;
 
+sub nil {}
+
 sub OVERLOAD {
   $package = shift;
   my %arg = @_;
-  my $hash = \%{$package . "::OVERLOAD"};
+  my ($sub, $fb);
+  $ {$package . "::OVERLOAD"}{dummy}++; # Register with magic by touching.
+  *{$package . "::()"} = \&nil; # Make it findable via fetchmethod.
   for (keys %arg) {
-    $hash->{$_} = $arg{$_};
+    if ($_ eq 'fallback') {
+      $fb = $arg{$_};
+    } else {
+      $sub = $arg{$_};
+      if (not ref $sub and $sub !~ /::/) {
+	$ {$package . "::(" . $_} = $sub;
+	$sub = \&nil;
+      }
+      #print STDERR "Setting `$ {'package'}::\cO$_' to \\&`$sub'.\n";
+      *{$package . "::(" . $_} = \&{ $sub };
+    }
   }
+  ${$package . "::()"} = $fb; # Make it findable too (fallback only).
 }
 
 sub import {
@@ -18,44 +33,73 @@ sub import {
 
 sub unimport {
   $package = (caller())[0];
-  my $hash = \%{$package . "::OVERLOAD"};
+  ${$package . "::OVERLOAD"}{dummy}++; # Upgrade the table
   shift;
   for (@_) {
-    delete $hash->{$_};
+    if ($_ eq 'fallback') {
+      undef $ {$package . "::()"};
+    } else {
+      delete $ {$package . "::"}{"(" . $_};
+    }
   }
 }
 
 sub Overloaded {
-  defined ($package = ref $_[0]) and defined %{$package . "::OVERLOAD"};
+  my $package = shift;
+  $package = ref $package if ref $package;
+  $package->can('()');
+}
+
+sub ov_method {
+  my $globref = shift;
+  return undef unless $globref;
+  my $sub = \&{*$globref};
+  return $sub if $sub ne \&nil;
+  return shift->can($ {*$globref});
 }
 
 sub OverloadedStringify {
-  defined ($package = ref $_[0]) and 
-    defined %{$package . "::OVERLOAD"} and 
-      exists $ {$package . "::OVERLOAD"}{'""'} and
-	defined &{$ {$package . "::OVERLOAD"}{'""'}};
+  my $package = shift;
+  $package = ref $package if ref $package;
+  #$package->can('(""')
+  ov_method mycan($package, '(""'), $package;
 }
 
 sub Method {
-  defined ($package = ref $_[0]) and 
-    defined %{$package . "::OVERLOAD"} and 
-      $ {$package . "::OVERLOAD"}{$_[1]};
+  my $package = shift;
+  $package = ref $package if ref $package;
+  #my $meth = $package->can('(' . shift);
+  ov_method mycan($package, '(' . shift), $package;
+  #return $meth if $meth ne \&nil;
+  #return $ {*{$meth}};
 }
 
 sub AddrRef {
-  $package = ref $_[0];
-  bless $_[0], Overload::Fake;	# Non-overloaded package
+  my $package = ref $_[0];
+  return "$_[0]" unless $package;
+  bless $_[0], overload::Fake;	# Non-overloaded package
   my $str = "$_[0]";
   bless $_[0], $package;	# Back
-  $str;
+  $package . substr $str, index $str, '=';
 }
 
 sub StrVal {
-  (OverloadedStringify) ?
-    (AddrRef) :
+  (OverloadedStringify($_[0])) ?
+    (AddrRef(shift)) :
     "$_[0]";
 }
 
+sub mycan {				# Real can would leave stubs.
+  my ($package, $meth) = @_;
+  return \*{$package . "::$meth"} if defined &{$package . "::$meth"};
+  my $p;
+  foreach $p (@{$package . "::ISA"}) {
+    my $out = mycan($p, $meth);
+    return $out if $out;
+  }
+  return undef;
+}
+
 1;
 
 __END__
@@ -105,9 +149,10 @@ 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.
+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.  Note that values specified as strings are
+interpreted as methods, not subroutines.  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
@@ -117,6 +162,10 @@ C<$a+=7>, or C<$a++>.  See L<MAGIC AUTOGENERATION>.  (Mathemagical
 methods refer to methods triggered by an overloaded mathematical
 operator.)
 
+Since overloading respects inheritance via the @ISA hierarchy, the
+above declaration would also trigger overloading of C<+> and C<*=> in
+all the packages which inherit from C<Number>.
+
 =head2 Calling Conventions for Binary Operations
 
 The functions specified in the C<use overload ...> directive are called
@@ -186,7 +235,9 @@ arrays, C<cmp> is used to compare values subject to C<use overload>.
     "&", "^", "|", "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.
+specified, it can be autogenerated using the method for
+subtraction. If the method for "C<!>" is not specified, it can be
+autogenerated using the methods for "C<bool>", or "C<\"\">", or "C<0+>".
 
 =item * I<Increment and decrement>
 
@@ -201,7 +252,7 @@ postfix form.
     "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.
+for "E<lt>" or "E<lt>=E<gt>" combined with either unary minus or subtraction.
 
 =item * I<Boolean, string and numeric conversion>
 
@@ -223,12 +274,46 @@ see L<SPECIAL SYMBOLS FOR C<use overload>>.
 
 See L<"Fallback"> for an explanation of when a missing method can be autogenerated.
 
+=head2 Inheritance and overloading
+
+Inheritance interacts with overloading in two ways.
+
+=over
+
+=item Strings as values of C<use overload> directive
+
+If C<value> in
+
+  use overload key => value;
+
+is a string, it is interpreted as a method name.
+
+=item Overloading of an operation is inherited by derived classes
+
+Any class derived from an overloaded class is also overloaded.  The
+set of overloaded methods is the union of overloaded methods of all
+the ancestors. If some method is overloaded in several ancestor, then
+which description will be used is decided by the usual inheritance
+rules:
+
+If C<A> inherits from C<B> and C<C> (in this order), C<B> overloads
+C<+> with C<\&D::plus_sub>, and C<C> overloads C<+> by C<"plus_meth">,
+then the subroutine C<D::plus_sub> will be called to implement
+operation C<+> for an object in package C<A>.
+
+=back
+
+Note that since the value of the C<fallback> key is not a subroutine,
+its inheritance is not governed by the above rules.  In the current
+implementation, the value of C<fallback> in the first overloaded
+ancestor is used, but this is accidental and subject to change.
+
 =head1 SPECIAL SYMBOLS FOR C<use overload>
 
 Three keys are recognized by Perl that are not covered by the above
 description.
 
-=head2  Last Resort
+=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
@@ -275,6 +360,9 @@ C<"nomethod"> value, and if this is missing, raises an exception.
 
 =back
 
+B<Note.> C<"fallback"> inheritance via @ISA is not carved in stone
+yet, see L<"Inheritance and overloading">.
+
 =head2 Copy Constructor
 
 The value for C<"="> is a reference to a function with three
@@ -361,6 +449,11 @@ can be expressed in terms of C<$aE<lt>0> and C<-$a> (or C<0-$a>).
 
 can be expressed in terms of subtraction.
 
+=item I<Negation>
+
+C<!> and C<not> can be expressed in terms of boolean conversion, or
+string or numerical conversion.
+
 =item I<Concatenation>
 
 can be expressed in terms of string conversion.
@@ -369,7 +462,7 @@ can be expressed in terms of string conversion.
 
 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
 
@@ -433,31 +526,40 @@ Returns C<undef> or a reference to the method that implements C<op>.
 
 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.)
+The table of methods for all operations is cached in magic for the
+symbol table hash for the package.  The cache is invalidated during
+processing of C<use overload>, C<no overload>, new function
+definitions, and changes in @ISA. However, this invalidation remains
+unprocessed until the next C<bless>ing into the package. Hence if you
+want to change overloading structure 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. However, the magic which implements overloading is applied to
+the stashes, which are rarely used directly, thus should not slow down
+Perl.)
 
 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. 
+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 in some package, 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. The only
+size penalty if overload is used in some package is that I<all> the
+packages acquire a magic during the next C<bless>ing into the
+package. This magic is three-words-long for packages without
+overloading, and carries the cache tabel if the package is overloaded.
 
 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
@@ -469,19 +571,31 @@ to be changed are constant (but this is not enforced).
 
 =head1 AUTHOR
 
-Ilya Zakharevich <F<ilya@math.mps.ohio-state.edu>>.
+Ilya Zakharevich E<lt>F<ilya@math.mps.ohio-state.edu>E<gt>.
 
 =head1 DIAGNOSTICS
 
 When Perl is run with the B<-Do> switch or its equivalent, overloading
 induces diagnostic messages.
 
+Using the C<m> command of Perl debugger (see L<perldebug>) one can
+deduce which operations are overloaded (and which ancestor triggers
+this overloading). Say, if C<eq> is overloaded, then the method C<(eq>
+is shown by debugger. The method C<()> corresponds to the C<fallback>
+key (in fact a presence of this method shows that this package has
+overloading enabled, and it is what is used by the C<Overloaded>
+function).
+
 =head1 BUGS
 
-Because it is used for overloading, the per-package associative array
-%OVERLOAD now has a special meaning in Perl.
+Because it is used for overloading, the per-package hash %OVERLOAD now
+has a special meaning in Perl. The symbol table is filled with names
+looking like line-noise.
 
-As shipped, mathemagical properties are not inherited via the @ISA tree.
+For the purpose of inheritance every overloaded package behaves as if
+C<fallback> is present (possibly undefined). This may create
+interesting effects if some package is not overloaded, but inherits
+from two overloaded packages.
 
 This document is confusing.
 
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 5c8d2727b7..c09238d16c 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -2,7 +2,8 @@ package DB;
 
 # Debugger for Perl 5.00x; perl5db.pl patch level:
 
-$header = 'perl5db.pl patch level 0.94';
+$VERSION = 1.00;
+$header = "perl5db.pl version $VERSION";
 
 # Enhanced by ilya@math.ohio-state.edu (Ilya Zakharevich)
 # Latest version available: ftp://ftp.math.ohio-state.edu/pub/users/ilya/perl
@@ -16,14 +17,35 @@ $header = 'perl5db.pl patch level 0.94';
 # This file is automatically included if you do perl -d.
 # It's probably not useful to include this yourself.
 #
-# Perl supplies the values for @line and %sub.  It effectively inserts
-# a &DB'DB(<linenum>); in front of every place that can have a
+# Perl supplies the values for %sub.  It effectively inserts
+# a &DB'DB(); in front of every place that can have a
 # breakpoint. Instead of a subroutine call it calls &DB::sub with
 # $DB::sub being the called subroutine. It also inserts a BEGIN
 # {require 'perl5db.pl'} before the first line.
 #
+# After each `require'd file is compiled, but before it is executed, a
+# call to DB::postponed($main::{'_<'.$filename}) is emulated. Here the
+# $filename is the expanded name of the `require'd file (as found as
+# value of %INC).
+#
+# Additional services from Perl interpreter:
+#
+# if caller() is called from the package DB, it provides some
+# additional data.
+#
+# The array @{$main::{'_<'.$filename} is the line-by-line contents of
+# $filename.
+#
+# The hash %{'_<'.$filename} contains breakpoints and action (it is
+# keyed by line number), and individual entries are settable (as
+# opposed to the whole hash). Only true/false is important to the
+# interpreter, though the values used by perl5db.pl have the form
+# "$break_condition\0$action". Values are magical in numeric context.
+#
+# The scalar ${'_<'.$filename} contains "_<$filename".
+#
 # Note that no subroutine call is possible until &DB::sub is defined
-# (for subroutines defined outside this file). In fact the same is
+# (for subroutines defined outside of the package DB). In fact the same is
 # true if $deep is not defined.
 #
 # $Log:	perldb.pl,v $
@@ -63,6 +85,65 @@ $header = 'perl5db.pl patch level 0.94';
 # information into db.out.  (If you interrupt it, you would better
 # reset LineInfo to something "interactive"!)
 #
+##################################################################
+# Changelog:
+
+# A lot of things changed after 0.94. First of all, core now informs
+# debugger about entry into XSUBs, overloaded operators, tied operations,
+# BEGIN and END. Handy with `O f=2'.
+
+# This can make debugger a little bit too verbose, please be patient
+# and report your problems promptly.
+
+# Now the option frame has 3 values: 0,1,2.
+
+# Note that if DESTROY returns a reference to the object (or object),
+# the deletion of data may be postponed until the next function call,
+# due to the need to examine the return value.
+
+# Changes: 0.95: `v' command shows versions.
+# Changes: 0.96: `v' command shows version of readline.
+#	primitive completion works (dynamic variables, subs for `b' and `l',
+#		options). Can `p %var'
+#	Better help (`h <' now works). New commands <<, >>, {, {{.
+#	{dump|print}_trace() coded (to be able to do it from <<cmd).
+#	`c sub' documented.
+#	At last enough magic combined to stop after the end of debuggee.
+#	!! should work now (thanks to Emacs bracket matching an extra
+#	`]' in a regexp is caught).
+#	`L', `D' and `A' span files now (as documented).
+#	Breakpoints in `require'd code are possible (used in `R').
+#	Some additional words on internal work of debugger.
+#	`b load filename' implemented.
+#	`b postpone subr' implemented.
+#	now only `q' exits debugger (overwriteable on $inhibit_exit).
+#	When restarting debugger breakpoints/actions persist.
+#     Buglet: When restarting debugger only one breakpoint/action per 
+#		autoloaded function persists.
+# Changes: 0.97: NonStop will not stop in at_exit().
+#	Option AutoTrace implemented.
+#	Trace printed differently if frames are printed too.
+#	new `inhibitExit' option.
+#	printing of a very long statement interruptible.
+# Changes: 0.98: New command `m' for printing possible methods
+#	'l -' is a synonim for `-'.
+#	Cosmetic bugs in printing stack trace.
+#	`frame' & 8 to print "expanded args" in stack trace.
+#	Can list/break in imported subs.
+#	new `maxTraceLen' option.
+#	frame & 4 and frame & 8 granted.
+#	new command `m'
+#	nonstoppable lines do not have `:' near the line number.
+#	`b compile subname' implemented.
+#	Will not use $` any more.
+#	`-' behaves sane now.
+# Changes: 0.99: Completion for `f', `m'.
+#	`m' will remove duplicate names instead of duplicate functions.
+#	`b load' strips trailing whitespace.
+#	completion ignores leading `|'; takes into account current package
+#	when completing a subroutine name (same for `l').
+
+####################################################################
 
 # Needed for the statement after exec():
 
@@ -76,12 +157,11 @@ warn (			# Do not ;-)
       $dumpvar::quoteHighBit,  
       $dumpvar::printUndef,    
       $dumpvar::globPrint,     
-      $readline::Tk_toloop,    
       $dumpvar::usageOnly,
       @ARGS,
       $Carp::CarpLevel,
       $panic,
-      $first_time,
+      $second_time,
      ) if 0;
 
 # Command-line + PERLLIB:
@@ -91,16 +171,14 @@ warn (			# Do not ;-)
 
 $trace = $signal = $single = 0;	# Uninitialized warning suppression
                                 # (local $^W cannot help - other packages!).
-@stack = (0);
-
-$option{PrintRet} = 1;
+$inhibit_exit = $option{PrintRet} = 1;
 
 @options     = qw(hashDepth arrayDepth DumpDBFiles DumpPackages 
 		  compactDump veryCompact quote HighBit undefPrint
-		  globPrint PrintRet UsageOnly frame
-		  TTY noTTY ReadLine NonStop LineInfo
-		  recallCommand ShellBang pager tkRunning
-		  signalLevel warnLevel dieLevel);
+		  globPrint PrintRet UsageOnly frame AutoTrace
+		  TTY noTTY ReadLine NonStop LineInfo maxTraceLen
+		  recallCommand ShellBang pager tkRunning ornaments
+		  signalLevel warnLevel dieLevel inhibit_exit);
 
 %optionVars    = (
 		 hashDepth	=> \$dumpvar::hashDepth,
@@ -110,9 +188,11 @@ $option{PrintRet} = 1;
 		 HighBit	=> \$dumpvar::quoteHighBit,
 		 undefPrint	=> \$dumpvar::printUndef,
 		 globPrint	=> \$dumpvar::globPrint,
-		 tkRunning	=> \$readline::Tk_toloop,
 		 UsageOnly	=> \$dumpvar::usageOnly,     
-		  frame           => \$frame,
+		 frame          => \$frame,
+		 AutoTrace      => \$trace,
+		 inhibit_exit   => \$inhibit_exit,
+		 maxTraceLen	=> \$maxtrace,
 );
 
 %optionAction  = (
@@ -130,6 +210,8 @@ $option{PrintRet} = 1;
 		  signalLevel	=> \&signalLevel,
 		  warnLevel	=> \&warnLevel,
 		  dieLevel	=> \&dieLevel,
+		  tkRunning	=> \&tkRunning,
+		  ornaments	=> \&ornaments,
 		 );
 
 %optionRequire = (
@@ -140,12 +222,19 @@ $option{PrintRet} = 1;
 
 # These guys may be defined in $ENV{PERL5DB} :
 $rl = 1 unless defined $rl;
+$warnLevel = 1 unless defined $warnLevel;
+$dieLevel = 1 unless defined $dieLevel;
+$signalLevel = 1 unless defined $signalLevel;
+$pre = [] unless defined $pre;
+$post = [] unless defined $post;
+$pretype = [] unless defined $pretype;
 warnLevel($warnLevel);
 dieLevel($dieLevel);
 signalLevel($signalLevel);
 &pager(defined($ENV{PAGER}) ? $ENV{PAGER} : "|more") unless defined $pager;
 &recallCommand("!") unless defined $prc;
 &shellBang("!") unless defined $psh;
+$maxtrace = 400 unless defined $maxtrace;
 
 if (-e "/dev/tty") {
   $rcfile=".perldb";
@@ -169,9 +258,12 @@ if (exists $ENV{PERLDB_RESTART}) {
   delete $ENV{PERLDB_RESTART};
   # $restart = 1;
   @hist = get_list('PERLDB_HIST');
-  my @visited = get_list("PERLDB_VISITED");
-  for (0 .. $#visited) {
-    %{$postponed{$visited[$_]}} = get_list("PERLDB_FILE_$_");
+  %break_on_load = get_list("PERLDB_ON_LOAD");
+  %postponed = get_list("PERLDB_POSTPONE");
+  my @had_breakpoints= get_list("PERLDB_VISITED");
+  for (0 .. $#had_breakpoints) {
+    my %pf = get_list("PERLDB_FILE_$_");
+    $postponed_file{$had_breakpoints[$_]} = \%pf if %pf;
   }
   my %opt = get_list("PERLDB_OPT");
   my ($opt,$val);
@@ -181,6 +273,10 @@ if (exists $ENV{PERLDB_RESTART}) {
   }
   @INC = get_list("PERLDB_INC");
   @ini_INC = @INC;
+  $pretype = [get_list("PERLDB_PRETYPE")];
+  $pre = [get_list("PERLDB_PRE")];
+  $post = [get_list("PERLDB_POST")];
+  @typeahead = get_list("PERLDB_TYPEAHEAD", @typeahead);
 }
 
 if ($notty) {
@@ -194,14 +290,14 @@ if ($notty) {
 
   if (-e "/dev/tty") {
     $console = "/dev/tty";
-  } elsif (-e "con") {
+  } elsif (-e "con" or $^O eq 'MSWin32') {
     $console = "con";
   } else {
     $console = "sys\$command";
   }
 
   # Around a bug:
-  if (defined $ENV{OS2_SHELL} and $emacs) { # In OS/2
+  if (defined $ENV{OS2_SHELL} and ($emacs or $ENV{WINDOWID})) { # In OS/2
     $console = undef;
   }
 
@@ -249,41 +345,28 @@ if (defined &afterinit) {	# May be defined in $rcfile
   &afterinit();
 }
 
+$I_m_init = 1;
+
 ############################################################ Subroutines
 
 sub DB {
-    unless ($first_time++) {	# Do when-running init
-      if ($runnonstop) {		# Disable until signal
+    # _After_ the perl program is compiled, $single is set to 1:
+    if ($single and not $second_time++) {
+      if ($runnonstop) {	# Disable until signal
 	for ($i=0; $i <= $#stack; ) {
 	    $stack[$i++] &= ~1;
 	}
 	$single = 0;
-	return;
+	# return;			# Would not print trace!
       }
-      # Define a subroutine in which we will stop
-#       eval <<'EOE';
-# sub at_end::db {"Debuggee terminating";}
-# END {
-#   $DB::step = 1; 
-#   print $OUT "Debuggee terminating.\n"; 
-#   &at_end::db;}
-# EOE
     }
+    $runnonstop = 0 if $single or $signal; # Disable it if interactive.
     &save;
-    if ($doret) {
-	$doret = 0;
-	if ($option{PrintRet}) {
-	    print $OUT "$retctx context return from $lastsub:", 
-	      ($retctx eq 'list') ? "\n" : " " ;
-	    dumpit( ($retctx eq 'list') ? \@ret : $ret );
-	}
-    }
     ($package, $filename, $line) = caller;
     $filename_ini = $filename;
     $usercontext = '($@, $!, $,, $/, $\, $^W) = @saved;' .
       "package $package;";	# this won't let them modify, alas
-    local(*dbline) = "::_<$filename";
-    install_breakpoints($filename) unless $visited{$filename}++;
+    local(*dbline) = $main::{'_<' . $filename};
     $max = $#dbline;
     if (($stop,$action) = split(/\0/,$dbline{$line})) {
 	if ($stop eq '1') {
@@ -293,7 +376,9 @@ sub DB {
 	    $dbline{$line} =~ s/;9($|\0)/$1/;
 	}
     }
-    if ($single || $trace || $signal) {
+    my $was_signal = $signal;
+    $signal = 0;
+    if ($single || $trace || $was_signal) {
 	$term || &setterm;
 	if ($emacs) {
 	    $position = "\032\032$filename:$line:0\n";
@@ -305,48 +390,59 @@ sub DB {
 	    $after = ($dbline[$line] =~ /\n$/ ? '' : "\n");
 	    if (length($prefix) > 30) {
 	        $position = "$prefix$line):\n$line:\t$dbline[$line]$after";
-		print $LINEINFO $position;
 		$prefix = "";
 		$infix = ":\t";
 	    } else {
 		$infix = "):\t";
 		$position = "$prefix$line$infix$dbline[$line]$after";
+	    }
+	    if ($frame) {
+		print $LINEINFO ' ' x $#stack, "$line:\t$dbline[$line]$after";
+	    } else {
 		print $LINEINFO $position;
 	    }
 	    for ($i = $line + 1; $i <= $max && $dbline[$i] == 0; ++$i) { #{ vi
 		last if $dbline[$i] =~ /^\s*[\;\}\#\n]/;
+		last if $signal;
 		$after = ($dbline[$i] =~ /\n$/ ? '' : "\n");
 		$incr_pos = "$prefix$i$infix$dbline[$i]$after";
-		print $LINEINFO $incr_pos;
 		$position .= $incr_pos;
+		if ($frame) {
+		    print $LINEINFO ' ' x $#stack, "$i:\t$dbline[$i]$after";
+		} else {
+		    print $LINEINFO $incr_pos;
+		}
 	    }
 	}
     }
     $evalarg = $action, &eval if $action;
-    if ($single || $signal) {
+    if ($single || $was_signal) {
 	local $level = $level + 1;
-	$evalarg = $pre, &eval if $pre;
+	foreach $evalarg (@$pre) {
+	  &eval;
+	}
 	print $OUT $#stack . " levels deep in subroutine calls!\n"
 	  if $single & 4;
 	$start = $line;
+	$incr = -1;		# for backward motion.
+	@typeahead = @$pretype, @typeahead;
       CMD:
 	while (($term || &setterm),
 	       defined ($cmd=&readline("  DB" . ('<' x $level) .
 				       ($#hist+1) . ('>' x $level) .
 				       " "))) {
-	    #{			# <-- Do we know what this brace is for?
 		$single = 0;
 		$signal = 0;
 		$cmd =~ s/\\$/\n/ && do {
 		    $cmd .= &readline("  cont: ");
 		    redo CMD;
 		};
-		$cmd =~ /^q$/ && exit 0;
 		$cmd =~ /^$/ && ($cmd = $laststep);
 		push(@hist,$cmd) if length($cmd) > 1;
 	      PIPE: {
 		    ($i) = split(/\s+/,$cmd);
 		    eval "\$cmd =~ $alias{$i}", print $OUT $@ if $alias{$i};
+		    $cmd =~ /^q$/ && ($exiting = 1) && exit 0;
 		    $cmd =~ /^h$/ && do {
 			print $OUT $help;
 			next CMD; };
@@ -355,8 +451,10 @@ sub DB {
 			next CMD; };
 		    $cmd =~ /^h\s+(\S)$/ && do {
 			my $asked = "\Q$1";
-			if ($help =~ /^($asked([\s\S]*?)\n)(\Z|[^\s$asked])/m) {
+			if ($help =~ /^$asked/m) {
+			  while ($help =~ /^($asked([\s\S]*?)\n)(\Z|[^\s$asked])/mg) {
 			    print $OUT $1;
+			  }
 			} else {
 			    print $OUT "`$asked' is not a debugger command.\n";
 			}
@@ -373,6 +471,8 @@ sub DB {
 			    }
 			}
 			next CMD; };
+		    $cmd =~ /^v$/ && do {
+			list_versions(); next CMD};
 		    $cmd =~ s/^X\b/V $package/;
 		    $cmd =~ /^V$/ && do {
 			$cmd = "V $package"; };
@@ -383,6 +483,7 @@ sub DB {
 			do 'dumpvar.pl' unless defined &main::dumpvar;
 			if (defined &main::dumpvar) {
 			    local $frame = 0;
+			    local $doret = -2;
 			    &main::dumpvar($packname,@vars);
 			} else {
 			    print $OUT "dumpvar.pl not available.\n";
@@ -390,9 +491,14 @@ sub DB {
 			select ($savout);
 			next CMD; };
 		    $cmd =~ s/^x\b/ / && do { # So that will be evaled
-			$onetimeDump = 1; };
+			$onetimeDump = 'dump'; };
+		    $cmd =~ s/^m\s+([\w:]+)\s*$/ / && do {
+			methods($1); next CMD};
+		    $cmd =~ s/^m\b/ / && do { # So this will be evaled
+			$onetimeDump = 'methods'; };
 		    $cmd =~ /^f\b\s*(.*)/ && do {
 			$file = $1;
+			$file =~ s/\s+$//;
 			if (!$file) {
 			    print $OUT "The old f command is now the r command.\n";
 			    print $OUT "The new f command switches filenames.\n";
@@ -400,32 +506,37 @@ sub DB {
 			}
 			if (!defined $main::{'_<' . $file}) {
 			    if (($try) = grep(m#^_<.*$file#, keys %main::)) {{
-					      $file = substr($try,2);
-					      print "\n$file:\n";
+					      $try = substr($try,2);
+					      print $OUT "Choosing $try matching `$file':\n";
+					      $file = $try;
 					  }}
 			}
 			if (!defined $main::{'_<' . $file}) {
-			    print $OUT "There's no code here matching $file.\n";
+			    print $OUT "No file matching `$file' is loaded.\n";
 			    next CMD;
 			} elsif ($file ne $filename) {
-			    *dbline = "::_<$file";
-			    $visited{$file}++;
+			    *dbline = $main::{'_<' . $file};
 			    $max = $#dbline;
 			    $filename = $file;
 			    $start = 1;
 			    $cmd = "l";
-			} };
+			  } else {
+			    print $OUT "Already in $file.\n";
+			    next CMD;
+			  }
+		      };
+		    $cmd =~ s/^l\s+-\s*$/-/;
 		    $cmd =~ /^l\b\s*([\':A-Za-z_][\':\w]*)/ && do {
 			$subname = $1;
 			$subname =~ s/\'/::/;
-			$subname = "main::".$subname unless $subname =~ /::/;
+			$subname = $package."::".$subname 
+			  unless $subname =~ /::/;
 			$subname = "main".$subname if substr($subname,0,2) eq "::";
-			@pieces = split(/:/,$sub{$subname});
+			@pieces = split(/:/,find_sub($subname));
 			$subrange = pop @pieces;
 			$file = join(':', @pieces);
 			if ($file ne $filename) {
-			    *dbline = "::_<$file";
-			    $visited{$file}++;
+			    *dbline = $main::{'_<' . $file};
 			    $max = $#dbline;
 			    $filename = $file;
 			}
@@ -439,9 +550,10 @@ sub DB {
 			    next CMD;
 			} };
 		    $cmd =~ /^\.$/ && do {
+			$incr = -1;		# for backward motion.
 			$start = $line;
 			$filename = $filename_ini;
-			*dbline = "::_<$filename";
+			*dbline = $main::{'_<' . $filename};
 			$max = $#dbline;
 			print $LINEINFO $position;
 			next CMD };
@@ -452,8 +564,10 @@ sub DB {
 			#print $OUT 'l ' . $start . '-' . ($start + $incr);
 			$cmd = 'l ' . $start . '-' . ($start + $incr); };
 		    $cmd =~ /^-$/ && do {
+			$start -= $incr + $window + 1;
+			$start = 1 if $start <= 0;
 			$incr = $window - 1;
-			$cmd = 'l ' . ($start-$window*2) . '+'; };
+			$cmd = 'l ' . ($start) . '+'; };
 		    $cmd =~ /^l$/ && do {
 			$incr = $window - 1;
 			$cmd = 'l ' . $start . '-' . ($start + $incr); };
@@ -468,6 +582,7 @@ sub DB {
 			$i = $2;
 			$i = $line if $i eq '.';
 			$i = 1 if $i < 1;
+			$incr = $end - $i;
 			if ($emacs) {
 			    print $OUT "\032\032$filename:$i:0\n";
 			    $i = $end;
@@ -477,7 +592,7 @@ sub DB {
 			        $arrow = ($i==$line 
 					  and $filename eq $filename_ini) 
 				  ?  '==>' 
-				    : ':' ;
+				    : ($dbline[$i]+0 ? ':' : ' ') ;
 				$arrow .= 'b' if $stop;
 				$arrow .= 'a' if $action;
 				print $OUT "$i$arrow\t", $dbline[$i];
@@ -488,7 +603,13 @@ sub DB {
 			$start = $max if $start > $max;
 			next CMD; };
 		    $cmd =~ /^D$/ && do {
-			print $OUT "Deleting all breakpoints...\n";
+		      print $OUT "Deleting all breakpoints...\n";
+		      my $file;
+		      for $file (keys %had_breakpoints) {
+			local *dbline = $main::{'_<' . $file};
+			my $max = $#dbline;
+			my $was;
+			
 			for ($i = 1; $i <= $max ; $i++) {
 			    if (defined $dbline{$i}) {
 				$dbline{$i} =~ s/^[^\0]+//;
@@ -497,19 +618,89 @@ sub DB {
 				}
 			    }
 			}
-			next CMD; };
+		      }
+		      undef %postponed;
+		      undef %postponed_file;
+		      undef %break_on_load;
+		      undef %had_breakpoints;
+		      next CMD; };
 		    $cmd =~ /^L$/ && do {
+		      my $file;
+		      for $file (keys %had_breakpoints) {
+			local *dbline = $main::{'_<' . $file};
+			my $max = $#dbline;
+			my $was;
+			
 			for ($i = 1; $i <= $max; $i++) {
 			    if (defined $dbline{$i}) {
-				print $OUT "$i:\t", $dbline[$i];
+			        print "$file:\n" unless $was++;
+				print $OUT " $i:\t", $dbline[$i];
 				($stop,$action) = split(/\0/, $dbline{$i});
-				print $OUT "  break if (", $stop, ")\n"
+				print $OUT "   break if (", $stop, ")\n"
 				  if $stop;
-				print $OUT "  action:  ", $action, "\n"
+				print $OUT "   action:  ", $action, "\n"
 				  if $action;
 				last if $signal;
 			    }
 			}
+		      }
+		      if (%postponed) {
+			print $OUT "Postponed breakpoints in subroutines:\n";
+			my $subname;
+			for $subname (keys %postponed) {
+			  print $OUT " $subname\t$postponed{$subname}\n";
+			  last if $signal;
+			}
+		      }
+		      my @have = map { # Combined keys
+			keys %{$postponed_file{$_}}
+		      } keys %postponed_file;
+		      if (@have) {
+			print $OUT "Postponed breakpoints in files:\n";
+			my ($file, $line);
+			for $file (keys %postponed_file) {
+			  my $db = $postponed_file{$file};
+			  print $OUT " $file:\n";
+			  for $line (sort {$a <=> $b} keys %$db) {
+				print $OUT "  $line:\n";
+				my ($stop,$action) = split(/\0/, $$db{$line});
+				print $OUT "    break if (", $stop, ")\n"
+				  if $stop;
+				print $OUT "    action:  ", $action, "\n"
+				  if $action;
+				last if $signal;
+			  }
+			  last if $signal;
+			}
+		      }
+		      if (%break_on_load) {
+			print $OUT "Breakpoints on load:\n";
+			my $file;
+			for $file (keys %break_on_load) {
+			  print $OUT " $file\n";
+			  last if $signal;
+			}
+		      }
+		      next CMD; };
+		    $cmd =~ /^b\b\s*load\b\s*(.*)/ && do {
+			my $file = $1; $file =~ s/\s+$//;
+			{
+			  $break_on_load{$file} = 1;
+			  $break_on_load{$::INC{$file}} = 1 if $::INC{$file};
+			  $file .= '.pm', redo unless $file =~ /\./;
+			}
+			$had_breakpoints{$file} = 1;
+			print $OUT "Will stop on load of `@{[join '\', `', sort keys %break_on_load]}'.\n";
+			next CMD; };
+		    $cmd =~ /^b\b\s*(postpone|compile)\b\s*([':A-Za-z_][':\w]*)\s*(.*)/ && do {
+			my $cond = $3 || '1';
+			my ($subname, $break) = ($2, $1 eq 'postpone');
+			$subname =~ s/\'/::/;
+			$subname = "${'package'}::" . $subname
+			  unless $subname =~ /::/;
+			$subname = "main".$subname if substr($subname,0,2) eq "::";
+			$postponed{$subname} = $break 
+			  ? "break +0 if $cond" : "compile";
 			next CMD; };
 		    $cmd =~ /^b\b\s*([':A-Za-z_][':\w]*)\s*(.*)/ && do {
 			$subname = $1;
@@ -519,12 +710,12 @@ sub DB {
 			  unless $subname =~ /::/;
 			$subname = "main".$subname if substr($subname,0,2) eq "::";
 			# Filename below can contain ':'
-			($file,$i) = ($sub{$subname} =~ /^(.*):(.*)$/);
+			($file,$i) = (find_sub($subname) =~ /^(.*):(.*)$/);
 			$i += 0;
 			if ($i) {
 			    $filename = $file;
-			    *dbline = "::_<$filename";
-			    $visited{$filename}++;
+			    *dbline = $main::{'_<' . $filename};
+			    $had_breakpoints{$filename} = 1;
 			    $max = $#dbline;
 			    ++$i while $dbline[$i] == 0 && $i < $max;
 			    $dbline{$i} =~ s/^[^\0]*/$cond/;
@@ -538,6 +729,7 @@ sub DB {
 			if ($dbline[$i] == 0) {
 			    print $OUT "Line $i not breakable.\n";
 			} else {
+			    $had_breakpoints{$filename} = 1;
 			    $dbline{$i} =~ s/^[^\0]*/$cond/;
 			}
 			next CMD; };
@@ -547,13 +739,20 @@ sub DB {
 			delete $dbline{$i} if $dbline{$i} eq '';
 			next CMD; };
 		    $cmd =~ /^A$/ && do {
+		      my $file;
+		      for $file (keys %had_breakpoints) {
+			local *dbline = $main::{'_<' . $file};
+			my $max = $#dbline;
+			my $was;
+			
 			for ($i = 1; $i <= $max ; $i++) {
 			    if (defined $dbline{$i}) {
 				$dbline{$i} =~ s/\0[^\0]*//;
 				delete $dbline{$i} if $dbline{$i} eq '';
 			    }
 			}
-			next CMD; };
+		      }
+		      next CMD; };
 		    $cmd =~ /^O\s*$/ && do {
 			for (@options) {
 			    &dump_option($_);
@@ -562,11 +761,26 @@ sub DB {
 		    $cmd =~ /^O\s*(\S.*)/ && do {
 			parse_options($1);
 			next CMD; };
+		    $cmd =~ /^\<\<\s*(.*)/ && do { # \<\< for CPerl sake: not HERE
+			push @$pre, action($1);
+			next CMD; };
+		    $cmd =~ /^>>\s*(.*)/ && do {
+			push @$post, action($1);
+			next CMD; };
 		    $cmd =~ /^<\s*(.*)/ && do {
-			$pre = action($1);
+		        $pre = [], next CMD unless $1;
+			$pre = [action($1)];
 			next CMD; };
 		    $cmd =~ /^>\s*(.*)/ && do {
-			$post = action($1);
+		        $post = [], next CMD unless $1;
+			$post = [action($1)];
+			next CMD; };
+		    $cmd =~ /^\{\{\s*(.*)/ && do {
+			push @$pretype, $1;
+			next CMD; };
+		    $cmd =~ /^\{\s*(.*)/ && do {
+		        $pretype = [], next CMD unless $1;
+			$pretype = [$1];
 			next CMD; };
 		    $cmd =~ /^a\b\s*(\d+)(\s+(.*))?/ && do {
 			$i = $1; $j = $3;
@@ -578,22 +792,25 @@ sub DB {
 			}
 			next CMD; };
 		    $cmd =~ /^n$/ && do {
+		        end_report(), next CMD if $finished and $level <= 1;
 			$single = 2;
 			$laststep = $cmd;
 			last CMD; };
 		    $cmd =~ /^s$/ && do {
+		        end_report(), next CMD if $finished and $level <= 1;
 			$single = 1;
 			$laststep = $cmd;
 			last CMD; };
 		    $cmd =~ /^c\b\s*([\w:]*)\s*$/ && do {
+		        end_report(), next CMD if $finished and $level <= 1;
 			$i = $1;
 			if ($i =~ /\D/) { # subroutine name
-			    ($file,$i) = ($sub{$i} =~ /^(.*):(.*)$/);
+			    ($file,$i) = (find_sub($i) =~ /^(.*):(.*)$/);
 			    $i += 0;
 			    if ($i) {
 			        $filename = $file;
-				*dbline = "::_<$filename";
-				$visited{$filename}++;
+				*dbline = $main::{'_<' . $filename};
+				$had_breakpoints{$filename}++;
 				$max = $#dbline;
 				++$i while $dbline[$i] == 0 && $i < $max;
 			    } else {
@@ -613,11 +830,12 @@ sub DB {
 			}
 			last CMD; };
 		    $cmd =~ /^r$/ && do {
+		        end_report(), next CMD if $finished and $level <= 1;
 			$stack[$#stack] |= 1;
-			$doret = 1;
+			$doret = $option{PrintRet} ? $#stack - 1 : -2;
 			last CMD; };
 		    $cmd =~ /^R$/ && do {
-		        print $OUT "Warning: a lot of settings and command-line options may be lost!\n";
+		        print $OUT "Warning: some settings and command-line options may be lost!\n";
 			my (@script, @flags, $cl);
 			push @flags, '-w' if $ini_warn;
 			# Put all the old includes at the start to get
@@ -638,52 +856,67 @@ sub DB {
 			set_list("PERLDB_HIST", 
 				 $term->Features->{getHistory} 
 				 ? $term->GetHistory : @hist);
-			my @visited = keys %visited;
-			set_list("PERLDB_VISITED", @visited);
+			my @had_breakpoints = keys %had_breakpoints;
+			set_list("PERLDB_VISITED", @had_breakpoints);
 			set_list("PERLDB_OPT", %option);
-			for (0 .. $#visited) {
-			  *dbline = "::_<$visited[$_]";
-			  set_list("PERLDB_FILE_$_", %dbline);
+			set_list("PERLDB_ON_LOAD", %break_on_load);
+			my @hard;
+			for (0 .. $#had_breakpoints) {
+			  my $file = $had_breakpoints[$_];
+			  *dbline = $main::{'_<' . $file};
+			  next unless %dbline or $postponed_file{$file};
+			  (push @hard, $file), next 
+			    if $file =~ /^\(eval \d+\)$/;
+			  my @add;
+			  @add = %{$postponed_file{$file}}
+			    if $postponed_file{$file};
+			  set_list("PERLDB_FILE_$_", %dbline, @add);
 			}
+			for (@hard) { # Yes, really-really...
+			  # Find the subroutines in this eval
+			  *dbline = $main::{'_<' . $_};
+			  my ($quoted, $sub, %subs, $line) = quotemeta $_;
+			  for $sub (keys %sub) {
+			    next unless $sub{$sub} =~ /^$quoted:(\d+)-(\d+)$/;
+			    $subs{$sub} = [$1, $2];
+			  }
+			  unless (%subs) {
+			    print $OUT
+			      "No subroutines in $_, ignoring breakpoints.\n";
+			    next;
+			  }
+			LINES: for $line (keys %dbline) {
+			    # One breakpoint per sub only:
+			    my ($offset, $sub, $found);
+			  SUBS: for $sub (keys %subs) {
+			      if ($subs{$sub}->[1] >= $line # Not after the subroutine
+				  and (not defined $offset # Not caught
+				       or $offset < 0 )) { # or badly caught
+				$found = $sub;
+				$offset = $line - $subs{$sub}->[0];
+				$offset = "+$offset", last SUBS if $offset >= 0;
+			      }
+			    }
+			    if (defined $offset) {
+			      $postponed{$found} =
+				"break $offset if $dbline{$line}";
+			    } else {
+			      print $OUT "Breakpoint in $_:$line ignored: after all the subroutines.\n";
+			    }
+			  }
+			}
+			set_list("PERLDB_POSTPONE", %postponed);
+			set_list("PERLDB_PRETYPE", @$pretype);
+			set_list("PERLDB_PRE", @$pre);
+			set_list("PERLDB_POST", @$post);
+			set_list("PERLDB_TYPEAHEAD", @typeahead);
 			$ENV{PERLDB_RESTART} = 1;
 			#print "$^X, '-d', @flags, @script, ($emacs ? '-emacs' : ()), @ARGS";
 			exec $^X, '-d', @flags, @script, ($emacs ? '-emacs' : ()), @ARGS;
 			print $OUT "exec failed: $!\n";
 			last CMD; };
 		    $cmd =~ /^T$/ && do {
-			local($p,$f,$l,$s,$h,$a,$e,$r,@a,@sub);
-			for ($i = 1; 
-			     ($p,$f,$l,$s,$h,$w,$e,$r) = caller($i); 
-			     $i++) {
-			    @a = ();
-			    for $arg (@args) {
-				$_ = "$arg";
-				s/([\'\\])/\\$1/g;
-				s/([^\0]*)/'$1'/
-				  unless /^(?: -?[\d.]+ | \*[\w:]* )$/x;
-				s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
-				s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
-				push(@a, $_);
-			    }
-			    $w = $w ? '@ = ' : '$ = ';
-			    $a = $h ? '(' . join(', ', @a) . ')' : '';
-			    $e =~ s/\n\s*\;\s*\Z// if $e;
-			    $e =~ s/[\\\']/\\$1/g if $e;
-			    if ($r) {
-			      $s = "require '$e'";
-			    } elsif (defined $r) {
-			      $s = "eval '$e'";
-			    } elsif ($s eq '(eval)') {
-			      $s = "eval {...}";
-			    }
-			    $f = "file `$f'" unless $f eq '-e';
-			    push(@sub, "$w$s$a called from $f line $l\n");
-			    last if $signal;
-			}
-			for ($i=0; $i <= $#sub; $i++) {
-			    last if $signal;
-			    print $OUT $sub[$i];
-			}
+			print_trace($OUT, 1); # skip DB
 			next CMD; };
 		    $cmd =~ /^\/(.*)$/ && do {
 			$inpat = $1;
@@ -697,6 +930,7 @@ sub DB {
 			    $pat = $inpat;
 			}
 			$end = $start;
+			$incr = -1;
 			eval '
 			    for (;;) {
 				++$start;
@@ -725,6 +959,7 @@ sub DB {
 			    $pat = $inpat;
 			}
 			$end = $start;
+			$incr = -1;
 			eval '
 			    for (;;) {
 				--$start;
@@ -747,8 +982,8 @@ sub DB {
 			$cmd = $hist[$i] . "\n";
 			print $OUT $cmd;
 			redo CMD; };
-		    $cmd =~ /^$sh$sh\s*/ && do {
-			&system($');
+		    $cmd =~ /^$sh$sh\s*([\x00-\xff]*)/ && do {
+			&system($1);
 			next CMD; };
 		    $cmd =~ /^$rc([^$rc].*)$/ && do {
 			$pat = "^$1";
@@ -766,8 +1001,8 @@ sub DB {
 		    $cmd =~ /^$sh$/ && do {
 			&system($ENV{SHELL}||"/bin/sh");
 			next CMD; };
-		    $cmd =~ /^$sh\s*/ && do {
-			&system($ENV{SHELL}||"/bin/sh","-c",$');
+		    $cmd =~ /^$sh\s*([\x00-\xff]*)/ && do {
+			&system($ENV{SHELL}||"/bin/sh","-c",$1);
 			next CMD; };
 		    $cmd =~ /^H\b\s*(-(\d+))?/ && do {
 			$end = $2?($#hist-$2):0;
@@ -777,8 +1012,8 @@ sub DB {
 			      unless $hist[$i] =~ /^.?$/;
 			};
 			next CMD; };
-		    $cmd =~ s/^p$/print \$DB::OUT \$_/;
-		    $cmd =~ s/^p\b/print \$DB::OUT /;
+		    $cmd =~ s/^p$/print {\$DB::OUT} \$_/;
+		    $cmd =~ s/^p\b/print {\$DB::OUT} /;
 		    $cmd =~ /^=/ && do {
 			if (local($k,$v) = ($cmd =~ /^=\s*(\S+)\s+(.*)/)) {
 			    $alias{$k}="s~$k~$v~";
@@ -812,7 +1047,7 @@ sub DB {
 			    }
 			    next CMD;
 			}
-			$SIG{PIPE}= "DB::catch" if $pager =~ /^\|/
+			$SIG{PIPE}= \&DB::catch if $pager =~ /^\|/
 			  && "" eq $SIG{PIPE}  ||  "DEFAULT" eq $SIG{PIPE};
 			$selected= select(OUT);
 			$|= 1;
@@ -824,7 +1059,6 @@ sub DB {
 		    $cmd =~ s/^s\s/\$DB::single = 1;\n/ && do {$laststep = 's'};
 		    $cmd =~ s/^n\s/\$DB::single = 2;\n/ && do {$laststep = 'n'};
 		}		# PIPE:
-	    #}			# <-- Do we know what this brace is for?
 	    $evalarg = "\$^D = \$^D | \$DB::db_stop;\n$cmd"; &eval;
 	    if ($onetimeDump) {
 		$onetimeDump = undef;
@@ -841,7 +1075,7 @@ sub DB {
 			  ( $? & 127 ) ? " (SIG ".($?&127).")" : "", "\n" ) if $?;
 		    open(OUT,">&STDOUT") || &warn("Can't restore DB::OUT");
 		    open(STDOUT,">&SAVEOUT") || &warn("Can't restore STDOUT");
-		    $SIG{PIPE}= "DEFAULT" if $SIG{PIPE} eq "DB::catch";
+		    $SIG{PIPE}= "DEFAULT" if $SIG{PIPE} eq \&DB::catch;
 		    # Will stop ignoring SIGPIPE if done like nohup(1)
 		    # does SIGINT but Perl doesn't give us a choice.
 		} else {
@@ -852,8 +1086,9 @@ sub DB {
 		$piped= "";
 	    }
 	}			# CMD:
-	if ($post) {
-	    $evalarg = $post; &eval;
+	$exiting = 1 unless defined $cmd;
+	foreach $evalarg (@$post) {
+	  &eval;
 	}
     }				# if ($single || $signal)
     ($@, $!, $,, $/, $\, $^W) = @saved;
@@ -864,23 +1099,39 @@ sub DB {
 # BEGIN {warn 4}
 
 sub sub {
-    print $LINEINFO ' ' x $#stack, "entering $sub\n" if $frame;
+    my ($al, $ret, @ret) = "";
+    if (length($sub) > 10 && substr($sub, -10, 10) eq '::AUTOLOAD') {
+	$al = " for $$sub";
+    }
     push(@stack, $single);
     $single &= 1;
     $single |= 4 if $#stack == $deep;
+    ($frame & 4 
+     ? ( (print $LINEINFO ' ' x ($#stack - 1), "in  "), 
+	 # Why -1? But it works! :-(
+	 print_trace($LINEINFO, -1, 1, 1, "$sub$al") )
+     : print $LINEINFO ' ' x ($#stack - 1), "entering $sub$al\n") if $frame;
     if (wantarray) {
 	@ret = &$sub;
 	$single |= pop(@stack);
-	$retctx = "list";
-	$lastsub = $sub;
-print $LINEINFO ' ' x $#stack, "exited $sub\n" if $frame;
+	($frame & 4 
+	 ? ( (print $LINEINFO ' ' x $#stack, "out "), 
+	     print_trace($LINEINFO, -1, 1, 1, "$sub$al") )
+	 : print $LINEINFO ' ' x $#stack, "exited $sub$al\n") if $frame & 2;
+	print ($OUT ($frame & 16 ? ' ' x $#stack : ""),
+		    "list context return from $sub:\n"), dumpit( \@ret ),
+	  $doret = -2 if $doret eq $#stack or $frame & 16;
 	@ret;
     } else {
 	$ret = &$sub;
 	$single |= pop(@stack);
-	$retctx = "scalar";
-	$lastsub = $sub;
-print $LINEINFO ' ' x $#stack, "exited $sub\n" if $frame;
+	($frame & 4 
+	 ? ( (print $LINEINFO ' ' x $#stack, "out "), 
+	      print_trace($LINEINFO, -1, 1, 1, "$sub$al") )
+	 : print $LINEINFO ' ' x $#stack, "exited $sub$al\n") if $frame & 2;
+	print ($OUT ($frame & 16 ? ' ' x $#stack : ""),
+		    "scalar context return from $sub: "), dumpit( $ret ),
+	  $doret = -2 if $doret eq $#stack or $frame & 16;
 	$ret;
     }
 }
@@ -905,38 +1156,161 @@ sub eval {
 	$^D = $od;
     }
     my $at = $@;
+    local $saved[0];		# Preserve the old value of $@
     eval "&DB::save";
     if ($at) {
 	print $OUT $at;
-    } elsif ($onetimeDump) {
+    } elsif ($onetimeDump eq 'dump') {
 	dumpit(\@res);
+    } elsif ($onetimeDump eq 'methods') {
+	methods($res[0]);
+    }
+}
+
+sub postponed_sub {
+  my $subname = shift;
+  if ($postponed{$subname} =~ s/^break\s([+-]?\d+)\s+if\s//) {
+    my $offset = $1 || 0;
+    # Filename below can contain ':'
+    my ($file,$i) = (find_sub($subname) =~ /^(.*):(\d+)-.*$/);
+    $i += $offset;
+    if ($i) {
+      local *dbline = $main::{'_<' . $file};
+      local $^W = 0;		# != 0 is magical below
+      $had_breakpoints{$file}++;
+      my $max = $#dbline;
+      ++$i until $dbline[$i] != 0 or $i >= $max;
+      $dbline{$i} = delete $postponed{$subname};
+    } else {
+      print $OUT "Subroutine $subname not found.\n";
     }
+    return;
+  }
+  elsif ($postponed{$subname} eq 'compile') { $signal = 1 }
+  #print $OUT "In postponed_sub for `$subname'.\n";
 }
 
-sub install_breakpoints {
-  my $filename = shift;
-  return unless exists $postponed{$filename};
-  my %break = %{$postponed{$filename}};
-  for (keys %break) {
-    my $i = $_;
-    #if (/\D/) {			# Subroutine name
-    #} 
-    $dbline{$i} = $break{$_};	# Cannot be done before the file is around
+sub postponed {
+  return &postponed_sub
+    unless ref \$_[0] eq 'GLOB'; # A subroutine is compiled.
+  # Cannot be done before the file is compiled
+  local *dbline = shift;
+  my $filename = $dbline;
+  $filename =~ s/^_<//;
+  $signal = 1, print $OUT "'$filename' loaded...\n"
+    if $break_on_load{$filename};
+  print $LINEINFO ' ' x $#stack, "Package $filename.\n" if $frame;
+  return unless $postponed_file{$filename};
+  $had_breakpoints{$filename}++;
+  #%dbline = %{$postponed_file{$filename}}; # Cannot be done: unsufficient magic
+  my $key;
+  for $key (keys %{$postponed_file{$filename}}) {
+    $dbline{$key} = $ {$postponed_file{$filename}}{$key};
   }
+  delete $postponed_file{$filename};
 }
 
 sub dumpit {
     local ($savout) = select($OUT);
-    do 'dumpvar.pl' unless defined &main::dumpValue;
+    my $osingle = $single;
+    my $otrace = $trace;
+    $single = $trace = 0;
+    local $frame = 0;
+    local $doret = -2;
+    unless (defined &main::dumpValue) {
+	do 'dumpvar.pl';
+    }
     if (defined &main::dumpValue) {
-        local $frame = 0;
 	&main::dumpValue(shift);
     } else {
 	print $OUT "dumpvar.pl not available.\n";
     }
+    $single = $osingle;
+    $trace = $otrace;
     select ($savout);    
 }
 
+# Tied method do not create a context, so may get wrong message:
+
+sub print_trace {
+  my $fh = shift;
+  my @sub = dump_trace($_[0] + 1, $_[1]);
+  my $short = $_[2];		# Print short report, next one for sub name
+  my $s;
+  for ($i=0; $i <= $#sub; $i++) {
+    last if $signal;
+    local $" = ', ';
+    my $args = defined $sub[$i]{args} 
+    ? "(@{ $sub[$i]{args} })"
+      : '' ;
+    $args = (substr $args, 0, $maxtrace - 3) . '...' 
+      if length $args > $maxtrace;
+    my $file = $sub[$i]{file};
+    $file = $file eq '-e' ? $file : "file `$file'" unless $short;
+    $s = $sub[$i]{sub};
+    $s = (substr $s, 0, $maxtrace - 3) . '...' if length $s > $maxtrace;    
+    if ($short) {
+      my $sub = @_ >= 4 ? $_[3] : $s;
+      print $fh "$sub[$i]{context}=$sub$args from $file:$sub[$i]{line}\n";
+    } else {
+      print $fh "$sub[$i]{context} = $s$args" .
+	" called from $file" . 
+	  " line $sub[$i]{line}\n";
+    }
+  }
+}
+
+sub dump_trace {
+  my $skip = shift;
+  my $count = shift || 1e9;
+  $skip++;
+  $count += $skip;
+  my ($p,$file,$line,$sub,$h,$args,$e,$r,@a,@sub,$context);
+  my $nothard = not $frame & 8;
+  local $frame = 0;		# Do not want to trace this.
+  my $otrace = $trace;
+  $trace = 0;
+  for ($i = $skip; 
+       $i < $count and ($p,$file,$line,$sub,$h,$context,$e,$r) = caller($i); 
+       $i++) {
+    @a = ();
+    for $arg (@args) {
+      my $type;
+      if (not defined $arg) {
+	push @a, "undef";
+      } elsif ($nothard and tied $arg) {
+	push @a, "tied";
+      } elsif ($nothard and $type = ref $arg) {
+	push @a, "ref($type)";
+      } else {
+	local $_ = "$arg";	# Safe to stringify now - should not call f().
+	s/([\'\\])/\\$1/g;
+	s/(.*)/'$1'/s
+	  unless /^(?: -?[\d.]+ | \*[\w:]* )$/x;
+	s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
+	s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
+	push(@a, $_);
+      }
+    }
+    $context = $context ? '@' : "\$";
+    $args = $h ? [@a] : undef;
+    $e =~ s/\n\s*\;\s*\Z// if $e;
+    $e =~ s/([\\\'])/\\$1/g if $e;
+    if ($r) {
+      $sub = "require '$e'";
+    } elsif (defined $r) {
+      $sub = "eval '$e'";
+    } elsif ($sub eq '(eval)') {
+      $sub = "eval {...}";
+    }
+    push(@sub, {context => $context, sub => $sub, args => $args,
+		file => $file, line => $line});
+    last if $signal;
+  }
+  $trace = $otrace;
+  @sub;
+}
+
 sub action {
     my $action = shift;
     while ($action =~ s/\\$//) {
@@ -972,7 +1346,9 @@ sub system {
 
 sub setterm {
     local $frame = 0;
-    eval "require Term::ReadLine;" or die $@;
+    local $doret = -2;
+    local @stack = @stack;		# Prevent growth by failing `use'.
+    eval { require Term::ReadLine } or die $@;
     if ($notty) {
 	if ($tty) {
 	    open(IN,"<$tty") or die "Cannot open TTY `$TTY' for read: $!";
@@ -995,9 +1371,13 @@ sub setterm {
     } else {
 	$term = new Term::ReadLine 'perldb', $IN, $OUT;
 
-	$readline::rl_basic_word_break_characters .= "[:" 
-	  if defined $readline::rl_basic_word_break_characters 
-	    and index($readline::rl_basic_word_break_characters, ":") == -1;
+	$rl_attribs = $term->Attribs;
+	$rl_attribs->{basic_word_break_characters} .= '-:+/*,[])}' 
+	  if defined $rl_attribs->{basic_word_break_characters} 
+	    and index($rl_attribs->{basic_word_break_characters}, ":") == -1;
+	$rl_attribs->{special_prefixes} = '$@&%';
+	$rl_attribs->{completer_word_break_characters} .= '$@&%';
+	$rl_attribs->{completion_function} = \&db_complete; 
     }
     $LINEINFO = $OUT unless defined $LINEINFO;
     $lineinfo = $console unless defined $lineinfo;
@@ -1005,6 +1385,7 @@ sub setterm {
     if ($term->Features->{setHistory} and "@hist" ne "?") {
       $term->SetHistory(@hist);
     }
+    ornaments($ornaments) if defined $ornaments;
 }
 
 sub readline {
@@ -1017,11 +1398,20 @@ sub readline {
     return $got;
   }
   local $frame = 0;
+  local $doret = -2;
   $term->readline(@_);
 }
 
 sub dump_option {
     my ($opt, $val)= @_;
+    $val = option_val($opt,'N/A');
+    $val =~ s/([\\\'])/\\$1/g;
+    printf $OUT "%20s = '%s'\n", $opt, $val;
+}
+
+sub option_val {
+    my ($opt, $default)= @_;
+    my $val;
     if (defined $optionVars{$opt}
 	and defined $ {$optionVars{$opt}}) {
 	$val = $ {$optionVars{$opt}};
@@ -1032,12 +1422,11 @@ sub dump_option {
 	     and not defined $option{$opt}
 	     or defined $optionVars{$opt}
 	     and not defined $ {$optionVars{$opt}}) {
-	$val = 'N/A';
+	$val = $default;
     } else {
 	$val = $option{$opt};
     }
-    $val =~ s/[\\\']/\\$&/g;
-    printf $OUT "%20s = '%s'\n", $opt, $val;
+    $val
 }
 
 sub parse_options {
@@ -1070,7 +1459,8 @@ sub parse_options {
 	print $OUT "Unknown option `$opt'\n" unless $matches;
 	print $OUT "Ambiguous option `$opt'\n" if $matches > 1;
 	$option{$option} = $val if $matches == 1 and defined $val;
-	eval "local \$frame = 0; require '$optionRequire{$option}'"
+	eval "local \$frame = 0; local \$doret = -2; 
+	      require '$optionRequire{$option}'"
 	  if $matches == 1 and defined $optionRequire{$option} and defined $val;
 	$ {$optionVars{$option}} = $val 
 	  if $matches == 1
@@ -1091,7 +1481,7 @@ sub set_list {
   for $i (0 .. $#list) {
     $val = $list[$i];
     $val =~ s/\\/\\\\/g;
-    $val =~ s/[\0-\37\177\200-\377]/"\\0x" . unpack('H2',$&)/eg;
+    $val =~ s/([\0-\37\177\200-\377])/"\\0x" . unpack('H2',$1)/eg;
     $ENV{"$ {stem}_$i"} = $val;
   }
 }
@@ -1111,6 +1501,7 @@ sub get_list {
 
 sub catch {
     $signal = 1;
+    return;			# Put nothing on the stack - malloc/free land!
 }
 
 sub warn {
@@ -1121,37 +1512,42 @@ sub warn {
 
 sub TTY {
     if ($term) {
-	&warn("Too late to set TTY!\n") if @_;
-    } else {
-	$tty = shift if @_;
-    }
+	&warn("Too late to set TTY, enabled on next `R'!\n") if @_;
+    } 
+    $tty = shift if @_;
     $tty or $console;
 }
 
 sub noTTY {
     if ($term) {
-	&warn("Too late to set noTTY!\n") if @_;
-    } else {
-	$notty = shift if @_;
+	&warn("Too late to set noTTY, enabled on next `R'!\n") if @_;
     }
+    $notty = shift if @_;
     $notty;
 }
 
 sub ReadLine {
     if ($term) {
-	&warn("Too late to set ReadLine!\n") if @_;
-    } else {
-	$rl = shift if @_;
+	&warn("Too late to set ReadLine, enabled on next `R'!\n") if @_;
     }
+    $rl = shift if @_;
     $rl;
 }
 
+sub tkRunning {
+    if ($ {$term->Features}{tkRunning}) {
+        return $term->tkRunning(@_);
+    } else {
+	print $OUT "tkRunning not supported by current ReadLine package.\n";
+	0;
+    }
+}
+
 sub NonStop {
     if ($term) {
-	&warn("Too late to set up NonStop mode!\n") if @_;
-    } else {
-	$runnonstop = shift if @_;
+	&warn("Too late to set up NonStop mode, enabled on next `R'!\n") if @_;
     }
+    $runnonstop = shift if @_;
     $runnonstop;
 }
 
@@ -1175,6 +1571,16 @@ sub shellBang {
     $psh;
 }
 
+sub ornaments {
+  if (defined $term) {
+    local ($warnLevel,$dieLevel) = (0, 1);
+    return '' unless $term->Features->{ornaments};
+    eval { $term->ornaments(@_) } || '';
+  } else {
+    $ornaments = shift;
+  }
+}
+
 sub recallCommand {
     if (@_) {
 	$rc = quotemeta shift;
@@ -1200,6 +1606,29 @@ sub LineInfo {
     $lineinfo;
 }
 
+sub list_versions {
+  my %version;
+  my $file;
+  for (keys %INC) {
+    $file = $_;
+    s,\.p[lm]$,,i ;
+    s,/,::,g ;
+    s/^perl5db$/DB/;
+    s/^Term::ReadLine::readline$/readline/;
+    if (defined $ { $_ . '::VERSION' }) {
+      $version{$file} = "$ { $_ . '::VERSION' } from ";
+    } 
+    $version{$file} .= $INC{$file};
+  }
+  do 'dumpvar.pl' unless defined &main::dumpValue;
+  if (defined &main::dumpValue) {
+    local $frame = 0;
+    &main::dumpValue(\%version);
+  } else {
+    print $OUT "dumpvar.pl not available.\n";
+  }
+}
+
 sub sethelp {
     $help = "
 T		Stack trace.
@@ -1207,8 +1636,8 @@ s [expr]	Single step [in expr].
 n [expr]	Next, steps over subroutine calls [in expr].
 <CR>		Repeat last n or s command.
 r		Return from current subroutine.
-c [line]	Continue; optionally inserts a one-time-only breakpoint
-		at the specified line.
+c [line|sub]	Continue; optionally inserts a one-time-only breakpoint
+		at the specified position.
 l min+incr	List incr+1 lines starting at min.
 l min-max	List lines min through max.
 l line		List single line.
@@ -1217,10 +1646,10 @@ l		List next window of lines.
 -		List previous window of lines.
 w [line]	List window around line.
 .		Return to the executed line.
-f filename	Switch to viewing filename.
+f filename	Switch to viewing filename. Must be loaded.
 /pattern/	Search forwards for pattern; final / is optional.
 ?pattern?	Search backwards for pattern; final ? is optional.
-L		List all breakpoints and actions for the current file.
+L		List all breakpoints and actions.
 S [[!]pattern]	List subroutine names [not] matching pattern.
 t		Toggle trace mode.
 t expr		Trace through execution of expr.
@@ -1229,6 +1658,12 @@ b [line] [condition]
 		condition breaks if it evaluates to true, defaults to '1'.
 b subname [condition]
 		Set breakpoint at first line of subroutine.
+b load filename Set breakpoint on `require'ing the given file.
+b postpone subname [condition]
+		Set breakpoint at first line of subroutine after 
+		it is compiled.
+b compile subname
+		Stop after the subroutine is compiled.
 d [line]	Delete the breakpoint for line.
 D		Delete all breakpoints.
 a [line] command
@@ -1240,11 +1675,17 @@ V [pkg [vars]]	List some (default all) variables in package (default current).
 		Use ~pattern and !pattern for positive and negative regexps.
 X [vars]	Same as \"V currentpackage [vars]\".
 x expr		Evals expression in array context, dumps the result.
+m expr		Evals expression in array context, prints methods callable
+		on the first element of the result.
+m class		Prints methods callable via the given class.
 O [opt[=val]] [opt\"val\"] [opt?]...
 		Set or query values of options.  val defaults to 1.  opt can
 		be abbreviated.  Several options can be listed.
     recallCommand, ShellBang:	chars used to recall command or spawn shell;
     pager:			program for output of \"|cmd\";
+    tkRunning:			run Tk while prompting (with ReadLine);
+    signalLevel warnLevel dieLevel:	level of verbosity;
+    inhibit_exit		Allows stepping off the end of the script.
   The following options affect what happens with V, X, and x commands:
     arrayDepth, hashDepth:	print only first N elements ('' for all);
     compactDump, veryCompact:	change style of array and hash dump;
@@ -1252,15 +1693,20 @@ O [opt[=val]] [opt\"val\"] [opt?]...
     DumpDBFiles:		dump arrays holding debugged files;
     DumpPackages:		dump symbol tables of packages;
     quote, HighBit, undefPrint:	change style of string dump;
-    tkRunning:			run Tk while prompting (with ReadLine);
-    signalLevel warnLevel dieLevel:	level of verbosity;
   Option PrintRet affects printing of return value after r command,
          frame    affects printing messages on entry and exit from subroutines.
+         AutoTrace affects printing messages on every possible breaking point.
+	 maxTraceLen gives maximal length of evals/args listed in stack trace.
+	 ornaments affects screen appearance of the command line.
 		During startup options are initialized from \$ENV{PERLDB_OPTS}.
 		You can put additional initialization options TTY, noTTY,
-		ReadLine, and NonStop there.
-< command	Define command to run before each prompt.
-> command	Define command to run after each prompt.
+		ReadLine, and NonStop there (or use `R' after you set them).
+< command	Define Perl command to run before each prompt.
+<< command	Add to the list of Perl commands to run before each prompt.
+> command	Define Perl command to run after each prompt.
+>> command	Add to the list of Perl commands to run after each prompt.
+\{ commandline	Define debugger command to run before each prompt.
+\{{ commandline	Add to the list of debugger commands to run before each prompt.
 $prc number	Redo a previous command (default previous command).
 $prc -number	Redo number'th-to-last command.
 $prc pattern	Redo last command that started with pattern.
@@ -1270,16 +1716,20 @@ $psh$psh cmd  	Run cmd in a subprocess (reads from DB::IN, writes to DB::OUT)"
 $psh [cmd] 	Run cmd in subshell (forces \"\$SHELL -c 'cmd'\")." ) . "
 		See 'O shellBang' too.
 H -number	Display last number commands (default all).
-p expr		Same as \"print DB::OUT expr\" in current package.
+p expr		Same as \"print {DB::OUT} expr\" in current package.
 |dbcmd		Run debugger command, piping DB::OUT to current pager.
 ||dbcmd		Same as |dbcmd but DB::OUT is temporarilly select()ed as well.
 \= [alias value]	Define a command alias, or list current aliases.
 command		Execute as a perl statement in current package.
-R		Pure-man-restart of debugger, debugger state and command-line
-		options are lost.
+v		Show versions of loaded modules.
+R		Pure-man-restart of debugger, some of debugger state
+		and command-line options may be lost.
+		Currently the following setting are preserved: 
+		history, breakpoints and actions, debugger Options 
+		and the following command-line options: -w, -I, -e.
 h [db_command]	Get help [on a specific debugger command], enter |h to page.
 h h		Summary of debugger commands.
-q or ^D		Quit.
+q or ^D		Quit. Set \$DB::finished to 0 to debug global destruction.
 
 ";
     $summary = <<"END_SUM";
@@ -1288,12 +1738,12 @@ List/search source lines:               Control script execution:
   - or .      List previous/current line  s [expr]    Single step [in expr]
   w [line]    List around line            n [expr]    Next, steps over subs
   f filename  View source in file         <CR>        Repeat last n or s
-  /pattern/   Search forward              r           Return from subroutine
-  ?pattern?   Search backward             c [line]    Continue until line
+  /pattern/ ?patt?   Search forw/backw    r           Return from subroutine
+  v	      Show versions of modules    c [ln|sub]  Continue until position
 Debugger controls:                        L           List break pts & actions
   O [...]     Set debugger options        t [expr]    Toggle trace [trace expr]
-  < command   Command for before prompt   b [ln] [c]  Set breakpoint
-  > command   Command for after prompt    b sub [c]   Set breakpoint for sub
+  <[<] or {[{] [cmd]   Do before prompt   b [ln/event] [c]     Set breakpoint
+  >[>] [cmd]  Do after prompt             b sub [c]   Set breakpoint for sub
   $prc [N|pat]   Redo a previous command     d [line]    Delete a breakpoint
   H [-num]    Display last num commands   D           Delete all breakpoints
   = [a val]   Define/list an alias        a [ln] cmd  Do cmd before line
@@ -1301,31 +1751,40 @@ Debugger controls:                        L           List break pts & actions
   |[|]dbcmd   Send output to pager        $psh\[$psh\] syscmd Run cmd in a subprocess
   q or ^D     Quit			  R	      Attempt a restart
 Data Examination:	      expr     Execute perl code, also see: s,n,t expr
+  x|m expr	Evals expr in array context, dumps the result or lists methods.
+  p expr	Print expression (uses script's current package).
   S [[!]pat]	List subroutine names [not] matching pattern
   V [Pk [Vars]]	List Variables in Package.  Vars can be ~pattern or !pattern.
   X [Vars]	Same as \"V current_package [Vars]\".
-  x expr	Evals expression in array context, dumps the result.
-  p expr	Print expression (uses script's current package).
 END_SUM
-				# '); # Fix balance of Emacs parsing
+				# ')}}; # Fix balance of Emacs parsing
 }
 
 sub diesignal {
     local $frame = 0;
-    $SIG{'ABRT'} = DEFAULT;
+    local $doret = -2;
+    $SIG{'ABRT'} = 'DEFAULT';
     kill 'ABRT', $$ if $panic++;
-    print $DB::OUT "Got $_[0]!\n";	# in the case cannot continue
-    local $SIG{__WARN__} = '';
-    require Carp; 
-    local $Carp::CarpLevel = 2;		# mydie + confess
-    &warn(Carp::longmess("Signal @_"));
+    if (defined &Carp::longmess) {
+	local $SIG{__WARN__} = '';
+	local $Carp::CarpLevel = 2;		# mydie + confess
+	&warn(Carp::longmess("Signal @_"));
+    }
+    else {
+	print $DB::OUT "Got signal @_\n";
+    }
     kill 'ABRT', $$;
 }
 
 sub dbwarn { 
   local $frame = 0;
+  local $doret = -2;
   local $SIG{__WARN__} = '';
-  require Carp; 
+  local $SIG{__DIE__} = '';
+  eval { require Carp };	# If error/warning during compilation,
+                                # require may be broken.
+  warn(@_, "\nPossible unrecoverable error"), warn("\nTry to decrease warnLevel `O'ption!\n"), return
+    unless defined &Carp::longmess;
   #&warn("Entering dbwarn\n");
   my ($mysingle,$mytrace) = ($single,$trace);
   $single = 0; $trace = 0;
@@ -1338,6 +1797,7 @@ sub dbwarn {
 
 sub dbdie {
   local $frame = 0;
+  local $doret = -2;
   local $SIG{__DIE__} = '';
   local $SIG{__WARN__} = '';
   my $i = 0; my $ineval = 0; my $sub;
@@ -1353,7 +1813,9 @@ sub dbdie {
     #&warn("dieing quietly in dbdie\n") if $ineval and $dieLevel < 2;
     die @_ if $ineval and $dieLevel < 2;
   }
-  require Carp; 
+  eval { require Carp };	# If error/warning during compilation,
+                                # require may be broken.
+  die(@_, "\nUnrecoverable error") unless defined &Carp::longmess;
   # We do not want to debug this chunk (automatic disabling works
   # inside DB::DB, but not in Carp).
   my ($mysingle,$mytrace) = ($single,$trace);
@@ -1369,7 +1831,7 @@ sub warnLevel {
     $prevwarn = $SIG{__WARN__} unless $warnLevel;
     $warnLevel = shift;
     if ($warnLevel) {
-      $SIG{__WARN__} = 'DB::dbwarn';
+      $SIG{__WARN__} = \&DB::dbwarn;
     } else {
       $SIG{__WARN__} = $prevwarn;
     }
@@ -1382,10 +1844,11 @@ sub dieLevel {
     $prevdie = $SIG{__DIE__} unless $dieLevel;
     $dieLevel = shift;
     if ($dieLevel) {
-      $SIG{__DIE__} = 'DB::dbdie'; # if $dieLevel < 2;
-      #$SIG{__DIE__} = 'DB::diehard' if $dieLevel >= 2;
+      $SIG{__DIE__} = \&DB::dbdie; # if $dieLevel < 2;
+      #$SIG{__DIE__} = \&DB::diehard if $dieLevel >= 2;
       print $OUT "Stack dump during die enabled", 
-        ( $dieLevel == 1 ? " outside of evals" : ""), ".\n";
+        ( $dieLevel == 1 ? " outside of evals" : ""), ".\n"
+	  if $I_m_init;
       print $OUT "Dump printed too.\n" if $dieLevel > 2;
     } else {
       $SIG{__DIE__} = $prevdie;
@@ -1401,8 +1864,8 @@ sub signalLevel {
     $prevbus = $SIG{BUS} unless $signalLevel;
     $signalLevel = shift;
     if ($signalLevel) {
-      $SIG{SEGV} = 'DB::diesignal';
-      $SIG{BUS} = 'DB::diesignal';
+      $SIG{SEGV} = \&DB::diesignal;
+      $SIG{BUS} = \&DB::diesignal;
     } else {
       $SIG{SEGV} = $prevsegv;
       $SIG{BUS} = $prevbus;
@@ -1411,6 +1874,46 @@ sub signalLevel {
   $signalLevel;
 }
 
+sub find_sub {
+  my $subr = shift;
+  return unless defined &$subr;
+  $sub{$subr} or do {
+    $subr = \&$subr;		# Hard reference
+    my $s;
+    for (keys %sub) {
+      $s = $_, last if $subr eq \&$_;
+    }
+    $sub{$s} if $s;
+  }
+}
+
+sub methods {
+  my $class = shift;
+  $class = ref $class if ref $class;
+  local %seen;
+  local %packs;
+  methods_via($class, '', 1);
+  methods_via('UNIVERSAL', 'UNIVERSAL', 0);
+}
+
+sub methods_via {
+  my $class = shift;
+  return if $packs{$class}++;
+  my $prefix = shift;
+  my $prepend = $prefix ? "via $prefix: " : '';
+  my $name;
+  for $name (grep {defined &{$ {"$ {class}::"}{$_}}} 
+	     sort keys %{"$ {class}::"}) {
+    next if $seen{ $name }++;
+    print $DB::OUT "$prepend$name\n";
+  }
+  return unless shift;		# Recurse?
+  for $name (@{"$ {class}::ISA"}) {
+    $prepend = $prefix ? $prefix . " -> $name" : $name;
+    methods_via($name, $prepend, 1);
+  }
+}
+
 # The following BEGIN is very handy if debugger goes havoc, debugging debugger?
 
 BEGIN {			# This does not compile, alas.
@@ -1423,24 +1926,123 @@ BEGIN {			# This does not compile, alas.
   $window = 10;
   $preview = 3;
   $sub = '';
-  #$SIG{__WARN__} = "DB::dbwarn";
-  #$SIG{__DIE__} = 'DB::dbdie';
-  #$SIG{SEGV} = "DB::diesignal";
-  #$SIG{BUS} = "DB::diesignal";
-  $SIG{INT} = "DB::catch";
-  #$SIG{FPE} = "DB::catch";
-  #warn "SIGFPE installed";
-  $warnLevel = 1 unless defined $warnLevel;
-  $dieLevel = 1 unless defined $dieLevel;
-  $signalLevel = 1 unless defined $signalLevel;
+  $SIG{INT} = \&DB::catch;
+  # This may be enabled to debug debugger:
+  #$warnLevel = 1 unless defined $warnLevel;
+  #$dieLevel = 1 unless defined $dieLevel;
+  #$signalLevel = 1 unless defined $signalLevel;
 
   $db_stop = 0;			# Compiler warning
   $db_stop = 1 << 30;
   $level = 0;			# Level of recursive debugging
+  # @stack and $doret are needed in sub sub, which is called for DB::postponed.
+  # Triggers bug (?) in perl is we postpone this until runtime:
+  @postponed = @stack = (0);
+  $doret = -2;
+  $frame = 0;
 }
 
 BEGIN {$^W = $ini_warn;}	# Switch warnings back
 
 #use Carp;			# This did break, left for debuggin
 
+sub db_complete {
+  # Specific code for b c l V m f O, &blah, $blah, @blah, %blah
+  my($text, $line, $start) = @_;
+  my ($itext, $search, $prefix, $pack) =
+    ($text, "^\Q$ {'package'}::\E([^:]+)\$");
+  
+  return sort grep /^\Q$text/, (keys %sub), qw(postpone load compile), # subroutines
+                               (map { /$search/ ? ($1) : () } keys %sub)
+    if (substr $line, 0, $start) =~ /^\|*[blc]\s+((postpone|compile)\s+)?$/;
+  return sort grep /^\Q$text/, values %INC # files
+    if (substr $line, 0, $start) =~ /^\|*b\s+load\s+$/;
+  return sort map {($_, db_complete($_ . "::", "V ", 2))}
+    grep /^\Q$text/, map { /^(.*)::$/ ? ($1) : ()} keys %:: # top-packages
+      if (substr $line, 0, $start) =~ /^\|*[Vm]\s+$/ and $text =~ /^\w*$/;
+  return sort map {($_, db_complete($_ . "::", "V ", 2))}
+    grep !/^main::/,
+      grep /^\Q$text/, map { /^(.*)::$/ ? ($prefix . "::$1") : ()} keys %{$prefix . '::'}
+				 # packages
+	if (substr $line, 0, $start) =~ /^\|*[Vm]\s+$/ 
+	  and $text =~ /^(.*[^:])::?(\w*)$/  and $prefix = $1;
+  if ( $line =~ /^\|*f\s+(.*)/ ) { # Loaded files
+    # We may want to complete to (eval 9), so $text may be wrong
+    $prefix = length($1) - length($text);
+    $text = $1;
+    return sort 
+	map {substr $_, 2 + $prefix} grep /^_<\Q$text/, (keys %main::), $0
+  }
+  if ((substr $text, 0, 1) eq '&') { # subroutines
+    $text = substr $text, 1;
+    $prefix = "&";
+    return sort map "$prefix$_", 
+               grep /^\Q$text/, 
+                 (keys %sub),
+                 (map { /$search/ ? ($1) : () } 
+		    keys %sub);
+  }
+  if ($text =~ /^[\$@%](.*)::(.*)/) { # symbols in a package
+    $pack = ($1 eq 'main' ? '' : $1) . '::';
+    $prefix = (substr $text, 0, 1) . $1 . '::';
+    $text = $2;
+    my @out 
+      = map "$prefix$_", grep /^\Q$text/, grep /^_?[a-zA-Z]/, keys %$pack ;
+    if (@out == 1 and $out[0] =~ /::$/ and $out[0] ne $itext) {
+      return db_complete($out[0], $line, $start);
+    }
+    return sort @out;
+  }
+  if ($text =~ /^[\$@%]/) { # symbols (in $package + packages in main)
+    $pack = ($package eq 'main' ? '' : $package) . '::';
+    $prefix = substr $text, 0, 1;
+    $text = substr $text, 1;
+    my @out = map "$prefix$_", grep /^\Q$text/, 
+       (grep /^_?[a-zA-Z]/, keys %$pack), 
+       ( $pack eq '::' ? () : (grep /::$/, keys %::) ) ;
+    if (@out == 1 and $out[0] =~ /::$/ and $out[0] ne $itext) {
+      return db_complete($out[0], $line, $start);
+    }
+    return sort @out;
+  }
+  if ((substr $line, 0, $start) =~ /^\|*O\b.*\s$/) { # Options after a space
+    my @out = grep /^\Q$text/, @options;
+    my $val = option_val($out[0], undef);
+    my $out = '? ';
+    if (not defined $val or $val =~ /[\n\r]/) {
+      # Can do nothing better
+    } elsif ($val =~ /\s/) {
+      my $found;
+      foreach $l (split //, qq/\"\'\#\|/) {
+	$out = "$l$val$l ", last if (index $val, $l) == -1;
+      }
+    } else {
+      $out = "=$val ";
+    }
+    # Default to value if one completion, to question if many
+    $rl_attribs->{completer_terminator_character} = (@out == 1 ? $out : '? ');
+    return sort @out;
+  }
+  return $term->filename_list($text); # filenames
+}
+
+sub end_report {
+  print $OUT "Use `q' to quit or `R' to restart.  `h q' for details.\n"
+}
+
+END {
+  $finished = $inhibit_exit;	# So that some keys may be disabled.
+  # Do not stop in at_exit() and destructors on exit:
+  $DB::single = !$exiting && !$runnonstop;
+  DB::fake::at_exit() unless $exiting or $runnonstop;
+}
+
+package DB::fake;
+
+sub at_exit {
+  "Debugged program terminated.  Use `q' to quit or `R' to restart.";
+}
+
+package DB;			# Do not trace this 1; below!
+
 1;
diff --git a/lib/sigtrap.pm b/lib/sigtrap.pm
index e099ac4658..c081123b6b 100644
--- a/lib/sigtrap.pm
+++ b/lib/sigtrap.pm
@@ -2,38 +2,84 @@ package sigtrap;
 
 =head1 NAME
 
-sigtrap - Perl pragma to enable stack backtrace on unexpected signals
-
-=head1 SYNOPSIS
-
-    use sigtrap;
-    use sigtrap qw(BUS SEGV PIPE SYS ABRT TRAP);
-
-=head1 DESCRIPTION
-
-The C<sigtrap> pragma initializes some default signal handlers that print
-a stack dump of your Perl program, then sends itself a SIGABRT.  This
-provides a nice starting point if something horrible goes wrong.
-
-By default, handlers are installed for the ABRT, BUS, EMT, FPE, ILL, PIPE,
-QUIT, SEGV, SYS, TERM, and TRAP signals.
-
-See L<perlmod/Pragmatic Modules>.
+sigtrap - Perl pragma to enable simple signal handling
 
 =cut
 
-require Carp;
+use Carp;
+
+$VERSION = 1.02;
+$Verbose ||= 0;
 
 sub import {
-    my $pack = shift;
-    my @sigs = @_;
-    @sigs or @sigs = qw(QUIT ILL TRAP ABRT EMT FPE BUS SEGV SYS PIPE TERM);
-    foreach $sig (@sigs) {
-	$SIG{$sig} = 'sigtrap::trap';
+    my $pkg = shift;
+    my $handler = \&handler_traceback;
+    my $saw_sig = 0;
+    my $untrapped = 0;
+    local $_;
+
+  Arg_loop:
+    while (@_) {
+	$_ = shift;
+	if (/^[A-Z][A-Z0-9]*$/) {
+	    $saw_sig++;
+	    unless ($untrapped and $SIG{$_} and $SIG{$_} ne 'DEFAULT') {
+		print "Installing handler $handler for $_\n" if $Verbose;
+		$SIG{$_} = $handler;
+	    }
+	}
+	elsif ($_ eq 'normal-signals') {
+	    unshift @_, grep(exists $SIG{$_}, qw(HUP INT PIPE TERM));
+	}
+	elsif ($_ eq 'error-signals') {
+	    unshift @_, grep(exists $SIG{$_},
+			     qw(ABRT BUS EMT FPE ILL QUIT SEGV SYS TRAP));
+	}
+	elsif ($_ eq 'old-interface-signals') {
+	    unshift @_,
+	    grep(exists $SIG{$_},
+		 qw(ABRT BUS EMT FPE ILL PIPE QUIT SEGV SYS TERM TRAP));
+	}
+    	elsif ($_ eq 'stack-trace') {
+	    $handler = \&handler_traceback;
+	}
+	elsif ($_ eq 'die') {
+	    $handler = \&handler_die;
+	}
+	elsif ($_ eq 'handler') {
+	    @_ or croak "No argument specified after 'handler'";
+	    $handler = shift;
+	    unless (ref $handler or $handler eq 'IGNORE'
+			or $handler eq 'DEFAULT') {
+    	    	require Symbol;
+		$handler = Symbol::qualify($handler, (caller)[0]);
+	    }
+	}
+	elsif ($_ eq 'untrapped') {
+	    $untrapped = 1;
+	}
+	elsif ($_ eq 'any') {
+	    $untrapped = 0;
+	}
+	elsif ($_ =~ /^\d/) {
+	    $VERSION >= $_ or croak "sigtrap.pm version $_ required,"
+		    	    	    	. " but this is only version $VERSION";
+	}
+	else {
+	    croak "Unrecognized argument $_";
+	}
+    }
+    unless ($saw_sig) {
+	@_ = qw(old-interface-signals);
+	goto Arg_loop;
     }
 }
 
-sub trap {
+sub handler_die {
+    croak "Caught a SIG$_[0]";
+}
+
+sub handler_traceback {
     package DB;		# To get subroutine args.
     $SIG{'ABRT'} = DEFAULT;
     kill 'ABRT', $$ if $panic++;
@@ -77,3 +123,167 @@ sub trap {
 }
 
 1;
+
+__END__
+
+=head1 SYNOPSIS
+
+    use sigtrap;
+    use sigtrap qw(stack-trace old-interface-signals);	# equivalent
+    use sigtrap qw(BUS SEGV PIPE ABRT);
+    use sigtrap qw(die INT QUIT);
+    use sigtrap qw(die normal-signals);
+    use sigtrap qw(die untrapped normal-signals);
+    use sigtrap qw(die untrapped normal-signals
+		    stack-trace any error-signals);
+    use sigtrap 'handler' => \&my_handler, 'normal-signals';
+    use sigtrap qw(handler my_handler normal-signals
+    	    	    stack-trace error-signals);
+
+=head1 DESCRIPTION
+
+The B<sigtrap> pragma is a simple interface to installing signal
+handlers.  You can have it install one of two handlers supplied by
+B<sigtrap> itself (one which provides a Perl stack trace and one which
+simply C<die()>s), or alternately you can supply your own handler for it
+to install.  It can be told only to install a handler for signals which
+are either untrapped or ignored.  It has a couple of lists of signals to
+trap, plus you can supply your own list of signals.
+
+The arguments passed to the C<use> statement which invokes B<sigtrap>
+are processed in order.  When a signal name or the name of one of
+B<sigtrap>'s signal lists is encountered a handler is immediately
+installed, when an option is encountered it affects subsequently
+installed handlers.
+
+=head1 OPTIONS
+
+=head2 SIGNAL HANDLERS
+
+These options affect which handler will be used for subsequently
+installed signals.
+
+=over 4
+
+=item B<stack-trace>
+
+The handler used for subsequently installed signals outputs a Perl stack
+trace to STDERR and then tries to dump core.  This is the default signal
+handler.
+
+=item B<die>
+
+The handler used for subsequently installed signals calls C<die>
+(actually C<croak>) with a message indicating which signal was caught.
+
+=item B<handler> I<your-handler>
+
+I<your-handler> will be used as the handler for subsequently installed
+signals.  I<your-handler> can be any value which is valid as an
+assignment to an element of C<%SIG>.
+
+=back
+
+=head2 SIGNAL LISTS
+
+B<sigtrap> has a few built-in lists of signals to trap.  They are:
+
+=over 4
+
+=item B<normal-signals>
+
+These are the signals which a program might normally expect to encounter
+and which by default cause it to terminate.  They are HUP, INT, PIPE and
+TERM.
+
+=item B<error-signals>
+
+These signals usually indicate a serious problem with the Perl
+interpreter or with your script.  They are ABRT, BUS, EMT, FPE, ILL,
+QUIT, SEGV, SYS and TRAP.
+
+=item B<old-interface-signals>
+
+These are the signals which were trapped by default by the old
+B<sigtrap> interface, they are ABRT, BUS, EMT, FPE, ILL, PIPE, QUIT,
+SEGV, SYS, TERM, and TRAP.  If no signals or signals lists are passed to
+B<sigtrap>, this list is used.
+
+=back
+
+For each of these three lists, the collection of signals set to be
+trapped is checked before trapping; if your architecture does not
+implement a particular signal, it will not be trapped but rather
+silently ignored.
+
+=head2 OTHER
+
+=over 4
+
+=item B<untrapped>
+
+This token tells B<sigtrap> to install handlers only for subsequently
+listed signals which aren't already trapped or ignored.
+
+=item B<any>
+
+This token tells B<sigtrap> to install handlers for all subsequently
+listed signals.  This is the default behavior.
+
+=item I<signal>
+
+Any argument which looks like a signal name (that is,
+C</^[A-Z][A-Z0-9]*$/>) indicates that B<sigtrap> should install a
+handler for that name.
+
+=item I<number>
+
+Require that at least version I<number> of B<sigtrap> is being used.
+
+=back
+
+=head1 EXAMPLES
+
+Provide a stack trace for the old-interface-signals:
+
+    use sigtrap;
+
+Ditto:
+
+    use sigtrap qw(stack-trace old-interface-signals);
+
+Provide a stack trace on the 4 listed signals only:
+
+    use sigtrap qw(BUS SEGV PIPE ABRT);
+
+Die on INT or QUIT:
+
+    use sigtrap qw(die INT QUIT);
+
+Die on HUP, INT, PIPE or TERM:
+
+    use sigtrap qw(die normal-signals);
+
+Die on HUP, INT, PIPE or TERM, except don't change the behavior for
+signals which are already trapped or ignored:
+
+    use sigtrap qw(die untrapped normal-signals);
+
+Die on receipt one of an of the B<normal-signals> which is currently
+B<untrapped>, provide a stack trace on receipt of B<any> of the
+B<error-signals>:
+
+    use sigtrap qw(die untrapped normal-signals
+		    stack-trace any error-signals);
+
+Install my_handler() as the handler for the B<normal-signals>:
+
+    use sigtrap 'handler', \&my_handler, 'normal-signals';
+
+Install my_handler() as the handler for the normal-signals, provide a
+Perl stack trace on receipt of one of the error-signals:
+
+    use sigtrap qw(handler my_handler normal-signals
+    	    	    stack-trace error-signals);
+
+=cut
diff --git a/lib/splain b/lib/splain
deleted file mode 100755
index f40c51e030..0000000000
--- a/lib/splain
+++ /dev/null
@@ -1,503 +0,0 @@
-#!/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 defined $oldwarn and $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 and $olddie ne \&death_trap;
-    $SIG{__DIE__} = $SIG{__WARN__} = '';
-    local($Carp::CarpLevel) = 1;
-    confess "Uncaught exception from user code:\n\t$exception";
-	# 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/strict.pm b/lib/strict.pm
index 6f6028cad4..8492e933fd 100644
--- a/lib/strict.pm
+++ b/lib/strict.pm
@@ -55,7 +55,7 @@ name without fully qualifying it.
 
 This disables the poetry optimization, generating a compile-time error if
 you try to use a bareword identifier that's not a subroutine, unless it
-appears in curly braces or on the left hand side of the "=>" symbol.
+appears in curly braces or on the left hand side of the "=E<gt>" symbol.
 
 
     use strict 'subs';
@@ -74,10 +74,11 @@ See L<perlmod/Pragmatic Modules>.
 
 sub bits {
     my $bits = 0;
+    my $sememe;
     foreach $sememe (@_) {
-	$bits |= 0x00000002 if $sememe eq 'refs';
-	$bits |= 0x00000200 if $sememe eq 'subs';
-	$bits |= 0x00000400 if $sememe eq 'vars';
+	$bits |= 0x00000002, next if $sememe eq 'refs';
+	$bits |= 0x00000200, next if $sememe eq 'subs';
+	$bits |= 0x00000400, next if $sememe eq 'vars';
     }
     $bits;
 }
diff --git a/lib/subs.pm b/lib/subs.pm
index 84c913a346..512bc9be9a 100644
--- a/lib/subs.pm
+++ b/lib/subs.pm
@@ -15,9 +15,15 @@ This will predeclare all the subroutine whose names are
 in the list, allowing you to use them without parentheses
 even before they're declared.
 
-See L<perlmod/Pragmatic Modules> and L<strict/subs>.
+Unlike pragmas that affect the C<$^H> hints variable, the C<use vars> and
+C<use subs> declarations are not BLOCK-scoped.  They are thus effective
+for the entire file in which they appear.  You may not rescind such
+declarations with C<no vars> or C<no subs>.
+
+See L<perlmod/Pragmatic Modules> and L<strict/strict subs>.
 
 =cut
+
 require 5.000;
 
 sub import {
diff --git a/lib/syslog.pl b/lib/syslog.pl
index 29c3a1cc9a..9e03399e4d 100644
--- a/lib/syslog.pl
+++ b/lib/syslog.pl
@@ -37,7 +37,7 @@ if ($] >= 5) {
 
 require 'syslog.ph';
 
- eval 'use Socket' 			||
+ eval 'use Socket; 1' 			||
      eval { require "socket.ph" } 	||
      require "sys/socket.ph";
 
@@ -140,10 +140,10 @@ sub main'syslog {
 
 sub xlate {
     local($name) = @_;
-    $name =~ y/a-z/A-Z/;
+    $name = uc $name;
     $name = "LOG_$name" unless $name =~ /^LOG_/;
     $name = "syslog'$name";
-    eval(&$name) || -1;
+    defined &$name ? &$name : -1;
 }
 
 sub connect {
diff --git a/lib/termcap.pl b/lib/termcap.pl
index e8f108df06..37313432fd 100644
--- a/lib/termcap.pl
+++ b/lib/termcap.pl
@@ -14,7 +14,7 @@ sub Tgetent {
     local($TERMCAP,$_,$entry,$loop,$field);
 
     warn "Tgetent: no ospeed set" unless $ospeed;
-    foreach $key (keys(TC)) {
+    foreach $key (keys %TC) {
 	delete $TC{$key};
     }
     $TERM = $ENV{'TERM'} unless $TERM;
@@ -63,6 +63,9 @@ sub Tgetent {
 	    $entry = $1;
 	    $_ = $2;
 	    s/\\E/\033/g;
+	    s/\\(200)/pack('c',0)/eg;			# NUL character
+	    s/\\(0\d\d)/pack('c',oct($1))/eg;	# octal
+	    s/\\(0x[0-9A-Fa-f][0-9A-Fa-f])/pack('c',hex($1))/eg;	# hex
 	    s/\\(\d\d\d)/pack('c',$1 & 0177)/eg;
 	    s/\\n/\n/g;
 	    s/\\r/\r/g;
diff --git a/lib/timelocal.pl b/lib/timelocal.pl
index 75f1ac1851..ad322756e3 100644
--- a/lib/timelocal.pl
+++ b/lib/timelocal.pl
@@ -4,106 +4,15 @@
 ;#	$time = timelocal($sec,$min,$hours,$mday,$mon,$year);
 ;#	$time = timegm($sec,$min,$hours,$mday,$mon,$year);
 
-;# These routines are quite efficient and yet are always guaranteed to agree
-;# with localtime() and gmtime().  We manage this by caching the start times
-;# of any months we've seen before.  If we know the start time of the month,
-;# we can always calculate any time within the month.  The start times
-;# themselves are guessed by successive approximation starting at the
-;# current time, since most dates seen in practice are close to the
-;# current date.  Unlike algorithms that do a binary search (calling gmtime
-;# once for each bit of the time value, resulting in 32 calls), this algorithm
-;# calls it at most 6 times, and usually only once or twice.  If you hit
-;# the month cache, of course, it doesn't call it at all.
+;# This file has been superseded by the Time::Local library module.
+;# It is implemented as a call to that module for backwards compatibility
+;# with code written for perl4; new code should use Time::Local directly.
 
-;# timelocal is implemented using the same cache.  We just assume that we're
-;# translating a GMT time, and then fudge it when we're done for the timezone
-;# and daylight savings arguments.  The timezone is determined by examining
-;# the result of localtime(0) when the package is initialized.  The daylight
-;# savings offset is currently assumed to be one hour.
+;# The current implementation shares with the original the questionable
+;# behavior of defining the timelocal() and timegm() functions in the
+;# namespace of whatever package was current when the first instance of
+;# C<require 'timelocal.pl';> was executed in a program.
 
-;# Both routines return -1 if the integer limit is hit. I.e. for dates
-;# after the 1st of January, 2038 on most machines.
+use Time::Local;
 
-CONFIG: {
-    package timelocal;
-    
-    local($[) = 0;
-    @epoch = localtime(0);
-    $tzmin = $epoch[2] * 60 + $epoch[1];	# minutes east of GMT
-    if ($tzmin > 0) {
-	$tzmin = 24 * 60 - $tzmin;		# minutes west of GMT
-	$tzmin -= 24 * 60 if $epoch[5] == 70;	# account for the date line
-    }
-
-    $SEC = 1;
-    $MIN = 60 * $SEC;
-    $HR = 60 * $MIN;
-    $DAYS = 24 * $HR;
-    $YearFix = ((gmtime(946684800))[5] == 100) ? 100 : 0;
-    1;
-}
-
-sub timegm {
-    package timelocal;
-
-    local($[) = 0;
-    $ym = pack(C2, @_[5,4]);
-    $cheat = $cheat{$ym} || &cheat;
-    return -1 if $cheat<0;
-    $cheat + $_[0] * $SEC + $_[1] * $MIN + $_[2] * $HR + ($_[3]-1) * $DAYS;
-}
-
-sub timelocal {
-    package timelocal;
-
-    local($[) = 0;
-    $time = &main'timegm + $tzmin*$MIN;
-    return -1 if $cheat<0;
-    @test = localtime($time);
-    $time -= $HR if $test[2] != $_[2];
-    $time;
-}
-
-package timelocal;
-
-sub cheat {
-    $year = $_[5];
-    $month = $_[4];
-    die "Month out of range 0..11 in timelocal.pl\n" 
-	if $month > 11 || $month < 0;
-    die "Day out of range 1..31 in timelocal.pl\n" 
-	if $_[3] > 31 || $_[3] < 1;
-    die "Hour out of range 0..23 in timelocal.pl\n"
-	if $_[2] > 23 || $_[2] < 0;
-    die "Minute out of range 0..59 in timelocal.pl\n"
-	if $_[1] > 59 || $_[1] < 0;
-    die "Second out of range 0..59 in timelocal.pl\n"
-	if $_[0] > 59 || $_[0] < 0;
-    $guess = $^T;
-    @g = gmtime($guess);
-    $year += $YearFix if $year < $epoch[5];
-    $lastguess = "";
-    while ($diff = $year - $g[5]) {
-	$guess += $diff * (363 * $DAYS);
-	@g = gmtime($guess);
-	if (($thisguess = "@g") eq $lastguess){
-	    return -1; #date beyond this machine's integer limit
-	}
-	$lastguess = $thisguess;
-    }
-    while ($diff = $month - $g[4]) {
-	$guess += $diff * (27 * $DAYS);
-	@g = gmtime($guess);
-	if (($thisguess = "@g") eq $lastguess){
-	    return -1; #date beyond this machine's integer limit
-	}
-	$lastguess = $thisguess;
-    }
-    @gfake = gmtime($guess-1); #still being sceptic
-    if ("@gfake" eq $lastguess){
-	return -1; #date beyond this machine's integer limit
-    }
-    $g[3]--;
-    $guess -= $g[0] * $SEC + $g[1] * $MIN + $g[2] * $HR + $g[3] * $DAYS;
-    $cheat{$ym} = $guess;
-}
+*timelocal::cheat = \&Time::Local::cheat;
diff --git a/lib/validate.pl b/lib/validate.pl
index 21d0505ad4..ec4a04b543 100644
--- a/lib/validate.pl
+++ b/lib/validate.pl
@@ -91,11 +91,11 @@ sub valmess {
 	    $mess =~ s/ does not / should not / ||
 	    $mess =~ s/ not / /;
 	}
-	print stderr $mess,"\n";
+	print STDERR $mess,"\n";
     }
     else {
 	$this =~ s/\$file/'$file'/g;
-	print stderr "Can't do $this.\n";
+	print STDERR "Can't do $this.\n";
     }
     if ($disposition eq 'die') { exit 1; }
     ++$warnings;
diff --git a/lib/vars.pm b/lib/vars.pm
index b9519291c4..e007baa7b9 100644
--- a/lib/vars.pm
+++ b/lib/vars.pm
@@ -14,10 +14,24 @@ This will predeclare all the variables whose names are
 in the list, allowing you to use them under "use strict", and
 disabling any typo warnings.
 
+Unlike pragmas that affect the C<$^H> hints variable, the C<use vars> and
+C<use subs> declarations are not BLOCK-scoped.  They are thus effective
+for the entire file in which they appear.  You may not rescind such
+declarations with C<no vars> or C<no subs>.
+
+Packages such as the B<AutoLoader> and B<SelfLoader> that delay
+loading of subroutines within packages can create problems with
+package lexicals defined using C<my()>. While the B<vars> pragma
+cannot duplicate the effect of package lexicals (total transparency
+outside of the package), it can act as an acceptable substitute by
+pre-declaring global symbols, ensuring their availability to the
+later-loaded routines.
+
 See L<perlmod/Pragmatic Modules>.
 
 =cut
-require 5.000;
+
+require 5.002;
 use Carp;
 
 sub import {