$VERSION crusade, strict, tests, etc... all over lib/
authorMichael G. Schwern <schwern@pobox.com>
Tue, 5 Dec 2000 21:23:28 +0000 (16:23 -0500)
committerJarkko Hietaniemi <jhi@iki.fi>
Wed, 6 Dec 2000 16:09:09 +0000 (16:09 +0000)
Message-ID: <20001205212328.C6473@blackrider.aocn.com>

Carp::Heavy parts not very applicable because of recent changes.

p4raw-id: //depot/perl@8013

60 files changed:
ext/Opcode/Opcode.pm
lib/AnyDBM_File.pm
lib/CGI/Apache.pm
lib/CGI/Switch.pm
lib/Carp.pm
lib/Carp/Heavy.pm
lib/DirHandle.pm
lib/Dumpvalue.pm
lib/English.pm
lib/Env.pm
lib/Exporter.pm
lib/Exporter/Heavy.pm
lib/ExtUtils/MM_Cygwin.pm
lib/ExtUtils/MM_OS2.pm
lib/ExtUtils/MM_Unix.pm
lib/ExtUtils/MM_VMS.pm
lib/ExtUtils/MM_Win32.pm
lib/File/CheckTree.pm
lib/File/DosGlob.pm
lib/File/Find.pm
lib/File/stat.pm
lib/FileCache.pm
lib/I18N/Collate.pm
lib/Net/hostent.pm
lib/Net/netent.pm
lib/Net/protoent.pm
lib/Net/servent.pm
lib/Pod/Functions.pm
lib/Pod/Html.pm
lib/Search/Dict.pm
lib/SelectSaver.pm
lib/Term/Cap.pm
lib/Term/Complete.pm
lib/Term/ReadLine.pm
lib/Text/Abbrev.pm
lib/Tie/Hash.pm
lib/Tie/RefHash.pm
lib/Tie/Scalar.pm
lib/Tie/SubstrHash.pm
lib/Time/Local.pm
lib/Time/tm.pm
lib/UNIVERSAL.pm
lib/User/grent.pm
lib/User/pwent.pm
lib/bytes.pm
lib/charnames.pm
lib/diagnostics.pm
lib/filetest.pm
lib/integer.pm
lib/less.pm
lib/locale.pm
lib/open.pm
lib/overload.pm
lib/subs.pm
lib/utf8.pm
lib/vars.pm
lib/warnings/register.pm
t/lib/attrs.t
t/lib/syslog.t
warnings.pl

index 841120c..6a5e30d 100644 (file)
@@ -2,18 +2,19 @@ package Opcode;
 
 require 5.005_64;
 
+use strict;
+
 our($VERSION, $XS_VERSION, @ISA, @EXPORT_OK);
 
 $VERSION = "1.04";
 $XS_VERSION = "1.03";
 
-use strict;
 use Carp;
 use Exporter ();
 use XSLoader ();
-@ISA = qw(Exporter);
 
 BEGIN {
+    @ISA = qw(Exporter);
     @EXPORT_OK = qw(
        opset ops_to_opset
        opset_to_ops opset_to_hex invert_opset
index 58ffda7..ce85049 100644 (file)
@@ -1,6 +1,7 @@
 package AnyDBM_File;
 
 use 5.005_64;
+our $VERSION = '1.00';
 our @ISA = qw(NDBM_File DB_File GDBM_File SDBM_File ODBM_File) unless @ISA;
 
 my $mod;
index dced866..550c6e4 100644 (file)
@@ -1,4 +1,7 @@
 use CGI;
+
+our $VERSION = '1.00';
+
 1;
 __END__
 
index b16b9c0..e754fde 100644 (file)
@@ -1,4 +1,7 @@
 use CGI;
+
+our $VERSION = '1.00';
+
 1;
 
 __END__
index f7e9bf1..69d477b 100644 (file)
@@ -1,5 +1,7 @@
 package Carp;
 
+our $VERSION = '1.00';
+
 =head1 NAME
 
 carp    - warn of errors (from perspective of caller)
index 36bdcd4..dac9c75 100644 (file)
@@ -1,8 +1,12 @@
+# Carp::Heavy uses some variables in common with Carp.
 package Carp;
 
-our $MaxEvalLen;
-our $MaxLenArg;
-our $Verbose;
+# use strict; # not yet
+
+# On one line so MakeMaker will see it.
+use Carp;  our $VERSION = $Carp::VERSION;
+
+our ($CarpLevel, $MaxArgNums, $MaxEvalLen, $MaxLenArg, $Verbose);
 
 sub caller_info {
   my $i = shift(@_) + 1;
index 047755d..12ee6c6 100644 (file)
@@ -1,5 +1,7 @@
 package DirHandle;
 
+our $VERSION = '1.00';
+
 =head1 NAME 
 
 DirHandle - supply object methods for directory handles
index 475f4ff..c8282cf 100644 (file)
@@ -1,6 +1,7 @@
 use 5.005_64;                  # for (defined ref) and $#$v and our
 package Dumpvalue;
 use strict;
+our $VERSION = '1.00';
 our(%address, $stab, @stab, %stab, %subs);
 
 # translate control chars to ^X - Randal Schwartz
index 1ebc3de..77f27c5 100644 (file)
@@ -1,5 +1,7 @@
 package English;
 
+our $VERSION = '1.00';
+
 require Exporter;
 @ISA = (Exporter);
 
index d1ee071..eb9187f 100644 (file)
@@ -1,5 +1,7 @@
 package Env;
 
+our $VERSION = '1.00';
+
 =head1 NAME
 
 Env - perl module that imports environment variables as scalars or arrays
index 585109e..ad6cdef 100644 (file)
@@ -2,88 +2,85 @@ package Exporter;
 
 require 5.001;
 
-$ExportLevel = 0;
-$Verbose ||= 0;
-$VERSION = '5.562';
+use strict;
+no strict 'refs';
+
+our $Debug = 0;
+our $ExportLevel = 0;
+our $Verbose ||= 0;
+our $VERSION = '5.562';
 
 sub export_to_level {
   require Exporter::Heavy;
-  goto &heavy_export_to_level;
+  goto &Exporter::Heavy::heavy_export_to_level;
 }
 
 sub export {
   require Exporter::Heavy;
-  goto &heavy_export;
+  goto &Exporter::Heavy::heavy_export;
 }
 
 sub export_tags {
   require Exporter::Heavy;
-  _push_tags((caller)[0], "EXPORT",    \@_);
+  Exporter::Heavy::_push_tags((caller)[0], "EXPORT",    \@_);
 }
 
 sub export_ok_tags {
   require Exporter::Heavy;
-  _push_tags((caller)[0], "EXPORT_OK", \@_);
+  Exporter::Heavy::_push_tags((caller)[0], "EXPORT_OK", \@_);
 }
 
 sub import {
   my $pkg = shift;
   my $callpkg = caller($ExportLevel);
-  *exports = *{"$pkg\::EXPORT"};
+
+  my($exports, $export_cache) = (\@{"$pkg\::EXPORT"},
+                                 \%{"$pkg\::EXPORT"});
   # We *need* to treat @{"$pkg\::EXPORT_FAIL"} since Carp uses it :-(
-  *fail = *{"$pkg\::EXPORT_FAIL"};
+  my($fail) = \@{"$pkg\::EXPORT_FAIL"};
   return export $pkg, $callpkg, @_
-    if $Verbose or $Debug or @fail > 1;
-  my $args = @_ or @_ = @exports;
+    if $Verbose or $Debug or @$fail > 1;
+  my $args = @_ or @_ = @$exports;
   
-  if ($args and not %exports) {
-    foreach my $sym (@exports, @{"$pkg\::EXPORT_OK"}) {
+  if ($args and not %$export_cache) {
+    foreach my $sym (@$exports, @{"$pkg\::EXPORT_OK"}) {
       $sym =~ s/^&//;
-      $exports{$sym} = 1;
+      $export_cache->{$sym} = 1;
     }
   }
   if ($Verbose or $Debug 
-      or grep {/\W/ or $args and not exists $exports{$_}
-              or @fail and $_ eq $fail[0]
+      or grep {/\W/ or $args and not exists $export_cache->{$_}
+              or @$fail and $_ eq $fail->[0]
               or (@{"$pkg\::EXPORT_OK"} 
                   and $_ eq ${"$pkg\::EXPORT_OK"}[0])} @_) {
     return export $pkg, $callpkg, ($args ? @_ : ());
   }
-  #local $SIG{__WARN__} = sub {require Carp; goto &Carp::carp};
   local $SIG{__WARN__} = 
        sub {require Carp; local $Carp::CarpLevel = 1; &Carp::carp};
-  foreach $sym (@_) {
+  foreach my $sym (@_) {
     # shortcut for the common case of no type character
     *{"$callpkg\::$sym"} = \&{"$pkg\::$sym"};
   }
 }
 
-1;
 
-# A simple self test harness. Change 'require Carp' to 'use Carp ()' for testing.
-# package main; eval(join('',<DATA>)) or die $@ unless caller;
-__END__
-package Test;
-$INC{'Exporter.pm'} = 1;
-@ISA = qw(Exporter);
-@EXPORT      = qw(A1 A2 A3 A4 A5);
-@EXPORT_OK   = qw(B1 B2 B3 B4 B5);
-%EXPORT_TAGS = (T1=>[qw(A1 A2 B1 B2)], T2=>[qw(A1 A2 B3 B4)], T3=>[qw(X3)]);
-@EXPORT_FAIL = qw(B4);
-Exporter::export_ok_tags('T3', 'unknown_tag');
+# Default methods
+
 sub export_fail {
-    map { "Test::$_" } @_      # edit symbols just as an example
+    my $self = shift;
+    @_;
 }
 
-package main;
-$Exporter::Verbose = 1;
-#import Test;
-#import Test qw(X3);           # export ok via export_ok_tags()
-#import Test qw(:T1 !A2 /5/ !/3/ B5);
-import Test qw(:T2 !B4);
-import Test qw(:T2);           # should fail
+
+sub require_version {
+    require Exporter::Heavy;
+    goto &Exporter::Heavy::require_version;
+}
+
+
 1;
 
+
 =head1 NAME
 
 Exporter - Implements default import method for modules
index 6647f70..39bce2d 100644 (file)
@@ -1,4 +1,12 @@
-package Exporter;
+package Exporter::Heavy;
+
+use strict;
+no strict 'refs';
+
+# On one line so MakeMaker will see it.
+require Exporter;  our $VERSION = $Exporter::VERSION;
+
+our $Verbose;
 
 =head1 NAME
 
@@ -41,16 +49,17 @@ sub heavy_export {
 
     my($pkg, $callpkg, @imports) = @_;
     my($type, $sym, $oops);
-    *exports = *{"${pkg}::EXPORT"};
+    my($exports, $export_cache) = (\@{"${pkg}::EXPORT"},
+                                   \%{"${pkg}::EXPORT"});
 
     if (@imports) {
-       if (!%exports) {
-           grep(s/^&//, @exports);
-           @exports{@exports} = (1) x @exports;
+       if (!%$export_cache) {
+           s/^&// foreach @$exports;
+           @{$export_cache}{@$exports} = (1) x @$exports;
            my $ok = \@{"${pkg}::EXPORT_OK"};
            if (@$ok) {
-               grep(s/^&//, @$ok);
-               @exports{@$ok} = (1) x @$ok;
+               s/^&// foreach @$ok;
+               @{$export_cache}{@$ok} = (1) x @$ok;
            }
        }
 
@@ -66,7 +75,7 @@ sub heavy_export {
 
                if ($spec =~ s/^://){
                    if ($spec eq 'DEFAULT'){
-                       @names = @exports;
+                       @names = @$exports;
                    }
                    elsif ($tagdata = $tagsref->{$spec}) {
                        @names = @$tagdata;
@@ -79,7 +88,7 @@ sub heavy_export {
                }
                elsif ($spec =~ m:^/(.*)/$:){
                    my $patn = $1;
-                   @allexports = keys %exports unless @allexports; # only do keys once
+                   @allexports = keys %$export_cache unless @allexports; # only do keys once
                    @names = grep(/$patn/, @allexports); # not anchored by default
                }
                else {
@@ -100,13 +109,13 @@ sub heavy_export {
        }
 
        foreach $sym (@imports) {
-           if (!$exports{$sym}) {
+           if (!$export_cache->{$sym}) {
                if ($sym =~ m/^\d/) {
                    $pkg->require_version($sym);
                    # If the version number was the only thing specified
                    # then we should act as if nothing was specified:
                    if (@imports == 1) {
-                       @imports = @exports;
+                       @imports = @$exports;
                        last;
                    }
                    # We need a way to emulate 'use Foo ()' but still
@@ -115,7 +124,7 @@ sub heavy_export {
                        @imports = ();
                        last;
                    }
-               } elsif ($sym !~ s/^&// || !$exports{$sym}) {
+               } elsif ($sym !~ s/^&// || !$export_cache->{$sym}) {
                     require Carp;
                    Carp::carp(qq["$sym" is not exported by the $pkg module]);
                    $oops++;
@@ -128,21 +137,23 @@ sub heavy_export {
        }
     }
     else {
-       @imports = @exports;
+       @imports = @$exports;
     }
 
-    *fail = *{"${pkg}::EXPORT_FAIL"};
-    if (@fail) {
-       if (!%fail) {
+    my($fail, $fail_cache) = (\@{"${pkg}::EXPORT_FAIL"},
+                              \%{"${pkg}::EXPORT_FAIL"});
+
+    if (@$fail) {
+       if (!%$fail_cache) {
            # Build cache of symbols. Optimise the lookup by adding
            # barewords twice... both with and without a leading &.
-           # (Technique could be applied to %exports cache at cost of memory)
-           my @expanded = map { /^\w/ ? ($_, '&'.$_) : $_ } @fail;
+           # (Technique could be applied to $export_cache at cost of memory)
+           my @expanded = map { /^\w/ ? ($_, '&'.$_) : $_ } @$fail;
            warn "${pkg}::EXPORT_FAIL cached: @expanded" if $Verbose;
-           @fail{@expanded} = (1) x @expanded;
+           @{$fail_cache}{@expanded} = (1) x @expanded;
        }
        my @failed;
-       foreach $sym (@imports) { push(@failed, $sym) if $fail{$sym} }
+       foreach $sym (@imports) { push(@failed, $sym) if $fail_cache->{$sym} }
        if (@failed) {
            @failed = $pkg->export_fail(@failed);
            foreach $sym (@failed) {
@@ -188,24 +199,19 @@ sub heavy_export_to_level
 
 sub _push_tags {
     my($pkg, $var, $syms) = @_;
-    my $nontag;
-    *export_tags = \%{"${pkg}::EXPORT_TAGS"};
+    my @nontag = ();
+    my $export_tags = \%{"${pkg}::EXPORT_TAGS"};
     push(@{"${pkg}::$var"},
-       map { $export_tags{$_} ? @{$export_tags{$_}} : scalar(++$nontag,$_) }
-               (@$syms) ? @$syms : keys %export_tags);
-    if ($nontag and $^W) {
+       map { $export_tags->{$_} ? @{$export_tags->{$_}} 
+                                 : scalar(push(@nontag,$_),$_) }
+               (@$syms) ? @$syms : keys %$export_tags);
+    if (@nontag and $^W) {
        # This may change to a die one day
        require Carp;
-       Carp::carp("Some names are not tags");
+       Carp::carp(join(", ", @nontag)." are not tags of $pkg");
     }
 }
 
-# Default methods
-
-sub export_fail {
-    my $self = shift;
-    @_;
-}
 
 sub require_version {
     my($self, $wanted) = @_;
index 439c67c..abb491f 100644 (file)
@@ -1,12 +1,16 @@
 package ExtUtils::MM_Cygwin;
 
+use strict;
+
+our $VERSION = '1.00';
+
 use Config;
 #use Cwd;
 #use File::Basename;
 require Exporter;
 
-Exporter::import('ExtUtils::MakeMaker',
-       qw( $Verbose &neatvalue));
+require ExtUtils::MakeMaker;
+ExtUtils::MakeMaker->import(qw( $Verbose &neatvalue));
 
 unshift @MM::ISA, 'ExtUtils::MM_Cygwin';
 
index 430235a..501832b 100644 (file)
@@ -1,12 +1,16 @@
 package ExtUtils::MM_OS2;
 
+use strict;
+
+our $VERSION = '1.00';
+
 #use Config;
 #use Cwd;
 #use File::Basename;
 require Exporter;
 
-Exporter::import('ExtUtils::MakeMaker',
-       qw( $Verbose &neatvalue));
+require ExtUtils::MakeMaker;
+ExtUtils::MakeMaker->import(qw( $Verbose &neatvalue));
 
 unshift @MM::ISA, 'ExtUtils::MM_OS2';
 
index eb3ef70..e926ca7 100644 (file)
@@ -1,5 +1,7 @@
 package ExtUtils::MM_Unix;
 
+use strict;
+
 use Exporter ();
 use Config;
 use File::Basename qw(basename dirname fileparse);
@@ -8,10 +10,10 @@ use strict;
 use vars qw($VERSION $Is_Mac $Is_OS2 $Is_VMS $Is_Win32 $Is_Dos $Is_PERL_OBJECT
            $Verbose %pm %static $Xsubpp_Version);
 
-$VERSION = substr q$Revision: 1.12603 $, 10;
-# $Id: MM_Unix.pm,v 1.126 1998/06/28 21:32:49 k Exp k $
+our $VERSION = '1.12603';
 
-Exporter::import('ExtUtils::MakeMaker', qw($Verbose &neatvalue));
+require ExtUtils::MakeMaker;
+ExtUtils::MakeMaker->import(qw($Verbose &neatvalue));
 
 $Is_OS2 = $^O eq 'os2';
 $Is_Mac = $^O eq 'MacOS';
index e059d8f..3485786 100644 (file)
@@ -7,19 +7,23 @@
 
 package ExtUtils::MM_VMS;
 
+use strict;
+
 use Carp qw( &carp );
 use Config;
 require Exporter;
 use VMS::Filespec;
 use File::Basename;
 use File::Spec;
-our($Revision, @ISA);
-$Revision = '5.56 (27-Apr-1999)';
+our($Revision, @ISA, $VERSION);
+# All on one line so MakeMaker can see it.
+($VERSION) = ($Revision = '5.56 (27-Apr-1999)') =~ /^([\d.]+)/;
 
 @ISA = qw( File::Spec );
 unshift @MM::ISA, 'ExtUtils::MM_VMS';
 
-Exporter::import('ExtUtils::MakeMaker', '$Verbose', '&neatvalue');
+require ExtUtils::MakeMaker;
+ExtUtils::MakeMaker->import('$Verbose', '&neatvalue');
 
 =head1 NAME
 
index 7f40ff7..513b110 100644 (file)
@@ -1,5 +1,7 @@
 package ExtUtils::MM_Win32;
 
+our $VERSION = '1.00';
+
 =head1 NAME
 
 ExtUtils::MM_Win32 - methods to override UN*X behaviour in ExtUtils::MakeMaker
@@ -23,8 +25,8 @@ use Config;
 use File::Basename;
 require Exporter;
 
-Exporter::import('ExtUtils::MakeMaker',
-       qw( $Verbose &neatvalue));
+require ExtUtils::MakeMaker;
+ExtUtils::MakeMaker->import(qw( $Verbose &neatvalue));
 
 $ENV{EMXSHELL} = 'sh'; # to run `commands`
 unshift @MM::ISA, 'ExtUtils::MM_Win32';
index ae18777..8b6ae08 100644 (file)
@@ -1,4 +1,7 @@
 package File::CheckTree;
+
+our $VERSION = '4.1';
+
 require 5.000;
 require Exporter;
 
@@ -41,39 +44,8 @@ The routine returns the number of warnings issued.
 
 =cut
 
-@ISA = qw(Exporter);
-@EXPORT = qw(validate);
-
-# $RCSfile: validate.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:19 $
-
-# 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:
-#      use File::CheckTree;
-#      $warnings += 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"
-#      ');
+our @ISA = qw(Exporter);
+our @EXPORT = qw(validate);
 
 sub validate {
     local($file,$test,$warnings,$oldwarnings);
@@ -94,7 +66,8 @@ sub validate {
            $this =~ s/(-\w\b)/$1 \$file/g;
            $this =~ s/-Z/-$one/;
            $this .= ' || warn' unless $this =~ /\|\|/;
-           $this =~ s/^(.*\S)\s*\|\|\s*(die|warn)$/$1 || valmess('$2','$1')/;
+           $this =~ s/^(.*\S)\s*\|\|\s*(die|warn)$/$1 || 
+               valmess('$2','$1')/;
            $this =~ s/\bcd\b/chdir (\$cwd = \$file)/g;
            eval $this;
            last if $warnings > $oldwarnings;
@@ -103,47 +76,54 @@ sub validate {
     $warnings;
 }
 
+our %Val_Switch = (
+       'r' => sub { "$_[0] is not readable by uid $>." },
+       'w' => sub { "$_[0] is not writable by uid $>." },
+       'x' => sub { "$_[0] is not executable by uid $>." },
+       'o' => sub { "$_[0] is not owned by uid $>." },
+       'R' => sub { "$_[0] is not readable by you." },
+       'W' => sub { "$_[0] is not writable by you." },
+       'X' => sub { "$_[0] is not executable by you." },
+       'O' => sub { "$_[0] is not owned by you." },
+       'e' => sub { "$_[0] does not exist." },
+       'z' => sub { "$_[0] does not have zero size." },
+       's' => sub { "$_[0] does not have non-zero size." },
+       'f' => sub { "$_[0] is not a plain file." },
+       'd' => sub { "$_[0] is not a directory." },
+       'l' => sub { "$_[0] is not a symbolic link." },
+       'p' => sub { "$_[0] is not a named pipe (FIFO)." },
+       'S' => sub { "$_[0] is not a socket." },
+       'b' => sub { "$_[0] is not a block special file." },
+       'c' => sub { "$_[0] is not a character special file." },
+       'u' => sub { "$_[0] does not have the setuid bit set." },
+       'g' => sub { "$_[0] does not have the setgid bit set." },
+       'k' => sub { "$_[0] does not have the sticky bit set." },
+       'T' => sub { "$_[0] is not a text file." },
+       'B' => sub { "$_[0] is not a binary file." },
+);
+
 sub valmess {
-    local($disposition,$this) = @_;
-    $file = $cwd . '/' . $file unless $file =~ m|^/|s;
+    my($disposition,$this) = @_;
+    my $file = $cwd . '/' . $file unless $file =~ m|^/|s;
+    
+    my $ferror;
     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.");
+       my($neg,$ftype) = ($1,$2);
+
+        $ferror = $Val_Switch{$tmp}->($file);
+
        if ($neg eq '!') {
-           $mess =~ s/ is not / should not be / ||
-           $mess =~ s/ does not / should not / ||
-           $mess =~ s/ not / /;
+           $ferror =~ s/ is not / should not be / ||
+           $ferror =~ s/ does not / should not / ||
+           $ferror =~ s/ not / /;
        }
     }
     else {
        $this =~ s/\$file/'$file'/g;
-       $mess = "Can't do $this.\n";
+       $ferror = "Can't do $this.\n";
     }
-    die "$mess\n" if $disposition eq 'die';
-    warn "$mess\n";
+    die "$ferror\n" if $disposition eq 'die';
+    warn "$ferror\n";
     ++$warnings;
 }
 
index d7dea7b..3401b5f 100644 (file)
@@ -6,49 +6,51 @@
 
 package File::DosGlob;
 
+our $VERSION = '1.00';
+use strict;
+
 sub doglob {
     my $cond = shift;
     my @retval = ();
     #print "doglob: ", join('|', @_), "\n";
   OUTER:
-    for my $arg (@_) {
-        local $_ = $arg;
+    for my $pat (@_) {
        my @matched = ();
        my @globdirs = ();
        my $head = '.';
        my $sepchr = '/';
-       next OUTER unless defined $_ and $_ ne '';
+        my $tail;
+       next OUTER unless defined $pat and $pat ne '';
        # if arg is within quotes strip em and do no globbing
-       if (/^"(.*)"\z/s) {
-           $_ = $1;
-           if ($cond eq 'd') { push(@retval, $_) if -d $_ }
-           else              { push(@retval, $_) if -e $_ }
+       if ($pat =~ /^"(.*)"\z/s) {
+           $pat = $1;
+           if ($cond eq 'd') { push(@retval, $pat) if -d $pat }
+           else              { push(@retval, $pat) if -e $pat }
            next OUTER;
        }
        # wildcards with a drive prefix such as h:*.pm must be changed
        # to h:./*.pm to expand correctly
-       if (m|^([A-Za-z]:)[^/\\]|s) {
+       if ($pat =~ m|^([A-Za-z]:)[^/\\]|s) {
            substr($_,0,2) = $1 . "./";
        }
-       if (m|^(.*)([\\/])([^\\/]*)\z|s) {
-           my $tail;
+       if ($pat =~ m|^(.*)([\\/])([^\\/]*)\z|s) {
            ($head, $sepchr, $tail) = ($1,$2,$3);
            #print "div: |$head|$sepchr|$tail|\n";
-           push (@retval, $_), next OUTER if $tail eq '';
+           push (@retval, $pat), next OUTER if $tail eq '';
            if ($head =~ /[*?]/) {
                @globdirs = doglob('d', $head);
                push(@retval, doglob($cond, map {"$_$sepchr$tail"} @globdirs)),
                    next OUTER if @globdirs;
            }
            $head .= $sepchr if $head eq '' or $head =~ /^[A-Za-z]:\z/s;
-           $_ = $tail;
+           $pat = $tail;
        }
        #
        # If file component has no wildcards, we can avoid opendir
-       unless (/[*?]/) {
+       unless ($pat =~ /[*?]/) {
            $head = '' if $head eq '.';
            $head .= $sepchr unless $head eq '' or substr($head,-1) eq $sepchr;
-           $head .= $_;
+           $head .= $pat;
            if ($cond eq 'd') { push(@retval,$head) if -d $head }
            else              { push(@retval,$head) if -e $head }
            next OUTER;
@@ -60,14 +62,13 @@ sub doglob {
        $head .= $sepchr unless $head eq '' or substr($head,-1) eq $sepchr;
 
        # escape regex metachars but not glob chars
-       s:([].+^\-\${}[|]):\\$1:g;
+        $pat =~ s:([].+^\-\${}[|]):\\$1:g;
        # and convert DOS-style wildcards to regex
-       s/\*/.*/g;
-       s/\?/.?/g;
+       $pat =~ s/\*/.*/g;
+       $pat =~ s/\?/.?/g;
 
-       #print "regex: '$_', head: '$head'\n";
-       my $matchsub = eval 'sub { $_[0] =~ m|^' . $_ . '\\z|ios }';
-       warn($@), next OUTER if $@;
+       #print "regex: '$pat', head: '$head'\n";
+       my $matchsub = sub { $_[0] =~ m|^$pat\z|is };
       INNER:
        for my $e (@leaves) {
            next INNER if $e eq '.' or $e eq '..';
@@ -80,7 +81,7 @@ sub doglob {
            # has a dot *and* name is shorter than 9 chars.
            #
            if (index($e,'.') == -1 and length($e) < 9
-               and index($_,'\\.') != -1) {
+               and index($pat,'\\.') != -1) {
                push(@matched, "$head$e"), next INNER if &$matchsub("$e.");
            }
        }
@@ -100,8 +101,7 @@ my %iter;
 my %entries;
 
 sub glob {
-    my $pat = shift;
-    my $cxix = shift;
+    my($pat,$cxix) = @_;
     my @pat;
 
     # glob without args defaults to $_
@@ -143,14 +143,17 @@ sub glob {
     }
 }
 
-sub import {
+{
+    no strict 'refs';
+
+    sub import {
     my $pkg = shift;
     return unless @_;
     my $sym = shift;
     my $callpkg = ($sym =~ s/^GLOBAL_//s ? 'CORE::GLOBAL' : caller(0));
     *{$callpkg.'::'.$sym} = \&{$pkg.'::'.$sym} if $sym eq 'glob';
+    }
 }
-
 1;
 
 __END__
index 3a621c0..1e33f1e 100644 (file)
@@ -1,5 +1,7 @@
 package File::Find;
+use strict;
 use 5.005_64;
+our $VERSION = '1.00';
 require Exporter;
 require Cwd;
 
@@ -187,8 +189,8 @@ in an unknown directory.
 
 =cut
 
-@ISA = qw(Exporter);
-@EXPORT = qw(find finddepth);
+our @ISA = qw(Exporter);
+our @EXPORT = qw(find finddepth);
 
 
 use strict;
index 0cf7a0b..200af4e 100644 (file)
@@ -4,6 +4,8 @@ use strict;
 use 5.005_64;
 our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS);
 
+our $VERSION = '1.00';
+
 BEGIN { 
     use Exporter   ();
     @EXPORT      = qw(stat lstat);
index e1c5ec4..78a3e67 100644 (file)
@@ -1,5 +1,7 @@
 package FileCache;
 
+our $VERSION = '1.00';
+
 =head1 NAME
 
 FileCache - keep more files open than the system permits
index 64a03a2..d18a5a5 100644 (file)
@@ -1,5 +1,8 @@
 package I18N::Collate;
 
+use strict;
+our $VERSION = '1.00';
+
 =head1 NAME
 
 I18N::Collate - compare 8-bit scalar data according to the current locale
@@ -112,15 +115,18 @@ use warnings::register;
 
 require Exporter;
 
-@ISA = qw(Exporter);
-@EXPORT = qw(collate_xfrm setlocale LC_COLLATE);
-@EXPORT_OK = qw();
+our @ISA = qw(Exporter);
+our @EXPORT = qw(collate_xfrm setlocale LC_COLLATE);
+our @EXPORT_OK = qw();
 
 use overload qw(
 fallback       1
 cmp            collate_cmp
 );
 
+our($LOCALE, $C);
+
+our $please_use_I18N_Collate_even_if_deprecated = 0;
 sub new {
   my $new = $_[1];
 
index 6cfde72..0a22389 100644 (file)
@@ -2,6 +2,7 @@ package Net::hostent;
 use strict;
 
 use 5.005_64;
+our $VERSION = '1.00';
 our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS);
 BEGIN { 
     use Exporter   ();
index b21cd04..d5ce22e 100644 (file)
@@ -2,6 +2,7 @@ package Net::netent;
 use strict;
 
 use 5.005_64;
+our $VERSION = '1.00';
 our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS);
 BEGIN { 
     use Exporter   ();
index 6aad940..2c3db88 100644 (file)
@@ -2,6 +2,7 @@ package Net::protoent;
 use strict;
 
 use 5.005_64;
+our $VERSION = '1.00';
 our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS);
 BEGIN { 
     use Exporter   ();
index c892af0..18c7fb5 100644 (file)
@@ -2,6 +2,7 @@ package Net::servent;
 use strict;
 
 use 5.005_64;
+our $VERSION = '1.00';
 our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS);
 BEGIN {
     use Exporter   ();
index 44619d5..960b847 100644 (file)
@@ -2,12 +2,16 @@ package Pod::Functions;
 
 #:vi:set ts=20
 
+our $VERSION = '1.00';
+
 require Exporter;
 
 @ISA = qw(Exporter);
 @EXPORT = qw(%Kinds %Type %Flavor %Type_Description @Type_Order);
 
-%Type_Description = (
+our(%Kinds, %Type, %Flavor);
+
+our %Type_Description = (
     'ARRAY'    => 'Functions for real @ARRAYs',
     'Binary'   => 'Functions for fixed length data or records',
     'File'     => 'Functions for filehandles, files, or directories',
@@ -30,7 +34,7 @@ require Exporter;
     'Namespace'        => 'Keywords altering or affecting scoping of identifiers',
 );
 
-@Type_Order = qw{
+our @Type_Order = qw{
     String
     Regexp
     Math
@@ -57,20 +61,20 @@ while (<DATA>) {
     chomp;
     s/#.*//;
     next unless $_;
-    ($name, $type, $text) = split " ", $_, 3;
+    my($name, $type, $text) = split " ", $_, 3;
     $Type{$name} = $type;
     $Flavor{$name} = $text;
-    for $type ( split /[,\s]+/, $type ) {
-       push @{$Kinds{$type}}, $name;
+    for my $t ( split /[,\s]+/, $type ) {
+       push @{$Kinds{$t}}, $name;
     }
 } 
 
 close DATA;
 
 unless (caller) { 
-    foreach $type ( @Type_Order ) {
-       $list = join(", ", sort @{$Kinds{$type}});
-       $typedesc = $Type_Description{$type} . ":";
+    foreach my $type ( @Type_Order ) {
+       my $list = join(", ", sort @{$Kinds{$type}});
+       my $typedesc = $Type_Description{$type} . ":";
        write;
     } 
 }
index f70a42b..4316823 100644 (file)
@@ -12,7 +12,6 @@ use Config;
 use Cwd;
 use File::Spec::Unix;
 use Getopt::Long;
-use Pod::Functions;
 
 use locale;    # make \w work right in non-ASCII lands
 
index 9a229a7..58c7543 100644 (file)
@@ -2,8 +2,11 @@ package Search::Dict;
 require 5.000;
 require Exporter;
 
-@ISA = qw(Exporter);
-@EXPORT = qw(look);
+use strict;
+
+our $VERSION = '1.00';
+our @ISA = qw(Exporter);
+our @EXPORT = qw(look);
 
 =head1 NAME
 
@@ -30,9 +33,9 @@ If I<$fold> is true, ignore case.
 =cut
 
 sub look {
-    local(*FH,$key,$dict,$fold) = @_;
+    my($fh,$key,$dict,$fold) = @_;
     local($_);
-    my(@stat) = stat(FH)
+    my(@stat) = stat($fh)
        or return -1;
     my($size, $blksize) = @stat[7,11];
     $blksize ||= 8192;
@@ -41,10 +44,10 @@ sub look {
     my($min, $max, $mid) = (0, int($size / $blksize));
     while ($max - $min > 1) {
        $mid = int(($max + $min) / 2);
-       seek(FH, $mid * $blksize, 0)
+       seek($fh, $mid * $blksize, 0)
            or return -1;
-       <FH> if $mid;                   # probably a partial line
-       $_ = <FH>;
+       <$fh> if $mid;                  # probably a partial line
+       $_ = <$fh>;
        chop;
        s/[^\w\s]//g if $dict;
        $_ = lc $_ if $fold;
@@ -56,19 +59,19 @@ sub look {
        }
     }
     $min *= $blksize;
-    seek(FH,$min,0)
+    seek($fh,$min,0)
        or return -1;
-    <FH> if $min;
+    <$fh> if $min;
     for (;;) {
-       $min = tell(FH);
-       defined($_ = <FH>)
+       $min = tell($fh);
+       defined($_ = <$fh>)
            or last;
        chop;
        s/[^\w\s]//g if $dict;
        $_ = lc $_ if $fold;
        last if $_ ge $key;
     }
-    seek(FH,$min,0);
+    seek($fh,$min,0);
     $min;
 }
 
index 5f56922..08104f4 100644 (file)
@@ -1,5 +1,7 @@
 package SelectSaver;
 
+our $VERSION = '1.00';
+
 =head1 NAME
 
 SelectSaver - save and restore selected file handle
index 0954000..6d31ab7 100644 (file)
@@ -1,7 +1,9 @@
 package Term::Cap;
 use Carp;
 
-# Last updated: Thu Dec 14 20:02:42 CST 1995 by sanders@bsdi.com
+our $VERSION = '1.00';
+
+# Last updated: Thu Nov 30 23:34:29 EST 2000 by schwern@pobox.com
 
 # TODO:
 # support Berkeley DB termcaps
index 445dfca..6cf6a0c 100644 (file)
@@ -2,8 +2,10 @@ package Term::Complete;
 require 5.000;
 require Exporter;
 
-@ISA = qw(Exporter);
-@EXPORT = qw(Complete);
+use strict;
+our @ISA = qw(Exporter);
+our @EXPORT = qw(Complete);
+our $VERSION = '1.2';
 
 #      @(#)complete.pl,v1.2            (me@anywhere.EBay.Sun.COM) 09/23/91
 
@@ -64,6 +66,7 @@ Wayne Thompson
 
 =cut
 
+our($complete, $kill, $erase1, $erase2);
 CONFIG: {
     $complete = "\004";
     $kill     = "\025";
@@ -72,7 +75,7 @@ CONFIG: {
 }
 
 sub Complete {
-    my($prompt, @cmp_list, $cmp, $test, $l, @match);
+    my($prompt, @cmp_lst, $cmp, $test, $l, @match);
     my ($return, $r) = ("", 0);
 
     $return = "";
index fc78d7b..491ce79 100644 (file)
@@ -159,10 +159,13 @@ particular used C<Term::ReadLine::*> package).
 
 =cut
 
+use strict;
+
 package Term::ReadLine::Stub;
-@ISA = qw'Term::ReadLine::Tk Term::ReadLine::TermCap';
+our @ISA = qw'Term::ReadLine::Tk Term::ReadLine::TermCap';
 
 $DB::emacs = $DB::emacs;       # To peacify -w
+our @rl_term_set;
 *rl_term_set = \@Term::ReadLine::TermCap::rl_term_set;
 
 sub ReadLine {'Term::ReadLine::Stub'}
@@ -208,7 +211,7 @@ sub findConsole {
       }
     }
 
-    $consoleOUT = $console;
+    my $consoleOUT = $console;
     $console = "&STDIN" unless defined $console;
     if (!defined $consoleOUT) {
       $consoleOUT = defined fileno(STDERR) ? "&STDERR" : "&STDOUT";
@@ -222,19 +225,19 @@ sub new {
   #local (*FIN, *FOUT);
   my ($FIN, $FOUT, $ret);
   if (@_==2) {
-    ($console, $consoleOUT) = findConsole;
+    my($console, $consoleOUT) = findConsole;
 
     open(FIN, "<$console"); 
     open(FOUT,">$consoleOUT");
     #OUT->autoflush(1);                # Conflicts with debugger?
-    $sel = select(FOUT);
+    my $sel = select(FOUT);
     $| = 1;                            # for DB::OUT
     select($sel);
     $ret = bless [\*FIN, \*FOUT];
   } else {                     # Filehandles supplied
     $FIN = $_[2]; $FOUT = $_[3];
     #OUT->autoflush(1);                # Conflicts with debugger?
-    $sel = select($FOUT);
+    my $sel = select($FOUT);
     $| = 1;                            # for DB::OUT
     select($sel);
     $ret = bless [$FIN, $FOUT];
@@ -266,6 +269,8 @@ sub Features { \%features }
 
 package Term::ReadLine;                # So late to allow the above code be defined?
 
+our $VERSION = '1.00';
+
 my ($which) = exists $ENV{PERL_RL} ? split /\s+/, $ENV{PERL_RL} : undef;
 if ($which) {
   if ($which =~ /\bgnu\b/i){
@@ -285,7 +290,7 @@ if ($which) {
 
 # To make possible switch off RL in debugger: (Not needed, work done
 # in debugger).
-
+our @ISA;
 if (defined &Term::ReadLine::Gnu::readline) {
   @ISA = qw(Term::ReadLine::Gnu Term::ReadLine::Stub);
 } elsif (defined &Term::ReadLine::Perl::readline) {
@@ -298,10 +303,11 @@ package Term::ReadLine::TermCap;
 
 # Prompt-start, prompt-end, command-line-start, command-line-end
 #     -- zero-width beautifies to emit around prompt and the command line.
-@rl_term_set = ("","","","");
+our @rl_term_set = ("","","","");
 # string encoded:
-$rl_term_set = ',,,';
+our $rl_term_set = ',,,';
 
+our $terminal;
 sub LoadTermCap {
   return if defined $terminal;
   
@@ -329,8 +335,10 @@ sub ornaments {
 
 package Term::ReadLine::Tk;
 
+our($count_handle, $count_DoOne, $count_loop);
 $count_handle = $count_DoOne = $count_loop = 0;
 
+our($giveup);
 sub handle {$giveup = 1; $count_handle++}
 
 sub Tk_loop {
index d4f12d0..08143fe 100644 (file)
@@ -2,6 +2,8 @@ package Text::Abbrev;
 require 5.005;         # Probably works on earlier versions too.
 require Exporter;
 
+our $VERSION = '1.00';
+
 =head1 NAME
 
 abbrev - create an abbreviation table from a list
index 2244711..7399d8b 100644 (file)
@@ -1,5 +1,7 @@
 package Tie::Hash;
 
+our $VERSION = '1.00';
+
 =head1 NAME
 
 Tie::Hash, Tie::StdHash - base class definitions for tied hashes
index d4111d9..8555635 100644 (file)
@@ -1,5 +1,7 @@
 package Tie::RefHash;
 
+our $VERSION = '1.21';
+
 =head1 NAME
 
 Tie::RefHash - use references as hash keys
index 89ad03e..39480c8 100644 (file)
@@ -1,5 +1,7 @@
 package Tie::Scalar;
 
+our $VERSION = '1.00';
+
 =head1 NAME
 
 Tie::Scalar, Tie::StdScalar - base class definitions for tied scalars
index b8f6449..3b92bd1 100644 (file)
@@ -1,5 +1,7 @@
 package Tie::SubstrHash;
 
+our $VERSION = '1.00';
+
 =head1 NAME
 
 Tie::SubstrHash - Fixed-table-size, fixed-key-length hashing
index a480884..9c81209 100644 (file)
@@ -2,23 +2,25 @@ package Time::Local;
 require 5.000;
 require Exporter;
 use Carp;
+use strict;
 
-@ISA           = qw( Exporter );
-@EXPORT                = qw( timegm timelocal );
-@EXPORT_OK     = qw( timegm_nocheck timelocal_nocheck );
+our $VERSION    = '1.00';
+our @ISA       = qw( Exporter );
+our @EXPORT    = qw( timegm timelocal );
+our @EXPORT_OK = qw( timegm_nocheck timelocal_nocheck );
 
 # Set up constants
-    $SEC  = 1;
-    $MIN  = 60 * $SEC;
-    $HR   = 60 * $MIN;
-    $DAY  = 24 * $HR;
+our $SEC  = 1;
+our $MIN  = 60 * $SEC;
+our $HR   = 60 * $MIN;
+our $DAY  = 24 * $HR;
 # Determine breakpoint for rolling century
-    my $thisYear = (localtime())[5];
-    $nextCentury = int($thisYear / 100) * 100;
-    $breakpoint = ($thisYear + 50) % 100;
-    $nextCentury += 100 if $breakpoint < 50;
+    my $ThisYear = (localtime())[5];
+    my $NextCentury = int($ThisYear / 100) * 100;
+    my $Breakpoint = ($ThisYear + 50) % 100;
+       $NextCentury += 100 if $Breakpoint < 50;
 
-my %options;
+our(%Options, %Cheat);
 
 sub timegm {
     my (@date) = @_;
@@ -26,11 +28,11 @@ sub timegm {
         $date[5] -= 1900;
     }
     elsif ($date[5] >= 0 && $date[5] < 100) {
-        $date[5] -= 100 if $date[5] > $breakpoint;
-        $date[5] += $nextCentury;
+        $date[5] -= 100 if $date[5] > $Breakpoint;
+        $date[5] += $NextCentury;
     }
-    $ym = pack(C2, @date[5,4]);
-    $cheat = $cheat{$ym} || &cheat(@date);
+    my $ym = pack('C2', @date[5,4]);
+    my $cheat = $Cheat{$ym} || &cheat($ym, @date);
     $cheat
     + $date[0] * $SEC
     + $date[1] * $MIN
@@ -39,7 +41,7 @@ sub timegm {
 }
 
 sub timegm_nocheck {
-    local $options{no_range_check} = 1;
+    local $Options{no_range_check} = 1;
     &timegm;
 }
 
@@ -71,59 +73,61 @@ sub timelocal {
 
     $tzsec += $HR if($lt[8]);
     
-    $time = $t + $tzsec;
-    @test = localtime($time + ($tt - $t));
+    my $time = $t + $tzsec;
+    my @test = localtime($time + ($tt - $t));
     $time -= $HR if $test[2] != $_[2];
     $time;
 }
 
 sub timelocal_nocheck {
-    local $options{no_range_check} = 1;
+    local $Options{no_range_check} = 1;
     &timelocal;
 }
 
 sub cheat {
-    $year = $_[5];
-    $month = $_[4];
-    unless ($options{no_range_check}) {
+    my($ym, @date) = @_;
+    my($sec, $min, $hour, $day, $month, $year) = @date;
+    unless ($Options{no_range_check}) {
        croak "Month '$month' out of range 0..11" if $month > 11 || $month < 0;
-       croak "Day '$_[3]' out of range 1..31"    if $_[3] > 31 || $_[3] < 1;
-       croak "Hour '$_[2]' out of range 0..23"   if $_[2] > 23 || $_[2] < 0;
-       croak "Minute '$_[1]' out of range 0..59" if $_[1] > 59 || $_[1] < 0;
-       croak "Second '$_[0]' out of range 0..59" if $_[0] > 59 || $_[0] < 0;
+       croak "Day '$day' out of range 1..31"     if $day > 31  || $day < 1;
+       croak "Hour '$hour' out of range 0..23"   if $hour > 23 || $hour < 0;
+       croak "Minute '$min' out of range 0..59" if $min > 59   || $min < 0;
+       croak "Second '$sec' out of range 0..59" if $sec > 59   || $sec < 0;
     }
-    $guess = $^T;
-    @g = gmtime($guess);
-    $lastguess = "";
-    $counter = 0;
-    while ($diff = $year - $g[5]) {
-       croak "Can't handle date (".join(", ",@_).")" if ++$counter > 255;
+    my $guess = $^T;
+    my @g = gmtime($guess);
+    my $lastguess = "";
+    my $counter = 0;
+    while (my $diff = $year - $g[5]) {
+        my $thisguess;
+       croak "Can't handle date (".join(", ",@date).")" if ++$counter > 255;
        $guess += $diff * (363 * $DAY);
        @g = gmtime($guess);
        if (($thisguess = "@g") eq $lastguess){
-           croak "Can't handle date (".join(", ",@_).")";
+           croak "Can't handle date (".join(", ",@date).")";
            #date beyond this machine's integer limit
        }
        $lastguess = $thisguess;
     }
-    while ($diff = $month - $g[4]) {
-       croak "Can't handle date (".join(", ",@_).")" if ++$counter > 255;
+    while (my $diff = $month - $g[4]) {
+        my $thisguess;
+       croak "Can't handle date (".join(", ",@date).")" if ++$counter > 255;
        $guess += $diff * (27 * $DAY);
        @g = gmtime($guess);
        if (($thisguess = "@g") eq $lastguess){
-           croak "Can't handle date (".join(", ",@_).")";
+           croak "Can't handle date (".join(", ",@date).")";
            #date beyond this machine's integer limit
        }
        $lastguess = $thisguess;
     }
-    @gfake = gmtime($guess-1); #still being sceptic
+    my @gfake = gmtime($guess-1); #still being sceptic
     if ("@gfake" eq $lastguess){
-        croak "Can't handle date (".join(", ",@_).")";
+        croak "Can't handle date (".join(", ",@date).")";
         #date beyond this machine's integer limit
     }
     $g[3]--;
     $guess -= $g[0] * $SEC + $g[1] * $MIN + $g[2] * $HR + $g[3] * $DAY;
-    $cheat{$ym} = $guess;
+    $Cheat{$ym} = $guess;
 }
 
 1;
index fd47ad1..2c308eb 100644 (file)
@@ -1,6 +1,8 @@
 package Time::tm;
 use strict;
 
+our $VERSION = '1.00';
+
 use Class::Struct qw(struct);
 struct('Time::tm' => [
      map { $_ => '$' } qw{ sec min hour mday mon year wday yday isdst }
index f2f1fe9..a66f8d5 100644 (file)
@@ -1,5 +1,7 @@
 package UNIVERSAL;
 
+our $VERSION = '1.00';
+
 # UNIVERSAL should not contain any extra subs/methods beyond those
 # that it exists to define. The use of Exporter below is a historical
 # accident that should be fixed sometime.
index 95e4189..fd6fe56 100644 (file)
@@ -2,6 +2,7 @@ package User::grent;
 use strict;
 
 use 5.005_64;
+our $VERSION = '1.00';
 our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS);
 BEGIN { 
     use Exporter   ();
index 8c05926..edd5f51 100644 (file)
@@ -1,6 +1,7 @@
 package User::pwent;
 
 use 5.006;
+our $VERSION = '1.00';
 
 use strict;
 use warnings;
index f2f7e01..3b0268e 100644 (file)
@@ -1,5 +1,7 @@
 package bytes;
 
+our $VERSION = '1.00';
+
 $bytes::hint_bits = 0x00000008;
 
 sub import {
index 0ec7ec2..934fafd 100644 (file)
@@ -1,4 +1,7 @@
 package charnames;
+
+our $VERSION = '1.00';
+
 use bytes ();          # for $bytes::hint_bits
 use warnings();
 $charnames::hint_bits = 0x20000;
index 884ea3c..f3e60f5 100755 (executable)
@@ -171,7 +171,7 @@ use strict;
 use 5.005_64;
 use Carp;
 
-our $VERSION = v1.0;
+our $VERSION = 1.0;
 our $DEBUG;
 our $VERBOSE;
 our $PRETTY;
index b52a9b4..21252f3 100644 (file)
@@ -1,5 +1,7 @@
 package filetest;
 
+our $VERSION = '1.00';
+
 =head1 NAME
 
 filetest - Perl pragma to control the filetest permission operators
index 86afcaf..f019fb3 100644 (file)
@@ -1,5 +1,7 @@
 package integer;
 
+our $VERSION = '1.00';
+
 =head1 NAME
 
 integer - Perl pragma to compute arithmetic in integer instead of double
index b3afef0..de0ac8f 100644 (file)
@@ -1,5 +1,7 @@
 package less;
 
+our $VERSION = '0.01';
+
 =head1 NAME
 
 less - perl pragma to request less of something from the compiler
index 6314aca..3e5054c 100644 (file)
@@ -1,5 +1,7 @@
 package locale;
 
+our $VERSION = '1.00';
+
 =head1 NAME
 
 locale - Perl pragma to use and avoid POSIX locales for built-in operations
index 82b043a..1e073c2 100644 (file)
@@ -7,6 +7,8 @@ use vars qw(%layers @layers);
 # Populate hash in non-PerlIO case
 %layers = (crlf => 1, raw => 0) unless (@layers);
 
+our $VERSION = '1.00';
+
 sub import {
     shift;
     die "`use open' needs explicit list of disciplines" unless @_;
index 2b0b99d..69092a0 100644 (file)
@@ -1,5 +1,7 @@
 package overload;
 
+our $VERSION = '1.00';
+
 $overload::hint_bits = 0x20000;
 
 sub nil {}
index aa332a6..e5a9aa8 100644 (file)
@@ -1,5 +1,7 @@
 package subs;
 
+our $VERSION = '1.00';
+
 =head1 NAME
 
 subs - Perl pragma to predeclare sub names
index 6d6c0eb..f06b893 100644 (file)
@@ -4,6 +4,8 @@ if (ord('A') != 193) { # make things more pragmatic for EBCDIC folk
 
 $utf8::hint_bits = 0x00800000;
 
+our $VERSION = '1.00';
+
 sub import {
     $^H |= $utf8::hint_bits;
     $enc{caller()} = $_[1] if $_[1];
index 39a15bd..d39f197 100644 (file)
@@ -2,6 +2,8 @@ package vars;
 
 require 5.002;
 
+our $VERSION = '1.00';
+
 # The following require can't be removed during maintenance
 # releases, sadly, because of the risk of buggy code that does
 # require Carp; Carp::croak "..."; without brackets dying
index f98075a..d40da36 100644 (file)
@@ -1,5 +1,7 @@
 package warnings::register ;
 
+our $VERSION = '1.00';
+
 =pod
 
 =head1 NAME
index 440122c..18a02ab 100644 (file)
@@ -11,9 +11,12 @@ BEGIN {
     }
 }
 
+use warnings;
+no warnings qw(deprecated);     # else attrs cries.
+
 sub NTESTS () ;
 
-my $test, $ntests;
+my ($test, $ntests);
 BEGIN {$ntests=0}
 $test=0;
 my $failed = 0;
@@ -119,7 +122,7 @@ BEGIN {++$ntests}
 
 {
     my $w = "" ;
-    local $SIG{__WARN__} = sub {$w = @_[0]} ;
+    local $SIG{__WARN__} = sub {$w = shift} ;
     eval 'sub w1 ($) { use warnings "deprecated"; use attrs "locked"; $_[0]++ }';
     (print "not "), $failed=1 if $@;
     print "ok ",++$test,"\n";
index 05d8b22..04adb6b 100755 (executable)
@@ -24,6 +24,10 @@ BEGIN {
 
 use Sys::Syslog qw(:DEFAULT setlogsock);
 
+# Test this to 1 if your syslog accepts udp connections.
+# Most don't (or at least shouldn't)
+my $Test_Syslog_INET = 0;
+
 print "1..6\n";
 
 if (Sys::Syslog::_PATH_LOG()) {
@@ -45,6 +49,15 @@ else {
     for (1..3) { print "ok $_ # skipping, _PATH_LOG unavailable\n" }
 }
 
-print defined(eval { setlogsock('inet') }) ? "ok 4\n" : "not ok 4\n";
-print defined(eval { openlog('perl', 'ndelay', 'local0') }) ? "ok 5\n" : "not ok 5\n";
-print defined(eval { syslog('info', 'test') }) ? "ok 6\n" : "not ok 6\n";
+if( $Test_Syslog_INET ) {
+    print defined(eval { setlogsock('inet') }) ? "ok 4\n" 
+                                               : "not ok 4\n";
+    print defined(eval { openlog('perl', 'ndelay', 'local0') }) ? "ok 5\n" 
+                                                                : "not ok 5\n";
+    print defined(eval { syslog('info', 'test') }) ? "ok 6\n" 
+                                                   : "not ok 6\n";
+}
+else {
+    print "ok $_ # skipped(assuming syslog doesn't accept inet connections)\n" 
+      foreach (4..6);
+}
index 0c2d2ec..be520ee 100644 (file)
@@ -1,5 +1,7 @@
 #!/usr/bin/perl
 
+our $VERSION = '1.00';
+
 BEGIN {
   push @INC, './lib';
 }
@@ -327,6 +329,8 @@ __END__
 
 package warnings;
 
+our $VERSION = '1.00';
+
 =head1 NAME
 
 warnings - Perl pragma to control optional warnings