Remove deprecated Perl 4 core libraries
authorFlorian Ragwitz <rafl@debian.org>
Sun, 3 Jul 2011 10:22:37 +0000 (12:22 +0200)
committerFlorian Ragwitz <rafl@debian.org>
Sun, 3 Jul 2011 16:09:39 +0000 (18:09 +0200)
37 files changed:
MANIFEST
META.yml
Porting/Maintainers.pl
cpan/Getopt-Long/t/gol-compat.t [deleted file]
lib/abbrev.pl [deleted file]
lib/assert.pl [deleted file]
lib/bigfloat.pl [deleted file]
lib/bigfloatpl.t [deleted file]
lib/bigint.pl [deleted file]
lib/bigintpl.t [deleted file]
lib/bigrat.pl [deleted file]
lib/cacheout.pl [deleted file]
lib/complete.pl [deleted file]
lib/ctime.pl [deleted file]
lib/dotsh.pl [deleted file]
lib/exceptions.pl [deleted file]
lib/fastcwd.pl [deleted file]
lib/find.pl [deleted file]
lib/finddepth.pl [deleted file]
lib/flush.pl [deleted file]
lib/getcwd.pl [deleted file]
lib/getopt.pl [deleted file]
lib/getopts.pl [deleted file]
lib/hostname.pl [deleted file]
lib/importenv.pl [deleted file]
lib/look.pl [deleted file]
lib/newgetopt.pl [deleted file]
lib/open2.pl [deleted file]
lib/open3.pl [deleted file]
lib/pwd.pl [deleted file]
lib/shellwords.pl [deleted file]
lib/stat.pl [deleted file]
lib/syslog.pl [deleted file]
lib/tainted.pl [deleted file]
lib/termcap.pl [deleted file]
lib/timelocal.pl [deleted file]
lib/validate.pl [deleted file]

index d64ad09..48a3987 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1086,7 +1086,6 @@ cpan/Getopt-Long/CHANGES          Getopt::Long changes
 cpan/Getopt-Long/lib/Getopt/Long.pm    Fetch command options (GetOptions)
 cpan/Getopt-Long/README                        Getopt::Long README
 cpan/Getopt-Long/t/gol-basic.t         See if Getopt::Long works
-cpan/Getopt-Long/t/gol-compat.t                See if Getopt::Long works
 cpan/Getopt-Long/t/gol-linkage.t       See if Getopt::Long works
 cpan/Getopt-Long/t/gol-oo.t            See if Getopt::Long works
 cpan/Getopt-Long/t/gol-xargv.t         See if Getopt::Long works
@@ -3854,23 +3853,15 @@ iperlsys.h                      Perl's interface to the system
 keywords.c                     Perl_keyword(), generated by regen/keywords.pl
 keywords.h                     The keyword numbers
 l1_char_class_tab.h            256 word bit table of character classes (for handy.h)
-lib/abbrev.pl                  An abbreviation table builder
 lib/AnyDBM_File.pm             Perl module to emulate dbmopen
 lib/AnyDBM_File.t              See if AnyDBM_File works
-lib/assert.pl                  assertion and panic with stack trace
 lib/Benchmark.pm               Measure execution time
 lib/Benchmark.t                        See if Benchmark works
-lib/bigfloat.pl                        An arbitrary precision floating point package
-lib/bigfloatpl.t               See if bigfloat.pl works
-lib/bigint.pl                  An arbitrary precision integer arithmetic package
-lib/bigintpl.t                 See if bigint.pl works
-lib/bigrat.pl                  An arbitrary precision rational arithmetic package
 lib/blib.pm                    For "use blib"
 lib/blib.t                     blib.pm test
 lib/bytes_heavy.pl             Support routines for byte pragma
 lib/bytes.pm                   Pragma to enable byte operations
 lib/bytes.t                    bytes.pm test
-lib/cacheout.pl                        Manages output filehandles when you need too many
 lib/Carp/Heavy.pm              Error message workhorse
 lib/Carp.pm                    Error message base class
 lib/Carp.t                     See if Carp works
@@ -3878,12 +3869,10 @@ lib/charnames.pm                Character names
 lib/charnames.t                        See if character names work
 lib/Class/Struct.pm            Declare struct-like datatypes as Perl classes
 lib/Class/Struct.t             See if Class::Struct works
-lib/complete.pl                        A command completion subroutine
 lib/Config/Extensions.pm       Convenient hash lookup for built extensions
 lib/Config/Extensions.t                See if Config::Extensions works
 lib/Config.t                   See if Config works
 lib/CORE.pod                   document the CORE namespace
-lib/ctime.pl                   A ctime workalike
 lib/DBM_Filter/Changes         DBM Filter Change history
 lib/DBM_Filter/compress.pm     DBM Filter to compress keys/values
 lib/DBM_Filter/encode.pm       DBM Filter for encoding
@@ -3906,12 +3895,10 @@ lib/diagnostics.pm              Print verbose diagnostics
 lib/diagnostics.t              See if diagnostics.pm works
 lib/DirHandle.pm               like FileHandle only for directories
 lib/DirHandle.t                        See if DirHandle works
-lib/dotsh.pl                   Code to "dot" in a shell script
 lib/dumpvar.pl                 A variable dumper
 lib/dumpvar.t                  A variable dumper tester
 lib/English.pm                 Readable aliases for short variables
 lib/English.t                  See if English works
-lib/exceptions.pl              catch and throw routines
 lib/Exporter/Heavy.pm          Complicated routines for Exporter
 lib/Exporter.pm                        Exporter base class
 lib/Exporter.t                 See if Exporter works
@@ -3919,7 +3906,6 @@ lib/ExtUtils/Embed.pm             Utilities for embedding Perl in C programs
 lib/ExtUtils/t/Embed.t         See if ExtUtils::Embed and embedding works
 lib/ExtUtils/typemap           Extension interface types
 lib/ExtUtils/XSSymSet.pm       on VMS, manage linker symbols when building extensions
-lib/fastcwd.pl                 a faster but more dangerous getcwd
 lib/feature.pm                 Pragma to enable new syntax
 lib/feature.t                  See if features work
 lib/feature/unicode_strings.t  See if feature "unicode_strings" work
@@ -3942,18 +3928,10 @@ lib/filetest.pm                 For "use filetest"
 lib/filetest.t                 See if filetest works
 lib/FindBin.pm                 Find name of currently executing program
 lib/FindBin.t                  See if FindBin works
-lib/finddepth.pl               A depth-first find emulator--used by find2perl
-lib/find.pl                    A find emulator--used by find2perl
-lib/flush.pl                   Routines to do single flush
-lib/getcwd.pl                  A getcwd() emulator
-lib/getopt.pl                  Perl library supporting option parsing
-lib/getopts.pl                 Perl library supporting option parsing
 lib/Getopt/Std.pm              Fetch command options (getopt, getopts)
 lib/Getopt/Std.t               See if Getopt::Std and Getopt::Long work
 lib/h2ph.t                     See if h2ph works like it should
 lib/h2xs.t                     See if h2xs produces expected lists of files
-lib/hostname.pl                        Old hostname code
-lib/importenv.pl               Perl routine to get environment into variables
 lib/integer.pm                 For "use integer"
 lib/integer.t                  For "use integer" testing
 lib/Internals.t                        For Internals::* testing
@@ -3961,7 +3939,6 @@ lib/less.pm                       For "use less"
 lib/less.t                     See if less support works
 lib/locale.pm                  For "use locale"
 lib/locale.t                   See if locale support works
-lib/look.pl                    A "look" equivalent
 lib/Net/hostent.pm             By-name interface to Perl's builtin gethost*
 lib/Net/hostent.t              See if Net::hostent works
 lib/Net/netent.pm              By-name interface to Perl's builtin getnet*
@@ -3970,9 +3947,6 @@ lib/Net/protoent.pm               By-name interface to Perl's builtin getproto*
 lib/Net/protoent.t             See if Net::protoent works
 lib/Net/servent.pm             By-name interface to Perl's builtin getserv*
 lib/Net/servent.t              See if Net::servtent works
-lib/newgetopt.pl               A perl library supporting long option parsing
-lib/open2.pl                   Open a two-ended pipe (uses IPC::Open2)
-lib/open3.pl                   Open a three-ended pipe (uses IPC::Open3)
 lib/open.pm                    Pragma to specify default I/O layers
 lib/open.t                     See if the open pragma works
 lib/overload64.t               See if operator overloading works with 64-bit ints
@@ -4001,26 +3975,20 @@ lib/Pod/t/InputObjects.t        See if Pod::InputObjects works
 lib/Pod/t/Select.t             See if Pod::Select works
 lib/Pod/t/Usage.t              See if Pod::Usage works
 lib/Pod/t/utils.t              Test for Pod::ParseUtils
-lib/pwd.pl                     Routines to keep track of PWD environment variable
 lib/Search/Dict.pm             Perform binary search on dictionaries
 lib/Search/Dict.t              See if Search::Dict works
 lib/SelectSaver.pm             Enforce proper select scoping
 lib/SelectSaver.t              See if SelectSaver works
-lib/shellwords.pl              Perl library to split into words with shell quoting
 lib/sigtrap.pm                 For trapping an abort and giving traceback
 lib/sigtrap.t                  See if sigtrap works
 lib/sort.pm                    For "use sort"
 lib/sort.t                     See if "use sort" works
-lib/stat.pl                    Perl library supporting stat function
 lib/strict.pm                  For "use strict"
 lib/strict.t                   See if strictures work
 lib/subs.pm                    Declare overriding subs
 lib/subs.t                     See if subroutine pseudo-importation works
 lib/Symbol.pm                  Symbol table manipulation routines
 lib/Symbol.t                   See if Symbol works
-lib/syslog.pl                  Perl library supporting syslogging
-lib/tainted.pl                 Old code for tainting
-lib/termcap.pl                 Perl library supporting termcap usage
 lib/Term/Complete.pm           A command completion subroutine
 lib/Term/Complete.t            See if Term::Complete works
 lib/Term/ReadLine.pm           Stub readline library
@@ -4045,7 +4013,6 @@ lib/Tie/SubstrHash.pm             Compact hash for known key, value and table size
 lib/Tie/SubstrHash.t           Test for Tie::SubstrHash
 lib/Time/gmtime.pm             By-name interface to Perl's builtin gmtime
 lib/Time/gmtime.t              Test for Time::gmtime
-lib/timelocal.pl               Perl library supporting inverse of localtime, gmtime
 lib/Time/localtime.pm          By-name interface to Perl's builtin localtime
 lib/Time/localtime.t           Test for Time::localtime
 lib/Time/tm.pm                 Internal object for Time::{gm,local}time
@@ -4110,7 +4077,6 @@ lib/User/pwent.t          See if User::pwent works
 lib/utf8_heavy.pl              Support routines for utf8 pragma
 lib/utf8.pm                    Pragma to control Unicode support
 lib/utf8.t                     See if utf8 operations work
-lib/validate.pl                        Perl library supporting wholesale file mode validation
 lib/vars_carp.t                        See if "use vars" doesn't load Carp.pm per default
 lib/vars.pm                    Declare pseudo-imported global variables
 lib/vars.t                     See if "use vars" works
index 4c999d3..52cd85f 100644 (file)
--- a/META.yml
+++ b/META.yml
@@ -97,7 +97,6 @@ no_index:
     - lib/Exporter.pm
     - lib/Exporter.t
     - lib/Exporter/Heavy.pm
-    - lib/newgetopt.pl
     - lib/unicore/mktables
     - lib/version.pm
     - lib/version.pod
index d3f3d79..8265910 100755 (executable)
@@ -943,17 +943,12 @@ use File::Glob qw(:case);
        {
        'MAINTAINER'    => 'jv',
        'DISTRIBUTION'  => 'JV/Getopt-Long-2.38.tar.gz',
-       'FILES'         => q[cpan/Getopt-Long
-                            lib/newgetopt.pl
-                           ],
+       'FILES'         => q[cpan/Getopt-Long],
        'EXCLUDED'      => [ qr{^examples/},
-                            qw{perl-Getopt-Long.spec},
+                            qw{perl-Getopt-Long.spec lib/newgetopt.pl},
                           ],
-       'MAP'           => { ''                => 'cpan/Getopt-Long/',
-                            'lib/newgetopt.pl' => 'lib/newgetopt.pl',
-                          },
+       'MAP'           => { '' => 'cpan/Getopt-Long/' },
        'UPSTREAM'      => 'cpan',
-       'CUSTOMIZED'    => [ qw( lib/newgetopt.pl t/gol-compat.t)],
        },
 
     'Getopt::Std' =>
diff --git a/cpan/Getopt-Long/t/gol-compat.t b/cpan/Getopt-Long/t/gol-compat.t
deleted file mode 100644 (file)
index 610474f..0000000
+++ /dev/null
@@ -1,39 +0,0 @@
-#!./perl -w
-
-no strict;
-
-BEGIN {
-    if ($ENV{PERL_CORE}) {
-       @INC = '../lib';
-       chdir 't';
-    }
-}
-
-{
-    # Silence the deprecation warnings from newgetopt.pl for the purpose
-    # of testing. These tests will be removed along with newgetopt.pl in
-    # the next major release of perl.
-    local $SIG{__WARN__} = sub {
-        if ($_[0] !~ /will be removed from the Perl core distribution/) {
-            print(STDERR @_);
-        }
-    };
-    require "newgetopt.pl";
-}
-
-print "1..9\n";
-
-@ARGV = qw(-Foo -baR --foo bar);
-$newgetopt::ignorecase = 0;
-$newgetopt::ignorecase = 0;
-undef $opt_baR;
-undef $opt_bar;
-print "ok 1\n" if NGetOpt ("foo", "Foo=s");
-print ((defined $opt_foo)   ? "" : "not ", "ok 2\n");
-print (($opt_foo == 1)      ? "" : "not ", "ok 3\n");
-print ((defined $opt_Foo)   ? "" : "not ", "ok 4\n");
-print (($opt_Foo eq "-baR") ? "" : "not ", "ok 5\n");
-print ((@ARGV == 1)         ? "" : "not ", "ok 6\n");
-print (($ARGV[0] eq "bar")  ? "" : "not ", "ok 7\n");
-print (!(defined $opt_baR)  ? "" : "not ", "ok 8\n");
-print (!(defined $opt_bar)  ? "" : "not ", "ok 9\n");
diff --git a/lib/abbrev.pl b/lib/abbrev.pl
deleted file mode 100644 (file)
index d46321f..0000000
+++ /dev/null
@@ -1,46 +0,0 @@
-warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
-
-;# Usage:
-;#     %foo = ();
-;#     &abbrev(*foo,LIST);
-;#     ...
-;#     $long = $foo{$short};
-
-#
-# This library is no longer being maintained, and is included for backward
-# compatibility with Perl 4 programs which may require it.
-# This legacy library is deprecated and will be removed in a future
-# release of perl.
-#
-# In particular, this should not be used as an example of modern Perl
-# programming techniques.
-#
-# Suggested alternative: Text::Abbrev
-#
-
-package abbrev;
-
-sub main'abbrev {
-    local(*domain) = @_;
-    shift(@_);
-    @cmp = @_;
-    foreach $name (@_) {
-       @extra = split(//,$name);
-       $abbrev = shift(@extra);
-       $len = 1;
-       foreach $cmp (@cmp) {
-           next if $cmp eq $name;
-           while (@extra && substr($cmp,0,$len) eq $abbrev) {
-               $abbrev .= shift(@extra);
-               ++$len;
-           }
-       }
-       $domain{$abbrev} = $name;
-       while ($#extra >= 0) {
-           $abbrev .= shift(@extra);
-           $domain{$abbrev} = $name;
-       }
-    }
-}
-
-1;
diff --git a/lib/assert.pl b/lib/assert.pl
deleted file mode 100644 (file)
index d47e006..0000000
+++ /dev/null
@@ -1,63 +0,0 @@
-warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
-
-#
-# This library is no longer being maintained, and is included for backward
-# compatibility with Perl 4 programs which may require it.
-# This legacy library is deprecated and will be removed in a future
-# release of perl.
-#
-# assert.pl
-# tchrist@convex.com (Tom Christiansen)
-# 
-# Usage:
-# 
-#     &assert('@x > @y');
-#     &assert('$var > 10', $var, $othervar, @various_info);
-# 
-# That is, if the first expression evals false, we blow up.  The
-# rest of the args, if any, are nice to know because they will
-# be printed out by &panic, which is just the stack-backtrace
-# routine shamelessly borrowed from the perl debugger.
-
-sub assert {
-    &panic("ASSERTION BOTCHED: $_[0]",$@) unless eval $_[0];
-} 
-
-sub panic {
-    package DB;
-
-    select(STDERR);
-
-    print "\npanic: @_\n";
-
-    exit 1 if $] <= 4.003;  # caller broken
-
-    # stack traceback gratefully borrowed from perl debugger
-
-    local $_;
-    my $i;
-    my ($p,$f,$l,$s,$h,$a,@a,@frames);
-    for ($i = 0; ($p,$f,$l,$s,$h,$w) = caller($i); $i++) {
-       @a = @args;
-       for (@a) {
-           if (/^StB\000/ && length($_) == length($_main{'_main'})) {
-               $_ = sprintf("%s",$_);
-           }
-           else {
-               s/'/\\'/g;
-               s/([^\0]*)/'$1'/ unless /^-?[\d.]+$/;
-               s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
-               s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
-           }
-       }
-       $w = $w ? '@ = ' : '$ = ';
-       $a = $h ? '(' . join(', ', @a) . ')' : '';
-       push(@frames, "$w&$s$a from file $f line $l\n");
-    }
-    for ($i=0; $i <= $#frames; $i++) {
-       print $frames[$i];
-    }
-    exit 1;
-} 
-
-1;
diff --git a/lib/bigfloat.pl b/lib/bigfloat.pl
deleted file mode 100644 (file)
index 82d0f5c..0000000
+++ /dev/null
@@ -1,258 +0,0 @@
-warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
-
-package bigfloat;
-require "bigint.pl";
-#
-# This library is no longer being maintained, and is included for backward
-# compatibility with Perl 4 programs which may require it.
-# This legacy library is deprecated and will be removed in a future
-# release of perl.
-#
-# In particular, this should not be used as an example of modern Perl
-# programming techniques.
-#
-# Suggested alternative: Math::BigFloat
-
-# Arbitrary length float math package
-#
-# by Mark Biggar
-#
-# number format
-#   canonical strings have the form /[+-]\d+E[+-]\d+/
-#   Input values can have embedded whitespace
-# Error returns
-#   'NaN'           An input parameter was "Not a Number" or 
-#                       divide by zero or sqrt of negative number
-# Division is computed to 
-#   max($div_scale,length(dividend)+length(divisor)) 
-#   digits by default.
-# Also used for default sqrt scale
-
-$div_scale = 40;
-
-# Rounding modes one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'.
-
-$rnd_mode = 'even';
-
-#   bigfloat routines
-#
-#   fadd(NSTR, NSTR) return NSTR            addition
-#   fsub(NSTR, NSTR) return NSTR            subtraction
-#   fmul(NSTR, NSTR) return NSTR            multiplication
-#   fdiv(NSTR, NSTR[,SCALE]) returns NSTR   division to SCALE places
-#   fneg(NSTR) return NSTR                  negation
-#   fabs(NSTR) return NSTR                  absolute value
-#   fcmp(NSTR,NSTR) return CODE             compare undef,<0,=0,>0
-#   fround(NSTR, SCALE) return NSTR         round to SCALE digits
-#   ffround(NSTR, SCALE) return NSTR        round at SCALEth place
-#   fnorm(NSTR) return (NSTR)               normalize
-#   fsqrt(NSTR[, SCALE]) return NSTR        sqrt to SCALE places
-\f
-# Convert a number to canonical string form.
-#   Takes something that looks like a number and converts it to
-#   the form /^[+-]\d+E[+-]\d+$/.
-sub main'fnorm { #(string) return fnum_str
-    local($_) = @_;
-    s/\s+//g;                               # strip white space
-    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';
-    }
-}
-
-# normalize number -- for internal use
-sub norm { #(mantissa, exponent) return fnum_str
-    local($_, $exp) = @_;
-    if ($_ eq 'NaN') {
-       'NaN';
-    } else {
-       s/^([+-])0+/$1/;                        # strip leading zeros
-       if (length($_) == 1) {
-           '+0E+0';
-       } else {
-           $exp += length($1) if (s/(0+)$//);  # strip trailing zeros
-           sprintf("%sE%+ld", $_, $exp);
-       }
-    }
-}
-
-# negation
-sub main'fneg { #(fnum_str) return fnum_str
-    local($_) = &'fnorm($_[0]);
-    vec($_,0,8) ^= ord('+') ^ ord('-') unless $_ eq '+0E+0'; # flip sign
-    if ( ord("\t") == 9 ) { # ascii
-        s/^H/N/;
-    }
-    else { # ebcdic character set
-        s/\373/N/;
-    }
-    $_;
-}
-
-# absolute value
-sub main'fabs { #(fnum_str) return fnum_str
-    local($_) = &'fnorm($_[0]);
-    s/^-/+/;                                  # mash sign
-    $_;
-}
-
-# multiplication
-sub main'fmul { #(fnum_str, fnum_str) return fnum_str
-    local($x,$y) = (&'fnorm($_[0]),&'fnorm($_[1]));
-    if ($x eq 'NaN' || $y eq 'NaN') {
-       'NaN';
-    } else {
-       local($xm,$xe) = split('E',$x);
-       local($ym,$ye) = split('E',$y);
-       &norm(&'bmul($xm,$ym),$xe+$ye);
-    }
-}
-\f
-# addition
-sub main'fadd { #(fnum_str, fnum_str) return fnum_str
-    local($x,$y) = (&'fnorm($_[0]),&'fnorm($_[1]));
-    if ($x eq 'NaN' || $y eq 'NaN') {
-       'NaN';
-    } else {
-       local($xm,$xe) = split('E',$x);
-       local($ym,$ye) = split('E',$y);
-       ($xm,$xe,$ym,$ye) = ($ym,$ye,$xm,$xe) if ($xe < $ye);
-       &norm(&'badd($ym,$xm.('0' x ($xe-$ye))),$ye);
-    }
-}
-
-# subtraction
-sub main'fsub { #(fnum_str, fnum_str) return fnum_str
-    &'fadd($_[0],&'fneg($_[1]));    
-}
-
-# division
-#   args are dividend, divisor, scale (optional)
-#   result has at most max(scale, length(dividend), length(divisor)) digits
-sub main'fdiv #(fnum_str, fnum_str[,scale]) return fnum_str
-{
-    local($x,$y,$scale) = (&'fnorm($_[0]),&'fnorm($_[1]),$_[2]);
-    if ($x eq 'NaN' || $y eq 'NaN' || $y eq '+0E+0') {
-       'NaN';
-    } else {
-       local($xm,$xe) = split('E',$x);
-       local($ym,$ye) = split('E',$y);
-       $scale = $div_scale if (!$scale);
-       $scale = length($xm)-1 if (length($xm)-1 > $scale);
-       $scale = length($ym)-1 if (length($ym)-1 > $scale);
-       $scale = $scale + length($ym) - length($xm);
-       &norm(&round(&'bdiv($xm.('0' x $scale),$ym),&'babs($ym)),
-           $xe-$ye-$scale);
-    }
-}
-\f
-# round int $q based on fraction $r/$base using $rnd_mode
-sub round { #(int_str, int_str, int_str) return int_str
-    local($q,$r,$base) = @_;
-    if ($q eq 'NaN' || $r eq 'NaN') {
-       'NaN';
-    } elsif ($rnd_mode eq 'trunc') {
-       $q;                         # just truncate
-    } else {
-       local($cmp) = &'bcmp(&'bmul($r,'+2'),$base);
-       if ( $cmp < 0 ||
-                ($cmp == 0 &&
-                 ( $rnd_mode eq 'zero'                             ||
-                  ($rnd_mode eq '-inf' && (substr($q,0,1) eq '+')) ||
-                  ($rnd_mode eq '+inf' && (substr($q,0,1) eq '-')) ||
-                  ($rnd_mode eq 'even' && $q =~ /[24680]$/)        ||
-                  ($rnd_mode eq 'odd'  && $q =~ /[13579]$/)        )) ) {
-           $q;                     # round down
-       } else {
-           &'badd($q, ((substr($q,0,1) eq '-') ? '-1' : '+1'));
-                                   # round up
-       }
-    }
-}
-
-# round the mantissa of $x to $scale digits
-sub main'fround { #(fnum_str, scale) return fnum_str
-    local($x,$scale) = (&'fnorm($_[0]),$_[1]);
-    if ($x eq 'NaN' || $scale <= 0) {
-       $x;
-    } else {
-       local($xm,$xe) = split('E',$x);
-       if (length($xm)-1 <= $scale) {
-           $x;
-       } else {
-           &norm(&round(substr($xm,0,$scale+1),
-                        "+0".substr($xm,$scale+1,1),"+10"),
-                 $xe+length($xm)-$scale-1);
-       }
-    }
-}
-\f
-# round $x at the 10 to the $scale digit place
-sub main'ffround { #(fnum_str, scale) return fnum_str
-    local($x,$scale) = (&'fnorm($_[0]),$_[1]);
-    if ($x eq 'NaN') {
-       'NaN';
-    } else {
-       local($xm,$xe) = split('E',$x);
-       if ($xe >= $scale) {
-           $x;
-       } else {
-           $xe = length($xm)+$xe-$scale;
-           if ($xe < 1) {
-               '+0E+0';
-           } elsif ($xe == 1) {
-               # The first substr preserves the sign, which means that
-               # we'll pass a non-normalized "-0" to &round when rounding
-               # -0.006 (for example), purely so that &round won't lose
-               # the sign.
-               &norm(&round(substr($xm,0,1).'0',
-                     "+0".substr($xm,1,1),"+10"), $scale);
-           } else {
-               &norm(&round(substr($xm,0,$xe),
-                     "+0".substr($xm,$xe,1),"+10"), $scale);
-           }
-       }
-    }
-}
-    
-# compare 2 values returns one of undef, <0, =0, >0
-#   returns undef if either or both input value are not numbers
-sub main'fcmp #(fnum_str, fnum_str) return cond_code
-{
-    local($x, $y) = (&'fnorm($_[0]),&'fnorm($_[1]));
-    if ($x eq "NaN" || $y eq "NaN") {
-       undef;
-    } else {
-       ord($y) <=> ord($x)
-       ||
-       (  local($xm,$xe,$ym,$ye) = split('E', $x."E$y"),
-            (($xe <=> $ye) * (substr($x,0,1).'1')
-             || &bigint'cmp($xm,$ym))
-       );
-    }
-}
-\f
-# square root by Newtons method.
-sub main'fsqrt { #(fnum_str[, scale]) return fnum_str
-    local($x, $scale) = (&'fnorm($_[0]), $_[1]);
-    if ($x eq 'NaN' || $x =~ /^-/) {
-       'NaN';
-    } elsif ($x eq '+0E+0') {
-       '+0E+0';
-    } else {
-       local($xm, $xe) = split('E',$x);
-       $scale = $div_scale if (!$scale);
-       $scale = length($xm)-1 if ($scale < length($xm)-1);
-       local($gs, $guess) = (1, sprintf("1E%+d", (length($xm)+$xe-1)/2));
-       while ($gs < 2*$scale) {
-           $guess = &'fmul(&'fadd($guess,&'fdiv($x,$guess,$gs*2)),".5");
-           $gs *= 2;
-       }
-       &'fround($guess, $scale);
-    }
-}
-
-1;
diff --git a/lib/bigfloatpl.t b/lib/bigfloatpl.t
deleted file mode 100644 (file)
index 0a26598..0000000
+++ /dev/null
@@ -1,422 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-{
-    # Silence the deprecation warnings from bigfloat.pl for the purpose
-    # of testing. These tests will be removed along with bigfloat.pl in
-    # the next major release of perl.
-    local $SIG{__WARN__} = sub {
-        if ($_[0] !~ /will be removed from the Perl core distribution/) {
-            print(STDERR @_);
-        }
-    };
-    require "bigfloat.pl";
-}
-
-$test = 0;
-$| = 1;
-print "1..355\n";
-while (<DATA>) {
-       chop;
-       if (/^&/) {
-               $f = $_;
-       } elsif (/^\$.*/) {
-               eval "$_;";
-       } else {
-               ++$test;
-               @args = split(/:/,$_,99);
-               $ans = pop(@args);
-               $try = "$f('" . join("','", @args) . "');";
-               if (($ans1 = eval($try)) eq $ans) {
-                       print "ok $test\n";
-               } else {
-                       print "not ok $test\n";
-                       print "# '$try' expected: '$ans' got: '$ans1'\n";
-               }
-       }
-} 
-__END__
-&fnorm
-abc:NaN
-   1 a:NaN
-1bcd2:NaN
-11111b:NaN
-+1z:NaN
--1z:NaN
-0:+0E+0
-+0:+0E+0
-+00:+0E+0
-+0 0 0:+0E+0
-000000  0000000   00000:+0E+0
--0:+0E+0
--0000:+0E+0
-+1:+1E+0
-+01:+1E+0
-+001:+1E+0
-+00000100000:+1E+5
-123456789:+123456789E+0
--1:-1E+0
--01:-1E+0
--001:-1E+0
--123456789:-123456789E+0
--00000100000:-1E+5
-123.456a:NaN
-123.456:+123456E-3
-0.01:+1E-2
-.002:+2E-3
--0.0003:-3E-4
--.0000000004:-4E-10
-123456E2:+123456E+2
-123456E-2:+123456E-2
--123456E2:-123456E+2
--123456E-2:-123456E-2
-1e1:+1E+1
-2e-11:+2E-11
--3e111:-3E+111
--4e-1111:-4E-1111
-&fneg
-abd:NaN
-+0:+0E+0
-+1:-1E+0
--1:+1E+0
-+123456789:-123456789E+0
--123456789:+123456789E+0
-+123.456789:-123456789E-6
--123456.789:+123456789E-3
-&fabs
-abc:NaN
-+0:+0E+0
-+1:+1E+0
--1:+1E+0
-+123456789:+123456789E+0
--123456789:+123456789E+0
-+123.456789:+123456789E-6
--123456.789:+123456789E-3
-&fround
-$bigfloat::rnd_mode = 'trunc'
-+10123456789:5:+10123E+6
--10123456789:5:-10123E+6
-+10123456789:9:+101234567E+2
--10123456789:9:-101234567E+2
-+101234500:6:+101234E+3
--101234500:6:-101234E+3
-$bigfloat::rnd_mode = 'zero'
-+20123456789:5:+20123E+6
--20123456789:5:-20123E+6
-+20123456789:9:+201234568E+2
--20123456789:9:-201234568E+2
-+201234500:6:+201234E+3
--201234500:6:-201234E+3
-$bigfloat::rnd_mode = '+inf'
-+30123456789:5:+30123E+6
--30123456789:5:-30123E+6
-+30123456789:9:+301234568E+2
--30123456789:9:-301234568E+2
-+301234500:6:+301235E+3
--301234500:6:-301234E+3
-$bigfloat::rnd_mode = '-inf'
-+40123456789:5:+40123E+6
--40123456789:5:-40123E+6
-+40123456789:9:+401234568E+2
--40123456789:9:-401234568E+2
-+401234500:6:+401234E+3
--401234500:6:-401235E+3
-$bigfloat::rnd_mode = 'odd'
-+50123456789:5:+50123E+6
--50123456789:5:-50123E+6
-+50123456789:9:+501234568E+2
--50123456789:9:-501234568E+2
-+501234500:6:+501235E+3
--501234500:6:-501235E+3
-$bigfloat::rnd_mode = 'even'
-+60123456789:5:+60123E+6
--60123456789:5:-60123E+6
-+60123456789:9:+601234568E+2
--60123456789:9:-601234568E+2
-+601234500:6:+601234E+3
--601234500:6:-601234E+3
-&ffround
-$bigfloat::rnd_mode = 'trunc'
-+1.23:-1:+12E-1
--1.23:-1:-12E-1
-+1.27:-1:+12E-1
--1.27:-1:-12E-1
-+1.25:-1:+12E-1
--1.25:-1:-12E-1
-+1.35:-1:+13E-1
--1.35:-1:-13E-1
--0.006:-1:+0E+0
--0.006:-2:+0E+0
-$bigfloat::rnd_mode = 'zero'
-+2.23:-1:+22E-1
--2.23:-1:-22E-1
-+2.27:-1:+23E-1
--2.27:-1:-23E-1
-+2.25:-1:+22E-1
--2.25:-1:-22E-1
-+2.35:-1:+23E-1
--2.35:-1:-23E-1
--0.0065:-1:+0E+0
--0.0065:-2:-1E-2
--0.0065:-3:-6E-3
--0.0065:-4:-65E-4
--0.0065:-5:-65E-4
-$bigfloat::rnd_mode = '+inf'
-+3.23:-1:+32E-1
--3.23:-1:-32E-1
-+3.27:-1:+33E-1
--3.27:-1:-33E-1
-+3.25:-1:+33E-1
--3.25:-1:-32E-1
-+3.35:-1:+34E-1
--3.35:-1:-33E-1
--0.0065:-1:+0E+0
--0.0065:-2:-1E-2
--0.0065:-3:-6E-3
--0.0065:-4:-65E-4
--0.0065:-5:-65E-4
-$bigfloat::rnd_mode = '-inf'
-+4.23:-1:+42E-1
--4.23:-1:-42E-1
-+4.27:-1:+43E-1
--4.27:-1:-43E-1
-+4.25:-1:+42E-1
--4.25:-1:-43E-1
-+4.35:-1:+43E-1
--4.35:-1:-44E-1
--0.0065:-1:+0E+0
--0.0065:-2:-1E-2
--0.0065:-3:-7E-3
--0.0065:-4:-65E-4
--0.0065:-5:-65E-4
-$bigfloat::rnd_mode = 'odd'
-+5.23:-1:+52E-1
--5.23:-1:-52E-1
-+5.27:-1:+53E-1
--5.27:-1:-53E-1
-+5.25:-1:+53E-1
--5.25:-1:-53E-1
-+5.35:-1:+53E-1
--5.35:-1:-53E-1
--0.0065:-1:+0E+0
--0.0065:-2:-1E-2
--0.0065:-3:-7E-3
--0.0065:-4:-65E-4
--0.0065:-5:-65E-4
-$bigfloat::rnd_mode = 'even'
-+6.23:-1:+62E-1
--6.23:-1:-62E-1
-+6.27:-1:+63E-1
--6.27:-1:-63E-1
-+6.25:-1:+62E-1
--6.25:-1:-62E-1
-+6.35:-1:+64E-1
--6.35:-1:-64E-1
--0.0065:-1:+0E+0
--0.0065:-2:-1E-2
--0.0065:-3:-6E-3
--0.0065:-4:-65E-4
--0.0065:-5:-65E-4
-&fcmp
-abc:abc:
-abc:+0:
-+0:abc:
-+0:+0:0
--1:+0:-1
-+0:-1:1
-+1:+0:1
-+0:+1:-1
--1:+1:-1
-+1:-1:1
--1:-1:0
-+1:+1:0
-+123:+123:0
-+123:+12:1
-+12:+123:-1
--123:-123:0
--123:-12:-1
--12:-123:1
-+123:+124:-1
-+124:+123:1
--123:-124:1
--124:-123:-1
-&fadd
-abc:abc:NaN
-abc:+0:NaN
-+0:abc:NaN
-+0:+0:+0E+0
-+1:+0:+1E+0
-+0:+1:+1E+0
-+1:+1:+2E+0
--1:+0:-1E+0
-+0:-1:-1E+0
--1:-1:-2E+0
--1:+1:+0E+0
-+1:-1:+0E+0
-+9:+1:+1E+1
-+99:+1:+1E+2
-+999:+1:+1E+3
-+9999:+1:+1E+4
-+99999:+1:+1E+5
-+999999:+1:+1E+6
-+9999999:+1:+1E+7
-+99999999:+1:+1E+8
-+999999999:+1:+1E+9
-+9999999999:+1:+1E+10
-+99999999999:+1:+1E+11
-+10:-1:+9E+0
-+100:-1:+99E+0
-+1000:-1:+999E+0
-+10000:-1:+9999E+0
-+100000:-1:+99999E+0
-+1000000:-1:+999999E+0
-+10000000:-1:+9999999E+0
-+100000000:-1:+99999999E+0
-+1000000000:-1:+999999999E+0
-+10000000000:-1:+9999999999E+0
-+123456789:+987654321:+111111111E+1
--123456789:+987654321:+864197532E+0
--123456789:-987654321:-111111111E+1
-+123456789:-987654321:-864197532E+0
-&fsub
-abc:abc:NaN
-abc:+0:NaN
-+0:abc:NaN
-+0:+0:+0E+0
-+1:+0:+1E+0
-+0:+1:-1E+0
-+1:+1:+0E+0
--1:+0:-1E+0
-+0:-1:+1E+0
--1:-1:+0E+0
--1:+1:-2E+0
-+1:-1:+2E+0
-+9:+1:+8E+0
-+99:+1:+98E+0
-+999:+1:+998E+0
-+9999:+1:+9998E+0
-+99999:+1:+99998E+0
-+999999:+1:+999998E+0
-+9999999:+1:+9999998E+0
-+99999999:+1:+99999998E+0
-+999999999:+1:+999999998E+0
-+9999999999:+1:+9999999998E+0
-+99999999999:+1:+99999999998E+0
-+10:-1:+11E+0
-+100:-1:+101E+0
-+1000:-1:+1001E+0
-+10000:-1:+10001E+0
-+100000:-1:+100001E+0
-+1000000:-1:+1000001E+0
-+10000000:-1:+10000001E+0
-+100000000:-1:+100000001E+0
-+1000000000:-1:+1000000001E+0
-+10000000000:-1:+10000000001E+0
-+123456789:+987654321:-864197532E+0
--123456789:+987654321:-111111111E+1
--123456789:-987654321:+864197532E+0
-+123456789:-987654321:+111111111E+1
-&fmul
-abc:abc:NaN
-abc:+0:NaN
-+0:abc:NaN
-+0:+0:+0E+0
-+0:+1:+0E+0
-+1:+0:+0E+0
-+0:-1:+0E+0
--1:+0:+0E+0
-+123456789123456789:+0:+0E+0
-+0:+123456789123456789:+0E+0
--1:-1:+1E+0
--1:+1:-1E+0
-+1:-1:-1E+0
-+1:+1:+1E+0
-+2:+3:+6E+0
--2:+3:-6E+0
-+2:-3:-6E+0
--2:-3:+6E+0
-+111:+111:+12321E+0
-+10101:+10101:+102030201E+0
-+1001001:+1001001:+1002003002001E+0
-+100010001:+100010001:+10002000300020001E+0
-+10000100001:+10000100001:+100002000030000200001E+0
-+11111111111:+9:+99999999999E+0
-+22222222222:+9:+199999999998E+0
-+33333333333:+9:+299999999997E+0
-+44444444444:+9:+399999999996E+0
-+55555555555:+9:+499999999995E+0
-+66666666666:+9:+599999999994E+0
-+77777777777:+9:+699999999993E+0
-+88888888888:+9:+799999999992E+0
-+99999999999:+9:+899999999991E+0
-&fdiv
-abc:abc:NaN
-abc:+1:abc:NaN
-+1:abc:NaN
-+0:+0:NaN
-+0:+1:+0E+0
-+1:+0:NaN
-+0:-1:+0E+0
--1:+0:NaN
-+1:+1:+1E+0
--1:-1:+1E+0
-+1:-1:-1E+0
--1:+1:-1E+0
-+1:+2:+5E-1
-+2:+1:+2E+0
-+10:+5:+2E+0
-+100:+4:+25E+0
-+1000:+8:+125E+0
-+10000:+16:+625E+0
-+10000:-16:-625E+0
-+999999999999:+9:+111111111111E+0
-+999999999999:+99:+10101010101E+0
-+999999999999:+999:+1001001001E+0
-+999999999999:+9999:+100010001E+0
-+999999999999999:+99999:+10000100001E+0
-+1000000000:+9:+1111111111111111111111111111111111111111E-31
-+2000000000:+9:+2222222222222222222222222222222222222222E-31
-+3000000000:+9:+3333333333333333333333333333333333333333E-31
-+4000000000:+9:+4444444444444444444444444444444444444444E-31
-+5000000000:+9:+5555555555555555555555555555555555555556E-31
-+6000000000:+9:+6666666666666666666666666666666666666667E-31
-+7000000000:+9:+7777777777777777777777777777777777777778E-31
-+8000000000:+9:+8888888888888888888888888888888888888889E-31
-+9000000000:+9:+1E+9
-+35500000:+113:+3141592920353982300884955752212389380531E-34
-+71000000:+226:+3141592920353982300884955752212389380531E-34
-+106500000:+339:+3141592920353982300884955752212389380531E-34
-+1000000000:+3:+3333333333333333333333333333333333333333E-31
-$bigfloat::div_scale = 20
-+1000000000:+9:+11111111111111111111E-11
-+2000000000:+9:+22222222222222222222E-11
-+3000000000:+9:+33333333333333333333E-11
-+4000000000:+9:+44444444444444444444E-11
-+5000000000:+9:+55555555555555555556E-11
-+6000000000:+9:+66666666666666666667E-11
-+7000000000:+9:+77777777777777777778E-11
-+8000000000:+9:+88888888888888888889E-11
-+9000000000:+9:+1E+9
-+35500000:+113:+314159292035398230088E-15
-+71000000:+226:+314159292035398230088E-15
-+106500000:+339:+31415929203539823009E-14
-+1000000000:+3:+33333333333333333333E-11
-$bigfloat::div_scale = 40
-&fsqrt
-+0:+0E+0
--1:NaN
--2:NaN
--16:NaN
--123.456:NaN
-+1:+1E+0
-+1.44:+12E-1
-+2:+141421356237309504880168872420969807857E-38
-+4:+2E+0
-+16:+4E+0
-+100:+1E+1
-+123.456:+1111107555549866648462149404118219234119E-38
-+15241.383936:+123456E-3
diff --git a/lib/bigint.pl b/lib/bigint.pl
deleted file mode 100644 (file)
index 6de1c53..0000000
+++ /dev/null
@@ -1,324 +0,0 @@
-warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
-
-package bigint;
-#
-# This library is no longer being maintained, and is included for backward
-# compatibility with Perl 4 programs which may require it.
-#
-# In particular, this should not be used as an example of modern Perl
-# programming techniques.
-# This legacy library is deprecated and will be removed in a future
-# release of perl.
-#
-# Suggested alternative:  Math::BigInt
-
-# arbitrary size integer math package
-#
-# by Mark Biggar
-#
-# Canonical Big integer value are strings of the form
-#       /^[+-]\d+$/ with leading zeros suppressed
-# Input values to these routines may be strings of the form
-#       /^\s*[+-]?[\d\s]+$/.
-# Examples:
-#   '+0'                            canonical zero value
-#   '   -123 123 123'               canonical value '-123123123'
-#   '1 23 456 7890'                 canonical value '+1234567890'
-# Output values always in canonical form
-#
-# Actual math is done in an internal format consisting of an array
-#   whose first element is the sign (/^[+-]$/) and whose remaining 
-#   elements are base 100000 digits with the least significant digit first.
-# The string 'NaN' is used to represent the result when input arguments 
-#   are not numbers, as well as the result of dividing by zero
-#
-# routines provided are:
-#
-#   bneg(BINT) return BINT              negation
-#   babs(BINT) return BINT              absolute value
-#   bcmp(BINT,BINT) return CODE         compare numbers (undef,<0,=0,>0)
-#   badd(BINT,BINT) return BINT         addition
-#   bsub(BINT,BINT) return BINT         subtraction
-#   bmul(BINT,BINT) return BINT         multiplication
-#   bdiv(BINT,BINT) return (BINT,BINT)  division (quo,rem) just quo if scalar
-#   bmod(BINT,BINT) return BINT         modulus
-#   bgcd(BINT,BINT) return BINT         greatest common divisor
-#   bnorm(BINT) return BINT             normalization
-#
-
-# overcome a floating point problem on certain osnames (posix-bc, os390)
-BEGIN {
-    my $x = 100000.0;
-    my $use_mult = int($x*1e-5)*1e5 == $x ? 1 : 0;
-}
-
-$zero = 0;
-
-\f
-# normalize string form of number.   Strip leading zeros.  Strip any
-#   white space and add a sign, if missing.
-# Strings that are not numbers result the value 'NaN'.
-
-sub main'bnorm { #(num_str) return num_str
-    local($_) = @_;
-    s/\s+//g;                           # strip white space
-    if (s/^([+-]?)0*(\d+)$/$1$2/) {     # test if number
-       substr($_,0,0) = '+' unless $1; # Add missing sign
-       s/^-0/+0/;
-       $_;
-    } else {
-       'NaN';
-    }
-}
-
-# Convert a number from string format to internal base 100000 format.
-#   Assumes normalized value as input.
-sub internal { #(num_str) return int_num_array
-    local($d) = @_;
-    ($is,$il) = (substr($d,0,1),length($d)-2);
-    substr($d,0,1) = '';
-    ($is, reverse(unpack("a" . ($il%5+1) . ("a5" x ($il/5)), $d)));
-}
-
-# Convert a number from internal base 100000 format to string format.
-#   This routine scribbles all over input array.
-sub external { #(int_num_array) return num_str
-    $es = shift;
-    grep($_ > 9999 || ($_ = substr('0000'.$_,-5)), @_);   # zero pad
-    &'bnorm(join('', $es, reverse(@_)));    # reverse concat and normalize
-}
-
-# Negate input value.
-sub main'bneg { #(num_str) return num_str
-    local($_) = &'bnorm(@_);
-    vec($_,0,8) ^= ord('+') ^ ord('-') unless $_ eq '+0';
-    s/^./N/ unless /^[-+]/; # works both in ASCII and EBCDIC
-    $_;
-}
-
-# Returns the absolute value of the input.
-sub main'babs { #(num_str) return num_str
-    &abs(&'bnorm(@_));
-}
-
-sub abs { # post-normalized abs for internal use
-    local($_) = @_;
-    s/^-/+/;
-    $_;
-}
-\f
-# Compares 2 values.  Returns one of undef, <0, =0, >0. (suitable for sort)
-sub main'bcmp { #(num_str, num_str) return cond_code
-    local($x,$y) = (&'bnorm($_[0]),&'bnorm($_[1]));
-    if ($x eq 'NaN') {
-       undef;
-    } elsif ($y eq 'NaN') {
-       undef;
-    } else {
-       &cmp($x,$y);
-    }
-}
-
-sub cmp { # post-normalized compare for internal use
-    local($cx, $cy) = @_;
-    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
-    local(*x, *y); ($x, $y) = (&'bnorm($_[0]),&'bnorm($_[1]));
-    if ($x eq 'NaN') {
-       'NaN';
-    } elsif ($y eq 'NaN') {
-       'NaN';
-    } else {
-       @x = &internal($x);             # convert to internal form
-       @y = &internal($y);
-       local($sx, $sy) = (shift @x, shift @y); # get signs
-       if ($sx eq $sy) {
-           &external($sx, &add(*x, *y)); # if same sign add
-       } else {
-           ($x, $y) = (&abs($x),&abs($y)); # make abs
-           if (&cmp($y,$x) > 0) {
-               &external($sy, &sub(*y, *x));
-           } else {
-               &external($sx, &sub(*x, *y));
-           }
-       }
-    }
-}
-
-sub main'bsub { #(num_str, num_str) return num_str
-    &'badd($_[0],&'bneg($_[1]));    
-}
-
-# GCD -- Euclid's algorithm Knuth Vol 2 pg 296
-sub main'bgcd { #(num_str, num_str) return num_str
-    local($x,$y) = (&'bnorm($_[0]),&'bnorm($_[1]));
-    if ($x eq 'NaN' || $y eq 'NaN') {
-       'NaN';
-    } else {
-       ($x, $y) = ($y,&'bmod($x,$y)) while $y ne '+0';
-       $x;
-    }
-}
-\f
-# routine to add two base 1e5 numbers
-#   stolen from Knuth Vol 2 Algorithm A pg 231
-#   there are separate routines to add and sub as per Kunth pg 233
-sub add { #(int_num_array, int_num_array) return int_num_array
-    local(*x, *y) = @_;
-    $car = 0;
-    for $x (@x) {
-       last unless @y || $car;
-       $x -= 1e5 if $car = (($x += shift(@y) + $car) >= 1e5) ? 1 : 0;
-    }
-    for $y (@y) {
-       last unless $car;
-       $y -= 1e5 if $car = (($y += $car) >= 1e5) ? 1 : 0;
-    }
-    (@x, @y, $car);
-}
-
-# subtract base 1e5 numbers -- stolen from Knuth Vol 2 pg 232, $x > $y
-sub sub { #(int_num_array, int_num_array) return int_num_array
-    local(*sx, *sy) = @_;
-    $bar = 0;
-    for $sx (@sx) {
-       last unless @y || $bar;
-       $sx += 1e5 if $bar = (($sx -= shift(@sy) + $bar) < 0);
-    }
-    @sx;
-}
-
-# multiply two numbers -- stolen from Knuth Vol 2 pg 233
-sub main'bmul { #(num_str, num_str) return num_str
-    local(*x, *y); ($x, $y) = (&'bnorm($_[0]), &'bnorm($_[1]));
-    if ($x eq 'NaN') {
-       'NaN';
-    } elsif ($y eq 'NaN') {
-       'NaN';
-    } else {
-       @x = &internal($x);
-       @y = &internal($y);
-       local($signr) = (shift @x ne shift @y) ? '-' : '+';
-       @prod = ();
-       for $x (@x) {
-           ($car, $cty) = (0, 0);
-           for $y (@y) {
-               $prod = $x * $y + $prod[$cty] + $car;
-                if ($use_mult) {
-                   $prod[$cty++] =
-                       $prod - ($car = int($prod * 1e-5)) * 1e5;
-                }
-                else {
-                   $prod[$cty++] =
-                       $prod - ($car = int($prod / 1e5)) * 1e5;
-                }
-           }
-           $prod[$cty] += $car if $car;
-           $x = shift @prod;
-       }
-       &external($signr, @x, @prod);
-    }
-}
-
-# modulus
-sub main'bmod { #(num_str, num_str) return num_str
-    (&'bdiv(@_))[1];
-}
-\f
-sub main'bdiv { #(dividend: num_str, divisor: num_str) return num_str
-    local (*x, *y); ($x, $y) = (&'bnorm($_[0]), &'bnorm($_[1]));
-    return wantarray ? ('NaN','NaN') : 'NaN'
-       if ($x eq 'NaN' || $y eq 'NaN' || $y eq '+0');
-    return wantarray ? ('+0',$x) : '+0' if (&cmp(&abs($x),&abs($y)) < 0);
-    @x = &internal($x); @y = &internal($y);
-    $srem = $y[0];
-    $sr = (shift @x ne shift @y) ? '-' : '+';
-    $car = $bar = $prd = 0;
-    if (($dd = int(1e5/($y[$#y]+1))) != 1) {
-       for $x (@x) {
-           $x = $x * $dd + $car;
-            if ($use_mult) {
-           $x -= ($car = int($x * 1e-5)) * 1e5;
-            }
-            else {
-           $x -= ($car = int($x / 1e5)) * 1e5;
-            }
-       }
-       push(@x, $car); $car = 0;
-       for $y (@y) {
-           $y = $y * $dd + $car;
-            if ($use_mult) {
-           $y -= ($car = int($y * 1e-5)) * 1e5;
-            }
-            else {
-           $y -= ($car = int($y / 1e5)) * 1e5;
-            }
-       }
-    }
-    else {
-       push(@x, 0);
-    }
-    @q = (); ($v2,$v1) = @y[-2,-1];
-    while ($#x > $#y) {
-       ($u2,$u1,$u0) = @x[-3..-1];
-       $q = (($u0 == $v1) ? 99999 : int(($u0*1e5+$u1)/$v1));
-       --$q while ($v2*$q > ($u0*1e5+$u1-$q*$v1)*1e5+$u2);
-       if ($q) {
-           ($car, $bar) = (0,0);
-           for ($y = 0, $x = $#x-$#y-1; $y <= $#y; ++$y,++$x) {
-               $prd = $q * $y[$y] + $car;
-                if ($use_mult) {
-               $prd -= ($car = int($prd * 1e-5)) * 1e5;
-                }
-                else {
-               $prd -= ($car = int($prd / 1e5)) * 1e5;
-                }
-               $x[$x] += 1e5 if ($bar = (($x[$x] -= $prd + $bar) < 0));
-           }
-           if ($x[$#x] < $car + $bar) {
-               $car = 0; --$q;
-               for ($y = 0, $x = $#x-$#y-1; $y <= $#y; ++$y,++$x) {
-                   $x[$x] -= 1e5
-                       if ($car = (($x[$x] += $y[$y] + $car) > 1e5));
-               }
-           }   
-       }
-       pop(@x); unshift(@q, $q);
-    }
-    if (wantarray) {
-       @d = ();
-       if ($dd != 1) {
-           $car = 0;
-           for $x (reverse @x) {
-               $prd = $car * 1e5 + $x;
-               $car = $prd - ($tmp = int($prd / $dd)) * $dd;
-               unshift(@d, $tmp);
-           }
-       }
-       else {
-           @d = @x;
-       }
-       (&external($sr, @q), &external($srem, @d, $zero));
-    } else {
-       &external($sr, @q);
-    }
-}
-1;
diff --git a/lib/bigintpl.t b/lib/bigintpl.t
deleted file mode 100644 (file)
index bdd4919..0000000
+++ /dev/null
@@ -1,296 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-{
-    # Silence the deprecation warnings from bigint.pl for the purpose
-    # of testing. These tests will be removed along with bigint.pl in
-    # the next major release of perl.
-    local $SIG{__WARN__} = sub {
-        if ($_[0] !~ /will be removed from the Perl core distribution/) {
-            print(STDERR @_);
-        }
-    };
-    require "bigint.pl";
-}
-
-$test = 0;
-$| = 1;
-print "1..246\n";
-while (<DATA>) {
-       chop;
-       if (/^&/) {
-               $f = $_;
-       } else {
-               ++$test;
-               @args = split(/:/,$_,99);
-               $ans = pop(@args);
-               $try = "$f('" . join("','", @args) . "');";
-               if (($ans1 = eval($try)) eq $ans) {
-                       print "ok $test\n";
-               } else {
-                       print "not ok $test\n";
-                       print "# '$try' expected: '$ans' got: '$ans1'\n";
-               }
-       }
-} 
-__END__
-&bnorm
-abc:NaN
-   1 a:NaN
-1bcd2:NaN
-11111b:NaN
-+1z:NaN
--1z:NaN
-0:+0
-+0:+0
-+00:+0
-+0 0 0:+0
-000000  0000000   00000:+0
--0:+0
--0000:+0
-+1:+1
-+01:+1
-+001:+1
-+00000100000:+100000
-123456789:+123456789
--1:-1
--01:-1
--001:-1
--123456789:-123456789
--00000100000:-100000
-&bneg
-abd:NaN
-+0:+0
-+1:-1
--1:+1
-+123456789:-123456789
--123456789:+123456789
-&babs
-abc:NaN
-+0:+0
-+1:+1
--1:+1
-+123456789:+123456789
--123456789:+123456789
-&bcmp
-abc:abc:
-abc:+0:
-+0:abc:
-+0:+0:0
--1:+0:-1
-+0:-1:1
-+1:+0:1
-+0:+1:-1
--1:+1:-1
-+1:-1:1
--1:-1:0
-+1:+1:0
-+123:+123:0
-+123:+12:1
-+12:+123:-1
--123:-123:0
--123:-12:-1
--12:-123:1
-+123:+124:-1
-+124:+123:1
--123:-124:1
--124:-123:-1
-&badd
-abc:abc:NaN
-abc:+0:NaN
-+0:abc:NaN
-+0:+0:+0
-+1:+0:+1
-+0:+1:+1
-+1:+1:+2
--1:+0:-1
-+0:-1:-1
--1:-1:-2
--1:+1:+0
-+1:-1:+0
-+9:+1:+10
-+99:+1:+100
-+999:+1:+1000
-+9999:+1:+10000
-+99999:+1:+100000
-+999999:+1:+1000000
-+9999999:+1:+10000000
-+99999999:+1:+100000000
-+999999999:+1:+1000000000
-+9999999999:+1:+10000000000
-+99999999999:+1:+100000000000
-+10:-1:+9
-+100:-1:+99
-+1000:-1:+999
-+10000:-1:+9999
-+100000:-1:+99999
-+1000000:-1:+999999
-+10000000:-1:+9999999
-+100000000:-1:+99999999
-+1000000000:-1:+999999999
-+10000000000:-1:+9999999999
-+123456789:+987654321:+1111111110
--123456789:+987654321:+864197532
--123456789:-987654321:-1111111110
-+123456789:-987654321:-864197532
-&bsub
-abc:abc:NaN
-abc:+0:NaN
-+0:abc:NaN
-+0:+0:+0
-+1:+0:+1
-+0:+1:-1
-+1:+1:+0
--1:+0:-1
-+0:-1:+1
--1:-1:+0
--1:+1:-2
-+1:-1:+2
-+9:+1:+8
-+99:+1:+98
-+999:+1:+998
-+9999:+1:+9998
-+99999:+1:+99998
-+999999:+1:+999998
-+9999999:+1:+9999998
-+99999999:+1:+99999998
-+999999999:+1:+999999998
-+9999999999:+1:+9999999998
-+99999999999:+1:+99999999998
-+10:-1:+11
-+100:-1:+101
-+1000:-1:+1001
-+10000:-1:+10001
-+100000:-1:+100001
-+1000000:-1:+1000001
-+10000000:-1:+10000001
-+100000000:-1:+100000001
-+1000000000:-1:+1000000001
-+10000000000:-1:+10000000001
-+123456789:+987654321:-864197532
--123456789:+987654321:-1111111110
--123456789:-987654321:+864197532
-+123456789:-987654321:+1111111110
-&bmul
-abc:abc:NaN
-abc:+0:NaN
-+0:abc:NaN
-+0:+0:+0
-+0:+1:+0
-+1:+0:+0
-+0:-1:+0
--1:+0:+0
-+123456789123456789:+0:+0
-+0:+123456789123456789:+0
--1:-1:+1
--1:+1:-1
-+1:-1:-1
-+1:+1:+1
-+2:+3:+6
--2:+3:-6
-+2:-3:-6
--2:-3:+6
-+111:+111:+12321
-+10101:+10101:+102030201
-+1001001:+1001001:+1002003002001
-+100010001:+100010001:+10002000300020001
-+10000100001:+10000100001:+100002000030000200001
-+11111111111:+9:+99999999999
-+22222222222:+9:+199999999998
-+33333333333:+9:+299999999997
-+44444444444:+9:+399999999996
-+55555555555:+9:+499999999995
-+66666666666:+9:+599999999994
-+77777777777:+9:+699999999993
-+88888888888:+9:+799999999992
-+99999999999:+9:+899999999991
-&bdiv
-abc:abc:NaN
-abc:+1:abc:NaN
-+1:abc:NaN
-+0:+0:NaN
-+0:+1:+0
-+1:+0:NaN
-+0:-1:+0
--1:+0:NaN
-+1:+1:+1
--1:-1:+1
-+1:-1:-1
--1:+1:-1
-+1:+2:+0
-+2:+1:+2
-+1000000000:+9:+111111111
-+2000000000:+9:+222222222
-+3000000000:+9:+333333333
-+4000000000:+9:+444444444
-+5000000000:+9:+555555555
-+6000000000:+9:+666666666
-+7000000000:+9:+777777777
-+8000000000:+9:+888888888
-+9000000000:+9:+1000000000
-+35500000:+113:+314159
-+71000000:+226:+314159
-+106500000:+339:+314159
-+1000000000:+3:+333333333
-+10:+5:+2
-+100:+4:+25
-+1000:+8:+125
-+10000:+16:+625
-+999999999999:+9:+111111111111
-+999999999999:+99:+10101010101
-+999999999999:+999:+1001001001
-+999999999999:+9999:+100010001
-+999999999999999:+99999:+10000100001
-&bmod
-abc:abc:NaN
-abc:+1:abc:NaN
-+1:abc:NaN
-+0:+0:NaN
-+0:+1:+0
-+1:+0:NaN
-+0:-1:+0
--1:+0:NaN
-+1:+1:+0
--1:-1:+0
-+1:-1:+0
--1:+1:+0
-+1:+2:+1
-+2:+1:+0
-+1000000000:+9:+1
-+2000000000:+9:+2
-+3000000000:+9:+3
-+4000000000:+9:+4
-+5000000000:+9:+5
-+6000000000:+9:+6
-+7000000000:+9:+7
-+8000000000:+9:+8
-+9000000000:+9:+0
-+35500000:+113:+33
-+71000000:+226:+66
-+106500000:+339:+99
-+1000000000:+3:+1
-+10:+5:+0
-+100:+4:+0
-+1000:+8:+0
-+10000:+16:+0
-+999999999999:+9:+0
-+999999999999:+99:+0
-+999999999999:+999:+0
-+999999999999:+9999:+0
-+999999999999999:+99999:+0
-&bgcd
-abc:abc:NaN
-abc:+0:NaN
-+0:abc:NaN
-+0:+0:+0
-+0:+1:+1
-+1:+0:+1
-+1:+1:+1
-+2:+3:+1
-+3:+2:+1
-+100:+625:+25
-+4096:+81:+1
diff --git a/lib/bigrat.pl b/lib/bigrat.pl
deleted file mode 100644 (file)
index aaf1713..0000000
+++ /dev/null
@@ -1,159 +0,0 @@
-warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
-
-package bigrat;
-require "bigint.pl";
-#
-# This library is no longer being maintained, and is included for backward
-# compatibility with Perl 4 programs which may require it.
-# This legacy library is deprecated and will be removed in a future
-# release of perl.
-#
-# In particular, this should not be used as an example of modern Perl
-# programming techniques.
-#
-# Arbitrary size rational math package
-
-# by Mark Biggar
-#
-# Input values to these routines consist of strings of the form 
-#   m|^\s*[+-]?[\d\s]+(/[\d\s]+)?$|.
-# Examples:
-#   "+0/1"                          canonical zero value
-#   "3"                             canonical value "+3/1"
-#   "   -123/123 123"               canonical value "-1/1001"
-#   "123 456/7890"                  canonical value "+20576/1315"
-# Output values always include a sign and no leading zeros or
-#   white space.
-# This package makes use of the bigint package.
-# The string 'NaN' is used to represent the result when input arguments 
-#   that are not numbers, as well as the result of dividing by zero and
-#       the sqrt of a negative number.
-# Extremely naive algorithms are used.
-#
-# Routines provided are:
-#
-#   rneg(RAT) return RAT                negation
-#   rabs(RAT) return RAT                absolute value
-#   rcmp(RAT,RAT) return CODE           compare numbers (undef,<0,=0,>0)
-#   radd(RAT,RAT) return RAT            addition
-#   rsub(RAT,RAT) return RAT            subtraction
-#   rmul(RAT,RAT) return RAT            multiplication
-#   rdiv(RAT,RAT) return RAT            division
-#   rmod(RAT) return (RAT,RAT)          integer and fractional parts
-#   rnorm(RAT) return RAT               normalization
-#   rsqrt(RAT, cycles) return RAT       square root
-\f
-# Convert a number to the canonical string form m|^[+-]\d+/\d+|.
-sub main'rnorm { #(string) return rat_num
-    local($_) = @_;
-    s/\s+//g;
-    if (m#^([+-]?\d+)(/(\d*[1-9]0*))?$#) {
-       &norm($1, $3 ? $3 : '+1');
-    } else {
-       'NaN';
-    }
-}
-
-# Normalize by reducing to lowest terms
-sub norm { #(bint, bint) return rat_num
-    local($num,$dom) = @_;
-    if ($num eq 'NaN') {
-       'NaN';
-    } elsif ($dom eq 'NaN') {
-       'NaN';
-    } elsif ($dom =~ /^[+-]?0+$/) {
-       'NaN';
-    } else {
-       local($gcd) = &'bgcd($num,$dom);
-       $gcd =~ s/^-/+/;
-       if ($gcd ne '+1') { 
-           $num = &'bdiv($num,$gcd);
-           $dom = &'bdiv($dom,$gcd);
-       } else {
-           $num = &'bnorm($num);
-           $dom = &'bnorm($dom);
-       }
-       substr($dom,0,1) = '';
-       "$num/$dom";
-    }
-}
-
-# negation
-sub main'rneg { #(rat_num) return rat_num
-    local($_) = &'rnorm(@_);
-    tr/-+/+-/ if ($_ ne '+0/1');
-    $_;
-}
-
-# absolute value
-sub main'rabs { #(rat_num) return $rat_num
-    local($_) = &'rnorm(@_);
-    substr($_,0,1) = '+' unless $_ eq 'NaN';
-    $_;
-}
-
-# multipication
-sub main'rmul { #(rat_num, rat_num) return rat_num
-    local($xn,$xd) = split('/',&'rnorm($_[0]));
-    local($yn,$yd) = split('/',&'rnorm($_[1]));
-    &norm(&'bmul($xn,$yn),&'bmul($xd,$yd));
-}
-
-# division
-sub main'rdiv { #(rat_num, rat_num) return rat_num
-    local($xn,$xd) = split('/',&'rnorm($_[0]));
-    local($yn,$yd) = split('/',&'rnorm($_[1]));
-    &norm(&'bmul($xn,$yd),&'bmul($xd,$yn));
-}
-\f
-# addition
-sub main'radd { #(rat_num, rat_num) return rat_num
-    local($xn,$xd) = split('/',&'rnorm($_[0]));
-    local($yn,$yd) = split('/',&'rnorm($_[1]));
-    &norm(&'badd(&'bmul($xn,$yd),&'bmul($yn,$xd)),&'bmul($xd,$yd));
-}
-
-# subtraction
-sub main'rsub { #(rat_num, rat_num) return rat_num
-    local($xn,$xd) = split('/',&'rnorm($_[0]));
-    local($yn,$yd) = split('/',&'rnorm($_[1]));
-    &norm(&'bsub(&'bmul($xn,$yd),&'bmul($yn,$xd)),&'bmul($xd,$yd));
-}
-
-# comparison
-sub main'rcmp { #(rat_num, rat_num) return cond_code
-    local($xn,$xd) = split('/',&'rnorm($_[0]));
-    local($yn,$yd) = split('/',&'rnorm($_[1]));
-    &bigint'cmp(&'bmul($xn,$yd),&'bmul($yn,$xd));
-}
-
-# int and frac parts
-sub main'rmod { #(rat_num) return (rat_num,rat_num)
-    local($xn,$xd) = split('/',&'rnorm(@_));
-    local($i,$f) = &'bdiv($xn,$xd);
-    if (wantarray) {
-       ("$i/1", "$f/$xd");
-    } else {
-       "$i/1";
-    }   
-}
-
-# square root by Newtons method.
-#   cycles specifies the number of iterations default: 5
-sub main'rsqrt { #(fnum_str[, cycles]) return fnum_str
-    local($x, $scale) = (&'rnorm($_[0]), $_[1]);
-    if ($x eq 'NaN') {
-       'NaN';
-    } elsif ($x =~ /^-/) {
-       'NaN';
-    } else {
-       local($gscale, $guess) = (0, '+1/1');
-       $scale = 5 if (!$scale);
-       while ($gscale++ < $scale) {
-           $guess = &'rmul(&'radd($guess,&'rdiv($x,$guess)),"+1/2");
-       }
-       "$guess";          # quotes necessary due to perl bug
-    }
-}
-
-1;
diff --git a/lib/cacheout.pl b/lib/cacheout.pl
deleted file mode 100644 (file)
index a5da453..0000000
+++ /dev/null
@@ -1,59 +0,0 @@
-warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
-
-#
-# This library is no longer being maintained, and is included for backward
-# compatibility with Perl 4 programs which may require it.
-# This legacy library is deprecated and will be removed in a future
-# release of perl.
-#
-# In particular, this should not be used as an example of modern Perl
-# programming techniques.
-#
-# Suggested alternative: FileCache
-
-# Open in their package.
-
-sub cacheout'open {
-    open($_[0], $_[1]);
-}
-
-# Close as well
-
-sub cacheout'close {
-    close($_[0]);
-}
-
-# But only this sub name is visible to them.
-
-sub cacheout {
-    package cacheout;
-
-    ($file) = @_;
-    if (!$isopen{$file}) {
-       if (++$numopen > $maxopen) {
-           local(@lru) = sort {$isopen{$a} <=> $isopen{$b};} keys(%isopen);
-           splice(@lru, $maxopen / 3);
-           $numopen -= @lru;
-           for (@lru) { &close($_); delete $isopen{$_}; }
-       }
-       &open($file, ($saw{$file}++ ? '>>' : '>') . $file)
-           || die "Can't create $file: $!\n";
-    }
-    $isopen{$file} = ++$seq;
-}
-
-package cacheout;
-
-$seq = 0;
-$numopen = 0;
-
-if (open(PARAM,'/usr/include/sys/param.h')) {
-    local($_, $.);
-    while (<PARAM>) {
-       $maxopen = $1 - 4 if /^\s*#\s*define\s+NOFILE\s+(\d+)/;
-    }
-    close PARAM;
-}
-$maxopen = 16 unless $maxopen;
-
-1;
diff --git a/lib/complete.pl b/lib/complete.pl
deleted file mode 100644 (file)
index 9ed041c..0000000
+++ /dev/null
@@ -1,124 +0,0 @@
-warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
-
-;#
-#
-# This library is no longer being maintained, and is included for backward
-# compatibility with Perl 4 programs which may require it.
-# This legacy library is deprecated and will be removed in a future
-# release of perl.
-#
-# In particular, this should not be used as an example of modern Perl
-# programming techniques.
-#
-# Suggested alternative: Term::Complete
-
-;#      @(#)complete.pl,v1.1            (me@anywhere.EBay.Sun.COM) 09/23/91
-;#
-;# Author: Wayne Thompson
-;#
-;# Description:
-;#     This routine provides word completion.
-;#     (TAB) attempts word completion.
-;#     (^D)  prints completion list.
-;#      (These may be changed by setting $Complete'complete, etc.)
-;#
-;# Diagnostics:
-;#     Bell when word completion fails.
-;#
-;# Dependencies:
-;#     The tty driver is put into raw mode.
-;#
-;# Bugs:
-;#
-;# Usage:
-;#     $input = &Complete('prompt_string', *completion_list);
-;#         or
-;#     $input = &Complete('prompt_string', @completion_list);
-;#
-
-CONFIG: {
-    package Complete;
-
-    $complete = "\004";
-    $kill     = "\025";
-    $erase1 =   "\177";
-    $erase2 =   "\010";
-}
-
-sub Complete {
-    package Complete;
-
-    local($prompt, @cmp_list, $return, @match, $l, $test, $cmp, $r);
-    if ($_[1] =~ /^StB\0/) {
-        ($prompt, *_) = @_;
-    }
-    else {
-        $prompt = shift(@_);
-    }
-    @cmp_lst = sort(@_);
-
-    system('stty raw -echo');
-    LOOP: {
-        print($prompt, $return);
-        while (($_ = getc(STDIN)) ne "\r") {
-            CASE: {
-                # (TAB) attempt completion
-                $_ eq "\t" && do {
-                    @match = grep(/^$return/, @cmp_lst);
-                    $l = length($test = shift(@match));
-                    unless ($#match < 0) {
-                        foreach $cmp (@match) {
-                            until (substr($cmp, 0, $l) eq substr($test, 0, $l)) {
-                                $l--;
-                            }
-                        }
-                        print("\a");
-                    }
-                    print($test = substr($test, $r, $l - $r));
-                    $r = length($return .= $test);
-                    last CASE;
-                };
-
-                # (^D) completion list
-                $_ eq $complete && do {
-                    print(join("\r\n", '', grep(/^$return/, @cmp_lst)), "\r\n");
-                    redo LOOP;
-                };
-
-                # (^U) kill
-                $_ eq $kill && do {
-                    if ($r) {
-                        undef $r;
-                       undef $return;
-                        print("\r\n");
-                        redo LOOP;
-                    }
-                    last CASE;
-                };
-
-                # (DEL) || (BS) erase
-                ($_ eq $erase1 || $_ eq $erase2) && do {
-                    if($r) {
-                        print("\b \b");
-                        chop($return);
-                        $r--;
-                    }
-                    last CASE;
-                };
-
-                # printable char
-                ord >= 32 && do {
-                    $return .= $_;
-                    $r++;
-                    print;
-                    last CASE;
-                };
-            }
-        }
-    }
-    system('stty -raw echo');
-    print("\n");
-    $return;
-}
-
-1;
diff --git a/lib/ctime.pl b/lib/ctime.pl
deleted file mode 100644 (file)
index aa00d00..0000000
+++ /dev/null
@@ -1,63 +0,0 @@
-warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
-
-;# ctime.pl is a simple Perl emulation for the well known ctime(3C) function.
-#
-# This library is no longer being maintained, and is included for backward
-# compatibility with Perl 4 programs which may require it.
-# This legacy library is deprecated and will be removed in a future
-# release of perl.
-#
-# In particular, this should not be used as an example of modern Perl
-# programming techniques.
-#
-# Suggested alternative: the POSIX ctime function
-
-;#
-;# Waldemar Kebsch, Federal Republic of Germany, November 1988
-;# kebsch.pad@nixpbe.UUCP
-;# Modified March 1990, Feb 1991 to properly handle timezones
-;#  $RCSfile: ctime.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:23:47 $
-;#   Marion Hakanson (hakanson@cse.ogi.edu)
-;#   Oregon Graduate Institute of Science and Technology
-;#
-;# usage:
-;#
-;#     #include <ctime.pl>          # see the -P and -I option in perl.man
-;#     $Date = &ctime(time);
-
-CONFIG: {
-    package ctime;
-
-    @DoW = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
-    @MoY = ('Jan','Feb','Mar','Apr','May','Jun',
-           'Jul','Aug','Sep','Oct','Nov','Dec');
-}
-
-sub ctime {
-    package ctime;
-
-    local($time) = @_;
-    local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
-
-    # Determine what time zone is in effect.
-    # Use GMT if TZ is defined as null, local time if TZ undefined.
-    # There's no portable way to find the system default timezone.
-
-    $TZ = defined($ENV{'TZ'}) ? ( $ENV{'TZ'} ? $ENV{'TZ'} : 'GMT' ) : '';
-    ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
-        ($TZ eq 'GMT') ? gmtime($time) : localtime($time);
-
-    # Hack to deal with 'PST8PDT' format of TZ
-    # Note that this can't deal with all the esoteric forms, but it
-    # does recognize the most common: [:]STDoff[DST[off][,rule]]
-
-    if($TZ=~/^([^:\d+\-,]{3,})([+-]?\d{1,2}(:\d{1,2}){0,2})([^\d+\-,]{3,})?/){
-        $TZ = $isdst ? $4 : $1;
-    }
-    $TZ .= ' ' unless $TZ eq '';
-
-    $year += 1900;
-    sprintf("%s %s %2d %2d:%02d:%02d %s%4d\n",
-      $DoW[$wday], $MoY[$mon], $mday, $hour, $min, $sec, $TZ, $year);
-}
-1;
diff --git a/lib/dotsh.pl b/lib/dotsh.pl
deleted file mode 100644 (file)
index 92f1f4c..0000000
+++ /dev/null
@@ -1,78 +0,0 @@
-warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
-
-#
-#   @(#)dotsh.pl                                               03/19/94
-#
-# This library is no longer being maintained, and is included for backward
-# compatibility with Perl 4 programs which may require it.
-# This legacy library is deprecated and will be removed in a future
-# release of perl.
-#
-# In particular, this should not be used as an example of modern Perl
-# programming techniques.
-#
-#   Author: Charles Collins
-#
-#   Description:
-#      This routine takes a shell script and 'dots' it into the current perl
-#      environment. This makes it possible to use existing system scripts
-#      to alter environment variables on the fly.
-#
-#   Usage:
-#      &dotsh ('ShellScript', 'DependentVariable(s)');
-#
-#         where
-#
-#      'ShellScript' is the full name of the shell script to be dotted
-#
-#      'DependentVariable(s)' is an optional list of shell variables in the
-#         form VARIABLE=VALUE,VARIABLE=VALUE,... that 'ShellScript' is
-#         dependent upon. These variables MUST be defined using shell syntax.
-#
-#   Example:
-#      &dotsh ('/foo/bar', 'arg1');
-#      &dotsh ('/foo/bar');
-#      &dotsh ('/foo/bar arg1 ... argN');
-#
-
-sub dotsh {
-   local(@sh) = @_;
-   local($tmp,$key,$shell,$command,$args,$vars) = '';
-   local(*dotsh);
-   undef *dotsh;
-   $dotsh = shift(@sh);
-   @dotsh = split (/\s/, $dotsh);
-   $command = shift (@dotsh);
-   $args = join (" ", @dotsh);
-   $vars = join ("\n", @sh);
-   open (_SH_ENV, "$command") || die "Could not open $dotsh!\n";
-   chop($_ = <_SH_ENV>);
-   $shell = "$1 -c" if ($_ =~ /^\#\!\s*(\S+(\/sh|\/ksh|\/zsh|\/csh))\s*$/);
-   close (_SH_ENV);
-   if (!$shell) {
-      if ($ENV{'SHELL'} =~ /\/sh$|\/ksh$|\/zsh$|\/bash$|\/csh$/) {
-        $shell = "$ENV{'SHELL'} -c";
-      } else {
-        print "SHELL not recognized!\nUsing /bin/sh...\n";
-        $shell = "/bin/sh -c";
-      }
-   }
-   if (length($vars) > 0) {
-      open (_SH_ENV, "$shell \"$vars && . $command $args && set \" |") || die;
-   } else {
-      open (_SH_ENV, "$shell \". $command $args && set \" |") || die;
-   }
-
-   while (<_SH_ENV>) {
-       chop;
-       m/^([^=]*)=(.*)/s;
-       $ENV{$1} = $2;
-   }
-   close (_SH_ENV);
-
-   foreach $key (keys(%ENV)) {
-       $tmp .= "\$$key = \$ENV{'$key'};" if $key =~ /^[A-Za-z]\w*$/;
-   }
-   eval $tmp;
-}
-1;
diff --git a/lib/exceptions.pl b/lib/exceptions.pl
deleted file mode 100644 (file)
index 8af64c8..0000000
+++ /dev/null
@@ -1,64 +0,0 @@
-warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
-
-# exceptions.pl
-# tchrist@convex.com
-#
-# This library is no longer being maintained, and is included for backward
-# compatibility with Perl 4 programs which may require it.
-# This legacy library is deprecated and will be removed in a future
-# release of perl.
-#
-# In particular, this should not be used as an example of modern Perl
-# programming techniques.
-
-# Here's a little code I use for exception handling.  It's really just
-# glorified eval/die.  The way to use use it is when you might otherwise
-# exit, use &throw to raise an exception.  The first enclosing &catch
-# handler looks at the exception and decides whether it can catch this kind
-# (catch takes a list of regexps to catch), and if so, it returns the one it
-# caught.  If it *can't* catch it, then it will reraise the exception
-# for someone else to possibly see, or to die otherwise.
-# 
-# I use oddly named variables in order to make darn sure I don't conflict 
-# with my caller.  I also hide in my own package, and eval the code in his.
-# 
-# The EXCEPTION: prefix is so you can tell whether it's a user-raised
-# exception or a perl-raised one (eval error).
-# 
-# --tom
-#
-# examples:
-#      if (&catch('/$user_input/', 'regexp', 'syntax error') {
-#              warn "oops try again";
-#              redo;
-#      }
-#
-#      if ($error = &catch('&subroutine()')) { # catches anything
-#
-#      &throw('bad input') if /^$/;
-
-sub catch {
-    package exception;
-    local($__code__, @__exceptions__) = @_;
-    local($__package__) = caller;
-    local($__exception__);
-
-    eval "package $__package__; $__code__";
-    if ($__exception__ = &'thrown) {
-       for (@__exceptions__) {
-           return $__exception__ if /$__exception__/;
-       } 
-       &'throw($__exception__);
-    } 
-} 
-
-sub throw {
-    local($exception) = @_;
-    die "EXCEPTION: $exception\n";
-} 
-
-sub thrown {
-    $@ =~ /^(EXCEPTION: )+(.+)/ && $2;
-} 
-
-1;
diff --git a/lib/fastcwd.pl b/lib/fastcwd.pl
deleted file mode 100644 (file)
index 70007a1..0000000
+++ /dev/null
@@ -1,47 +0,0 @@
-warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
-
-# By John Bazik
-#
-# This library is no longer being maintained, and is included for backward
-# compatibility with Perl 4 programs which may require it.
-# This legacy library is deprecated and will be removed in a future
-# release of perl.
-#
-# In particular, this should not be used as an example of modern Perl
-# programming techniques.
-#
-# Suggested alternative: Cwd
-
-# Usage: $cwd = &fastcwd;
-#
-# This is a faster version of getcwd.  It's also more dangerous because
-# you might chdir out of a directory that you can't chdir back into.
-
-sub fastcwd {
-       local($odev, $oino, $cdev, $cino, $tdev, $tino);
-       local(@path, $path);
-       local(*DIR);
-
-       ($cdev, $cino) = stat('.');
-       for (;;) {
-               ($odev, $oino) = ($cdev, $cino);
-               chdir('..');
-               ($cdev, $cino) = stat('.');
-               last if $odev == $cdev && $oino == $cino;
-               opendir(DIR, '.');
-               for (;;) {
-                       $_ = readdir(DIR);
-                       next if $_ eq '.';
-                       next if $_ eq '..';
-
-                       last unless $_;
-                       ($tdev, $tino) = lstat($_);
-                       last unless $tdev != $odev || $tino != $oino;
-               }
-               closedir(DIR);
-               unshift(@path, $_);
-       }
-       chdir($path = '/' . join('/', @path));
-       $path;
-}
-1;
diff --git a/lib/find.pl b/lib/find.pl
deleted file mode 100644 (file)
index 8e1b42c..0000000
+++ /dev/null
@@ -1,54 +0,0 @@
-warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
-
-# This library is deprecated and unmaintained. It is included for
-# compatibility with Perl 4 scripts which may use it, but it will be
-# removed in a future version of Perl. Please use the File::Find module
-# instead.
-
-# Usage:
-#      require "find.pl";
-#
-#      &find('/foo','/bar');
-#
-#      sub wanted { ... }
-#              where wanted does whatever you want.  $dir contains the
-#              current directory name, and $_ the current filename within
-#              that directory.  $name contains "$dir/$_".  You are cd'ed
-#              to $dir when the function is called.  The function may
-#              set $prune to prune the tree.
-#
-# For example,
-#
-#   find / -name .nfs\* -mtime +7 -exec rm -f {} \; -o -fstype nfs -prune
-#
-# corresponds to this
-#
-#      sub wanted {
-#          /^\.nfs.*$/ &&
-#          (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
-#          int(-M _) > 7 &&
-#          unlink($_)
-#          ||
-#          ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
-#          $dev < 0 &&
-#          ($prune = 1);
-#      }
-#
-# Set the variable $dont_use_nlink if you're using AFS, since AFS cheats.
-
-use File::Find ();
-
-*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;
-
-sub find {
-    &File::Find::find(\&wanted, @_);
-}
-
-1;
diff --git a/lib/finddepth.pl b/lib/finddepth.pl
deleted file mode 100644 (file)
index 479905f..0000000
+++ /dev/null
@@ -1,53 +0,0 @@
-warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
-
-# This library is deprecated and unmaintained. It is included for
-# compatibility with Perl 4 scripts which may use it, but it will be
-# removed in a future version of Perl. Please use the File::Find module
-# instead.
-
-# Usage:
-#      require "finddepth.pl";
-#
-#      &finddepth('/foo','/bar');
-#
-#      sub wanted { ... }
-#              where wanted does whatever you want.  $dir contains the
-#              current directory name, and $_ the current filename within
-#              that directory.  $name contains "$dir/$_".  You are cd'ed
-#              to $dir when the function is called.  The function may
-#              set $prune to prune the tree.
-#
-# For example,
-#
-#   find / -name .nfs\* -mtime +7 -exec rm -f {} \; -o -fstype nfs -prune
-#
-# corresponds to this
-#
-#      sub wanted {
-#          /^\.nfs.*$/ &&
-#          (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
-#          int(-M _) > 7 &&
-#          unlink($_)
-#          ||
-#          ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
-#          $dev < 0 &&
-#          ($prune = 1);
-#      }
-
-
-use File::Find ();
-
-*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;
-
-sub finddepth {
-    &File::Find::finddepth(\&wanted, @_);
-}
-
-1;
diff --git a/lib/flush.pl b/lib/flush.pl
deleted file mode 100644 (file)
index c427976..0000000
+++ /dev/null
@@ -1,36 +0,0 @@
-warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
-
-#
-# This library is no longer being maintained, and is included for backward
-# compatibility with Perl 4 programs which may require it.
-# This legacy library is deprecated and will be removed in a future
-# release of perl.
-#
-# In particular, this should not be used as an example of modern Perl
-# programming techniques.
-#
-# Suggested alternative: IO::Handle
-
-;# Usage: &flush(FILEHANDLE)
-;# flushes the named filehandle
-
-;# Usage: &printflush(FILEHANDLE, "prompt: ")
-;# prints arguments and flushes filehandle
-
-sub flush {
-    local($old) = select(shift);
-    $| = 1;
-    print "";
-    $| = 0;
-    select($old);
-}
-
-sub printflush {
-    local($old) = select(shift);
-    $| = 1;
-    print @_;
-    $| = 0;
-    select($old);
-}
-
-1;
diff --git a/lib/getcwd.pl b/lib/getcwd.pl
deleted file mode 100644 (file)
index 77b2442..0000000
+++ /dev/null
@@ -1,74 +0,0 @@
-warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
-
-# By Brandon S. Allbery
-#
-# This library is no longer being maintained, and is included for backward
-# compatibility with Perl 4 programs which may require it.
-# This legacy library is deprecated and will be removed in a future
-# release of perl.
-# In particular, this should not be used as an example of modern Perl
-# programming techniques.
-#
-# Suggested alternative: Cwd
-
-#
-# Usage: $cwd = &getcwd;
-
-sub getcwd
-{
-    local($dotdots, $cwd, @pst, @cst, $dir, @tst);
-
-    unless (@cst = stat('.'))
-    {
-       warn "stat(.): $!";
-       return '';
-    }
-    $cwd = '';
-    do
-    {
-       $dotdots .= '/' if $dotdots;
-       $dotdots .= '..';
-       @pst = @cst;
-       unless (opendir(getcwd'PARENT, $dotdots))                       #'))
-       {
-           warn "opendir($dotdots): $!";
-           return '';
-       }
-       unless (@cst = stat($dotdots))
-       {
-           warn "stat($dotdots): $!";
-           closedir(getcwd'PARENT);                                    #');
-           return '';
-       }
-       if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
-       {
-           $dir = '';
-       }
-       else
-       {
-           do
-           {
-               unless (defined ($dir = readdir(getcwd'PARENT)))        #'))
-               {
-                   warn "readdir($dotdots): $!";
-                   closedir(getcwd'PARENT);                            #');
-                   return '';
-               }
-               unless (@tst = lstat("$dotdots/$dir"))
-               {
-                   # warn "lstat($dotdots/$dir): $!";
-                   # closedir(getcwd'PARENT);                          #');
-                   # return '';
-               }
-           }
-           while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
-                  $tst[1] != $pst[1]);
-       }
-       $cwd = "$dir/$cwd";
-       closedir(getcwd'PARENT);                                        #');
-    } while ($dir ne '');
-    chop($cwd);
-    $cwd;
-}
-
-1;
diff --git a/lib/getopt.pl b/lib/getopt.pl
deleted file mode 100644 (file)
index 1d4008a..0000000
+++ /dev/null
@@ -1,52 +0,0 @@
-warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
-
-;# $RCSfile: getopt.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:23:58 $
-#
-# This library is no longer being maintained, and is included for backward
-# compatibility with Perl 4 programs which may require it.
-# This legacy library is deprecated and will be removed in a future
-# release of perl.
-#
-# In particular, this should not be used as an example of modern Perl
-# programming techniques.
-#
-# Suggested alternatives: Getopt::Long or Getopt::Std
-
-;# Process single-character switches with switch clustering.  Pass one argument
-;# which is a string containing all switches that take an argument.  For each
-;# switch found, sets $opt_x (where x is the 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.
-
-;# Usage:
-;#     do Getopt('oDI');  # -o, -D & -I take arg.  Sets opt_* as a side effect.
-
-sub Getopt {
-    local($argumentative) = @_;
-    local($_,$first,$rest);
-
-    while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
-       ($first,$rest) = ($1,$2);
-       if (index($argumentative,$first) >= 0) {
-           if ($rest ne '') {
-               shift(@ARGV);
-           }
-           else {
-               shift(@ARGV);
-               $rest = shift(@ARGV);
-           }
-           ${"opt_$first"} = $rest;
-       }
-       else {
-           ${"opt_$first"} = 1;
-           if ($rest ne '') {
-               $ARGV[0] = "-$rest";
-           }
-           else {
-               shift(@ARGV);
-           }
-       }
-    }
-}
-
-1;
diff --git a/lib/getopts.pl b/lib/getopts.pl
deleted file mode 100644 (file)
index 37ecb4a..0000000
+++ /dev/null
@@ -1,67 +0,0 @@
-warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
-
-;# getopts.pl - a better getopt.pl
-#
-# This library is no longer being maintained, and is included for backward
-# compatibility with Perl 4 programs which may require it.
-#
-# In particular, this should not be used as an example of modern Perl
-# programming techniques.
-#
-# Suggested alternatives: Getopt::Long  or  Getopt::Std
-
-;# Usage:
-;#      do Getopts('a:bc');  # -a takes arg. -b & -c not. Sets opt_* as a
-;#                           #  side effect.
-
-sub Getopts {
-    local($argumentative) = @_;
-    local(@args,$_,$first,$rest);
-    local($errs) = 0;
-
-    @args = split( / */, $argumentative );
-    while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
-               ($first,$rest) = ($1,$2);
-               $pos = index($argumentative,$first);
-               if($pos >= 0) {
-                       if($args[$pos+1] eq ':') {
-                               shift(@ARGV);
-                               if($rest eq '') {
-                                       ++$errs unless(@ARGV);
-                                       $rest = shift(@ARGV);
-                               }
-                               eval "
-                               push(\@opt_$first, \$rest);
-                               if (!defined \$opt_$first or \$opt_$first eq '') {
-                                       \$opt_$first = \$rest;
-                               }
-                               else {
-                                       \$opt_$first .= ' ' . \$rest;
-                               }
-                               ";
-                       }
-                       else {
-                               eval "\$opt_$first = 1";
-                               if($rest eq '') {
-                                       shift(@ARGV);
-                               }
-                               else {
-                                       $ARGV[0] = "-$rest";
-                               }
-                       }
-               }
-               else {
-                       print STDERR "Unknown option: $first\n";
-                       ++$errs;
-                       if($rest ne '') {
-                               $ARGV[0] = "-$rest";
-                       }
-                       else {
-                               shift(@ARGV);
-                       }
-               }
-       }
-    $errs == 0;
-}
-
-1;
diff --git a/lib/hostname.pl b/lib/hostname.pl
deleted file mode 100644 (file)
index f57375e..0000000
+++ /dev/null
@@ -1,35 +0,0 @@
-warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
-
-# From: asherman@fmrco.com (Aaron Sherman)
-#
-# This library is no longer being maintained, and is included for backward
-# compatibility with Perl 4 programs which may require it.
-# This legacy library is deprecated and will be removed in a future
-# release of perl.
-#
-# In particular, this should not be used as an example of modern Perl
-# programming techniques.
-#
-# Suggested alternative: Sys::Hostname
-
-sub hostname
-{
-       local(*P,@tmp,$hostname,$_);
-       if (open(P,"hostname 2>&1 |") && (@tmp = <P>) && close(P))
-       {
-               chop($hostname = $tmp[$#tmp]);
-       }
-       elsif (open(P,"uname -n 2>&1 |") && (@tmp = <P>) && close(P))
-       {
-               chop($hostname = $tmp[$#tmp]);
-       }
-       else
-       {
-               die "$0: Cannot get hostname from 'hostname' or 'uname -n'\n";
-       }
-       @tmp = ();
-       close P; # Just in case we failed in an odd spot....
-       $hostname;
-}
-
-1;
diff --git a/lib/importenv.pl b/lib/importenv.pl
deleted file mode 100644 (file)
index 625edf6..0000000
+++ /dev/null
@@ -1,21 +0,0 @@
-warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
-
-# This library is no longer being maintained, and is included for backward
-# compatibility with Perl 4 programs which may require it.
-# This legacy library is deprecated and will be removed in a future
-# release of perl.
-
-;# This file, when interpreted, pulls the environment into normal variables.
-;# Usage:
-;#     require 'importenv.pl';
-;# or
-;#     #include <importenv.pl>
-
-local($tmp,$key) = '';
-
-foreach $key (keys(%ENV)) {
-    $tmp .= "\$$key = \$ENV{'$key'};" if $key =~ /^[A-Za-z]\w*$/;
-}
-eval $tmp;
-
-1;
diff --git a/lib/look.pl b/lib/look.pl
deleted file mode 100644 (file)
index 7be55b2..0000000
+++ /dev/null
@@ -1,54 +0,0 @@
-warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
-
-;# Usage: &look(*FILEHANDLE,$key,$dict,$fold)
-#
-# This library is no longer being maintained, and is included for backward
-# compatibility with Perl 4 programs which may require it.
-# This legacy library is deprecated and will be removed in a future
-# release of perl.
-#
-# In particular, this should not be used as an example of modern Perl
-# programming techniques.
-
-;# Sets file position in FILEHANDLE to be first line greater than or equal
-;# (stringwise) to $key.  Pass flags for dictionary order and case folding.
-
-sub look {
-    local(*FH,$key,$dict,$fold) = @_;
-    local($max,$min,$mid,$_);
-    local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
-       $blksize,$blocks) = stat(FH);
-    $blksize = 8192 unless $blksize;
-    $key =~ s/[^\w\s]//g if $dict;
-    $key = lc $key if $fold;
-    $max = int($size / $blksize);
-    while ($max - $min > 1) {
-       $mid = int(($max + $min) / 2);
-       seek(FH,$mid * $blksize,0);
-       $_ = <FH> if $mid;              # probably a partial line
-       $_ = <FH>;
-       chop;
-       s/[^\w\s]//g if $dict;
-       $_ = lc $_ if $fold;
-       if ($_ lt $key) {
-           $min = $mid;
-       }
-       else {
-           $max = $mid;
-       }
-    }
-    $min *= $blksize;
-    seek(FH,$min,0);
-    <FH> if $min;
-    while (<FH>) {
-       chop;
-       s/[^\w\s]//g if $dict;
-       $_ = lc $_ if $fold;
-       last if $_ ge $key;
-       $min = tell(FH);
-    }
-    seek(FH,$min,0);
-    $min;
-}
-
-1;
diff --git a/lib/newgetopt.pl b/lib/newgetopt.pl
deleted file mode 100644 (file)
index 4ac9470..0000000
+++ /dev/null
@@ -1,77 +0,0 @@
-warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
-
-# This library is no longer being maintained, and is included for backward
-# compatibility with Perl 4 programs which may require it.
-# It is now just a wrapper around the Getopt::Long module.
-# This legacy library is deprecated and will be removed in a future
-# release of perl.
-#
-# In particular, this should not be used as an example of modern Perl
-# programming techniques.
-#
-# Suggested alternative: Getopt::Long
-
-{   package newgetopt;
-
-    # Values for $order. See GNU getopt.c for details.
-    $REQUIRE_ORDER = 0;
-    $PERMUTE = 1;
-    $RETURN_IN_ORDER = 2;
-
-    # Handle POSIX compliance.
-    if ( defined $ENV{"POSIXLY_CORRECT"} ) {
-       $autoabbrev = 0;        # no automatic abbrev of options (???)
-       $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.
-    $debug = 0;                        # for debugging
-    $ignorecase = 1;           # ignore case when matching options
-    $argv_end = "--";          # don't change this!
-}
-
-use Getopt::Long;
-
-################ Subroutines ################
-
-sub NGetOpt {
-
-    $Getopt::Long::debug = $newgetopt::debug 
-       if defined $newgetopt::debug;
-    $Getopt::Long::autoabbrev = $newgetopt::autoabbrev 
-       if defined $newgetopt::autoabbrev;
-    $Getopt::Long::getopt_compat = $newgetopt::getopt_compat 
-       if defined $newgetopt::getopt_compat;
-    $Getopt::Long::option_start = $newgetopt::option_start 
-       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;
-}
-
-################ Package return ################
-
-1;
-
-################ End of newgetopt.pl ################
diff --git a/lib/open2.pl b/lib/open2.pl
deleted file mode 100644 (file)
index ceb5653..0000000
+++ /dev/null
@@ -1,17 +0,0 @@
-warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
-
-# This legacy library is deprecated and will be removed in a future
-# release of perl.
-#
-# This is a compatibility interface to IPC::Open2.  New programs should
-# do
-#
-#     use IPC::Open2;
-#
-# instead of
-#
-#     require 'open2.pl';
-
-package main;
-use IPC::Open2 'open2';
-1
diff --git a/lib/open3.pl b/lib/open3.pl
deleted file mode 100644 (file)
index 9f4d5a4..0000000
+++ /dev/null
@@ -1,17 +0,0 @@
-warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
-
-# This legacy library is deprecated and will be removed in a future
-# release of perl.
-#
-# This is a compatibility interface to IPC::Open3.  New programs should
-# do
-#
-#     use IPC::Open3;
-#
-# instead of
-#
-#     require 'open3.pl';
-
-package main;
-use IPC::Open3 'open3';
-1
diff --git a/lib/pwd.pl b/lib/pwd.pl
deleted file mode 100644 (file)
index bd8123b..0000000
+++ /dev/null
@@ -1,71 +0,0 @@
-warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
-
-;# pwd.pl - keeps track of current working directory in PWD environment var
-;#
-#
-# This library is no longer being maintained, and is included for backward
-# compatibility with Perl 4 programs which may require it.
-# This legacy library is deprecated and will be removed in a future
-# release of perl.
-#
-# In particular, this should not be used as an example of modern Perl
-# programming techniques.
-#
-# Suggested alternative: Cwd
-
-;# $RCSfile: pwd.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:11 $
-;#
-;# $Log:       pwd.pl,v $
-;#
-;# Usage:
-;#     require "pwd.pl";
-;#     &initpwd;
-;#     ...
-;#     &chdir($newdir);
-
-package pwd;
-
-sub main'initpwd {
-    if ($ENV{'PWD'}) {
-       local($dd,$di) = stat('.');
-       local($pd,$pi) = stat($ENV{'PWD'});
-       if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
-           chop($ENV{'PWD'} = `pwd`);
-       }
-    }
-    else {
-       chop($ENV{'PWD'} = `pwd`);
-    }
-    if ($ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|) {
-       local($pd,$pi) = stat($2);
-       local($dd,$di) = stat($1);
-       if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
-           $ENV{'PWD'}="$2$3";
-       }
-    }
-}
-
-sub main'chdir {
-    local($newdir) = shift;
-    $newdir =~ s|/{2,}|/|g;
-    if (chdir $newdir) {
-       if ($newdir =~ m#^/#) {
-           $ENV{'PWD'} = $newdir;
-       }
-       else {
-           local(@curdir) = split(m#/#,$ENV{'PWD'});
-           @curdir = '' unless @curdir;
-           foreach $component (split(m#/#, $newdir)) {
-               next if $component eq '.';
-               pop(@curdir),next if $component eq '..';
-               push(@curdir,$component);
-           }
-           $ENV{'PWD'} = join('/',@curdir) || '/';
-       }
-    }
-    else {
-       0;
-    }
-}
-
-1;
diff --git a/lib/shellwords.pl b/lib/shellwords.pl
deleted file mode 100644 (file)
index b562f5f..0000000
+++ /dev/null
@@ -1,19 +0,0 @@
-warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
-
-;# This legacy library is deprecated and will be removed in a future
-;# release of perl.
-;#
-;# shellwords.pl
-;#
-;# Usage:
-;#     require 'shellwords.pl';
-;#     @words = shellwords($line);
-;#     or
-;#     @words = shellwords(@lines);
-;#     or
-;#     @words = shellwords();          # defaults to $_ (and clobbers it)
-
-require Text::ParseWords;
-*shellwords = \&Text::ParseWords::old_shellwords;
-
-1;
diff --git a/lib/stat.pl b/lib/stat.pl
deleted file mode 100644 (file)
index feda273..0000000
+++ /dev/null
@@ -1,35 +0,0 @@
-warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
-
-;# This legacy library is deprecated and will be removed in a future
-;# release of perl.
-;#
-;# Usage:
-;#     require 'stat.pl';
-;#     @ary = stat(foo);
-;#     $st_dev = @ary[$ST_DEV];
-;#
-
-$ST_DEV =      0;
-$ST_INO =      1;
-$ST_MODE =     2;
-$ST_NLINK =    3;
-$ST_UID =      4;
-$ST_GID =      5;
-$ST_RDEV =     6;
-$ST_SIZE =     7;
-$ST_ATIME =    8;
-$ST_MTIME =    9;
-$ST_CTIME =    10;
-$ST_BLKSIZE =  11;
-$ST_BLOCKS =   12;
-
-;# Usage:
-;#     require 'stat.pl';
-;#     do Stat('foo');         # sets st_* as a side effect
-;#
-sub Stat {
-    ($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) = stat(shift(@_));
-}
-
-1;
diff --git a/lib/syslog.pl b/lib/syslog.pl
deleted file mode 100644 (file)
index 7504a5d..0000000
+++ /dev/null
@@ -1,201 +0,0 @@
-warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
-
-#
-# syslog.pl
-#
-# $Log:        syslog.pl,v $
-# 
-# tom christiansen <tchrist@convex.com>
-# modified to use sockets by Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
-# NOTE: openlog now takes three arguments, just like openlog(3)
-#
-# call syslog() with a string priority and a list of printf() args
-# like syslog(3)
-#
-#  usage: require 'syslog.pl';
-#
-#  then (put these all in a script to test function)
-#              
-#
-#      do openlog($program,'cons,pid','user');
-#      do syslog('info','this is another test');
-#      do syslog('mail|warning','this is a better test: %d', time);
-#      do closelog();
-#      
-#      do syslog('debug','this is the last test');
-#      do openlog("$program $$",'ndelay','user');
-#      do syslog('notice','fooprogram: this is really done');
-#
-#      $! = 55;
-#      do syslog('info','problem was %m'); # %m == $! in syslog(3)
-
-package syslog;
-
-use warnings::register;
-
-$host = 'localhost' unless $host;      # set $syslog'host to change
-
-if ($] >= 5 && warnings::enabled()) {
-    warnings::warn("You should 'use Sys::Syslog' instead; continuing");
-} 
-
-require 'syslog.ph';
-
- eval 'use Socket; 1'                  ||
-     eval { require "socket.ph" }      ||
-     require "sys/socket.ph";
-
-$maskpri = &LOG_UPTO(&LOG_DEBUG);
-
-sub main'openlog {
-    ($ident, $logopt, $facility) = @_;  # package vars
-    $lo_pid = $logopt =~ /\bpid\b/;
-    $lo_ndelay = $logopt =~ /\bndelay\b/;
-    $lo_cons = $logopt =~ /\bcons\b/;
-    $lo_nowait = $logopt =~ /\bnowait\b/;
-    &connect if $lo_ndelay;
-} 
-
-sub main'closelog {
-    $facility = $ident = '';
-    &disconnect;
-} 
-
-sub main'setlogmask {
-    local($oldmask) = $maskpri;
-    $maskpri = shift;
-    $oldmask;
-}
-sub main'syslog {
-    local($priority) = shift;
-    local($mask) = shift;
-    local($message, $whoami);
-    local(@words, $num, $numpri, $numfac, $sum);
-    local($facility) = $facility;      # may need to change temporarily.
-
-    die "syslog: expected both priority and mask" unless $mask && $priority;
-
-    @words = split(/\W+/, $priority, 2);# Allow "level" or "level|facility".
-    undef $numpri;
-    undef $numfac;
-    foreach (@words) {
-       $num = &xlate($_);              # Translate word to number.
-       if (/^kern$/ || $num < 0) {
-           die "syslog: invalid level/facility: $_\n";
-       }
-       elsif ($num <= &LOG_PRIMASK) {
-           die "syslog: too many levels given: $_\n" if defined($numpri);
-           $numpri = $num;
-           return 0 unless &LOG_MASK($numpri) & $maskpri;
-       }
-       else {
-           die "syslog: too many facilities given: $_\n" if defined($numfac);
-           $facility = $_;
-           $numfac = $num;
-       }
-    }
-
-    die "syslog: level must be given\n" unless defined($numpri);
-
-    if (!defined($numfac)) {   # Facility not specified in this call.
-       $facility = 'user' unless $facility;
-       $numfac = &xlate($facility);
-    }
-
-    &connect unless $connected;
-
-    $whoami = $ident;
-
-    if (!$ident && $mask =~ /^(\S.*):\s?(.*)/) {
-       $whoami = $1;
-       $mask = $2;
-    } 
-
-    unless ($whoami) {
-       ($whoami = getlogin) ||
-           ($whoami = getpwuid($<)) ||
-               ($whoami = 'syslog');
-    }
-
-    $whoami .= "[$$]" if $lo_pid;
-
-    $mask =~ s/%m/$!/g;
-    $mask .= "\n" unless $mask =~ /\n$/;
-    $message = sprintf ($mask, @_);
-
-    $sum = $numpri + $numfac;
-    unless (send(SYSLOG,"<$sum>$whoami: $message",0)) {
-       if ($lo_cons) {
-           if ($pid = fork) {
-               unless ($lo_nowait) {
-                   do {$died = wait;} until $died == $pid || $died < 0;
-               }
-           }
-           else {
-               open(CONS,">/dev/console");
-               print CONS "<$facility.$priority>$whoami: $message\r";
-               exit if defined $pid;           # if fork failed, we're parent
-               close CONS;
-           }
-       }
-    }
-}
-
-sub xlate {
-    local($name) = @_;
-    $name = uc $name;
-    $name = "LOG_$name" unless $name =~ /^LOG_/;
-    $name = "syslog'$name";
-    defined &$name ? &$name : -1;
-}
-
-sub connect {
-    $pat = 'S n C4 x8';
-
-    $af_unix = &AF_UNIX;
-    $af_inet = &AF_INET;
-
-    $stream = &SOCK_STREAM;
-    $datagram = &SOCK_DGRAM;
-
-    ($name,$aliases,$proto) = getprotobyname('udp');
-    $udp = $proto;
-
-    ($name,$aliases,$port,$proto) = getservbyname('syslog','udp');
-    $syslog = $port;
-
-    if (chop($myname = `hostname`)) {
-       ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($myname);
-       die "Can't lookup $myname\n" unless $name;
-       @bytes = unpack("C4",$addrs[0]);
-    }
-    else {
-       @bytes = (0,0,0,0);
-    }
-    $this = pack($pat, $af_inet, 0, @bytes);
-
-    if ($host =~ /^\d+\./) {
-       @bytes = split(/\./,$host);
-    }
-    else {
-       ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($host);
-       die "Can't lookup $host\n" unless $name;
-       @bytes = unpack("C4",$addrs[0]);
-    }
-    $that = pack($pat,$af_inet,$syslog,@bytes);
-
-    socket(SYSLOG,$af_inet,$datagram,$udp) || die "socket: $!\n";
-    bind(SYSLOG,$this) || die "bind: $!\n";
-    connect(SYSLOG,$that) || die "connect: $!\n";
-
-    local($old) = select(SYSLOG); $| = 1; select($old);
-    $connected = 1;
-}
-
-sub disconnect {
-    close SYSLOG;
-    $connected = 0;
-}
-
-1;
diff --git a/lib/tainted.pl b/lib/tainted.pl
deleted file mode 100644 (file)
index e88bca1..0000000
+++ /dev/null
@@ -1,14 +0,0 @@
-warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
-
-# This legacy library is deprecated and will be removed in a future
-# release of perl.
-# This subroutine returns true if its argument is tainted, false otherwise.
-#
-
-sub tainted {
-    local($@);
-    eval { kill 0 * $_[0] };
-    $@ =~ /^Insecure/;
-}
-
-1;
diff --git a/lib/termcap.pl b/lib/termcap.pl
deleted file mode 100644 (file)
index a84cba3..0000000
+++ /dev/null
@@ -1,183 +0,0 @@
-warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
-
-;# $RCSfile: termcap.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:16 $
-#
-# This library is no longer being maintained, and is included for backward
-# compatibility with Perl 4 programs which may require it.
-# This legacy library is deprecated and will be removed in a future
-# release of perl.
-#
-# In particular, this should not be used as an example of modern Perl
-# programming techniques.
-#
-# Suggested alternative: Term::Cap
-#
-
-;#
-;# Usage:
-;#     require 'ioctl.pl';
-;#     ioctl(TTY,$TIOCGETP,$foo);
-;#     ($ispeed,$ospeed) = unpack('cc',$foo);
-;#     require 'termcap.pl';
-;#     &Tgetent('vt100');      # sets $TC{'cm'}, etc.
-;#     &Tputs(&Tgoto($TC{'cm'},$col,$row), 0, 'FILEHANDLE');
-;#     &Tputs($TC{'dl'},$affcnt,'FILEHANDLE');
-;#
-sub Tgetent {
-    local($TERM) = @_;
-    local($TERMCAP,$_,$entry,$loop,$field);
-
-    # warn "Tgetent: no ospeed set" unless $ospeed;
-    foreach $key (keys %TC) {
-       delete $TC{$key};
-    }
-    $TERM = $ENV{'TERM'} unless $TERM;
-    $TERM =~ s/(\W)/\\$1/g;
-    $TERMCAP = $ENV{'TERMCAP'};
-    $TERMCAP = '/etc/termcap' unless $TERMCAP;
-    if ($TERMCAP !~ m:^/:) {
-       if ($TERMCAP !~ /(^|\|)$TERM[:\|]/) {
-           $TERMCAP = '/etc/termcap';
-       }
-    }
-    if ($TERMCAP =~ m:^/:) {
-       $entry = '';
-       do {
-           $loop = "
-           open(TERMCAP,'<$TERMCAP') || die \"Can't open $TERMCAP\";
-           while (<TERMCAP>) {
-               next if /^#/;
-               next if /^\t/;
-               if (/(^|\\|)${TERM}[:\\|]/) {
-                   chop;
-                   while (chop eq '\\\\') {
-                       \$_ .= <TERMCAP>;
-                       chop;
-                   }
-                   \$_ .= ':';
-                   last;
-               }
-           }
-           close TERMCAP;
-           \$entry .= \$_;
-           ";
-           eval $loop;
-       } while s/:tc=([^:]+):/:/ && ($TERM = $1);
-       $TERMCAP = $entry;
-    }
-
-    foreach $field (split(/:[\s:\\]*/,$TERMCAP)) {
-       if ($field =~ /^\w\w$/) {
-           $TC{$field} = 1;
-       }
-       elsif ($field =~ /^(\w\w)#(.*)/) {
-           $TC{$1} = $2 if $TC{$1} eq '';
-       }
-       elsif ($field =~ /^(\w\w)=(.*)/) {
-           $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;
-           s/\\t/\t/g;
-           s/\\b/\b/g;
-           s/\\f/\f/g;
-           s/\\\^/\377/g;
-           s/\^\?/\177/g;
-           s/\^(.)/pack('c',ord($1) & 31)/eg;
-           s/\\(.)/$1/g;
-           s/\377/^/g;
-           $TC{$entry} = $_ if $TC{$entry} eq '';
-       }
-    }
-    $TC{'pc'} = "\0" if $TC{'pc'} eq '';
-    $TC{'bc'} = "\b" if $TC{'bc'} eq '';
-}
-
-@Tputs = (0,200,133.3,90.9,74.3,66.7,50,33.3,16.7,8.3,5.5,4.1,2,1,.5,.2);
-
-sub Tputs {
-    local($string,$affcnt,$FH) = @_;
-    local($ms);
-    if ($string =~ /(^[\d.]+)(\*?)(.*)$/) {
-       $ms = $1;
-       $ms *= $affcnt if $2;
-       $string = $3;
-       $decr = $Tputs[$ospeed];
-       if ($decr > .1) {
-           $ms += $decr / 2;
-           $string .= $TC{'pc'} x ($ms / $decr);
-       }
-    }
-    print $FH $string if $FH;
-    $string;
-}
-
-sub Tgoto {
-    local($string) = shift(@_);
-    local($result) = '';
-    local($after) = '';
-    local($code,$tmp) = @_;
-    local(@tmp);
-    @tmp = ($tmp,$code);
-    local($online) = 0;
-    while ($string =~ /^([^%]*)%(.)(.*)/) {
-       $result .= $1;
-       $code = $2;
-       $string = $3;
-       if ($code eq 'd') {
-           $result .= sprintf("%d",shift(@tmp));
-       }
-       elsif ($code eq '.') {
-           $tmp = shift(@tmp);
-           if ($tmp == 0 || $tmp == 4 || $tmp == 10) {
-               if ($online) {
-                   ++$tmp, $after .= $TC{'up'} if $TC{'up'};
-               }
-               else {
-                   ++$tmp, $after .= $TC{'bc'};
-               }
-           }
-           $result .= sprintf("%c",$tmp);
-           $online = !$online;
-       }
-       elsif ($code eq '+') {
-           $result .= sprintf("%c",shift(@tmp)+ord($string));
-           $string = substr($string,1,99);
-           $online = !$online;
-       }
-       elsif ($code eq 'r') {
-           ($code,$tmp) = @tmp;
-           @tmp = ($tmp,$code);
-           $online = !$online;
-       }
-       elsif ($code eq '>') {
-           ($code,$tmp,$string) = unpack("CCa99",$string);
-           if ($tmp[0] > $code) {
-               $tmp[0] += $tmp;
-           }
-       }
-       elsif ($code eq '2') {
-           $result .= sprintf("%02d",shift(@tmp));
-           $online = !$online;
-       }
-       elsif ($code eq '3') {
-           $result .= sprintf("%03d",shift(@tmp));
-           $online = !$online;
-       }
-       elsif ($code eq 'i') {
-           ($code,$tmp) = @tmp;
-           @tmp = ($code+1,$tmp+1);
-       }
-       else {
-           return "OOPS";
-       }
-    }
-    $result . $string . $after;
-}
-
-1;
diff --git a/lib/timelocal.pl b/lib/timelocal.pl
deleted file mode 100644 (file)
index fefb9da..0000000
+++ /dev/null
@@ -1,23 +0,0 @@
-warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
-
-;# timelocal.pl
-;#
-;# Usage:
-;#     $time = timelocal($sec,$min,$hours,$mday,$mon,$year);
-;#     $time = timegm($sec,$min,$hours,$mday,$mon,$year);
-
-;# 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.
-;# This legacy library is deprecated and will be removed in a future
-;# release of perl.
-
-;# 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.
-
-use Time::Local;
-
-*timelocal::cheat = \&Time::Local::cheat;
-
diff --git a/lib/validate.pl b/lib/validate.pl
deleted file mode 100644 (file)
index fc2d16a..0000000
+++ /dev/null
@@ -1,104 +0,0 @@
-warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
-
-;# The validate routine takes a single multiline string consisting of
-;# lines containing a filename plus a file test to try on it.  (The
-;# file test may also be a 'cd', causing subsequent relative filenames
-;# to be interpreted relative to that directory.)  After the file test
-;# you may put '|| die' to make it a fatal error if the file test fails.
-;# The default is '|| warn'.  The file test may optionally have a ! prepended
-;# to test for the opposite condition.  If you do a cd and then list some
-;# relative filenames, you may want to indent them slightly for readability.
-;# If you supply your own "die" or "warn" message, you can use $file to
-;# interpolate the filename.
-
-;# Filetests may be bunched:  -rwx tests for all of -r, -w and -x.
-;# Only the first failed test of the bunch will produce a warning.
-
-;# The routine returns the number of warnings issued.
-
-;# Usage:
-;#     require "validate.pl";
-;#     $warnings += do validate('
-;#     /vmunix                 -e || die
-;#     /boot                   -e || die
-;#     /bin                    cd
-;#         csh                 -ex
-;#         csh                 !-ug
-;#         sh                  -ex
-;#         sh                  !-ug
-;#     /usr                    -d || warn "What happened to $file?\n"
-;#     ');
-
-sub validate {
-    local($file,$test,$warnings,$oldwarnings);
-    foreach $check (split(/\n/,$_[0])) {
-       next if $check =~ /^#/;
-       next if $check =~ /^$/;
-       ($file,$test) = split(' ',$check,2);
-       if ($test =~ s/^(!?-)(\w{2,}\b)/$1Z/) {
-           $testlist = $2;
-           @testlist = split(//,$testlist);
-       }
-       else {
-           @testlist = ('Z');
-       }
-       $oldwarnings = $warnings;
-       foreach $one (@testlist) {
-           $this = $test;
-           $this =~ s/(-\w\b)/$1 \$file/g;
-           $this =~ s/-Z/-$one/;
-           $this .= ' || warn' unless $this =~ /\|\|/;
-           $this =~ s/^(.*\S)\s*\|\|\s*(die|warn)$/$1 || do valmess('$2','$1')/;
-           $this =~ s/\bcd\b/chdir (\$cwd = \$file)/g;
-           eval $this;
-           last if $warnings > $oldwarnings;
-       }
-    }
-    $warnings;
-}
-
-sub valmess {
-    local($disposition,$this) = @_;
-    $file = $cwd . '/' . $file unless $file =~ m|^/|;
-    if ($this =~ /^(!?)-(\w)\s+\$file\s*$/) {
-       $neg = $1;
-       $tmp = $2;
-       $tmp eq 'r' && ($mess = "$file is not readable by uid $>.");
-       $tmp eq 'w' && ($mess = "$file is not writable by uid $>.");
-       $tmp eq 'x' && ($mess = "$file is not executable by uid $>.");
-       $tmp eq 'o' && ($mess = "$file is not owned by uid $>.");
-       $tmp eq 'R' && ($mess = "$file is not readable by you.");
-       $tmp eq 'W' && ($mess = "$file is not writable by you.");
-       $tmp eq 'X' && ($mess = "$file is not executable by you.");
-       $tmp eq 'O' && ($mess = "$file is not owned by you.");
-       $tmp eq 'e' && ($mess = "$file does not exist.");
-       $tmp eq 'z' && ($mess = "$file does not have zero size.");
-       $tmp eq 's' && ($mess = "$file does not have non-zero size.");
-       $tmp eq 'f' && ($mess = "$file is not a plain file.");
-       $tmp eq 'd' && ($mess = "$file is not a directory.");
-       $tmp eq 'l' && ($mess = "$file is not a symbolic link.");
-       $tmp eq 'p' && ($mess = "$file is not a named pipe (FIFO).");
-       $tmp eq 'S' && ($mess = "$file is not a socket.");
-       $tmp eq 'b' && ($mess = "$file is not a block special file.");
-       $tmp eq 'c' && ($mess = "$file is not a character special file.");
-       $tmp eq 'u' && ($mess = "$file does not have the setuid bit set.");
-       $tmp eq 'g' && ($mess = "$file does not have the setgid bit set.");
-       $tmp eq 'k' && ($mess = "$file does not have the sticky bit set.");
-       $tmp eq 'T' && ($mess = "$file is not a text file.");
-       $tmp eq 'B' && ($mess = "$file is not a binary file.");
-       if ($neg eq '!') {
-           $mess =~ s/ is not / should not be / ||
-           $mess =~ s/ does not / should not / ||
-           $mess =~ s/ not / /;
-       }
-       print STDERR $mess,"\n";
-    }
-    else {
-       $this =~ s/\$file/'$file'/g;
-       print STDERR "Can't do $this.\n";
-    }
-    if ($disposition eq 'die') { exit 1; }
-    ++$warnings;
-}
-
-1;