summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/AnyDBM_File.pm1
-rw-r--r--lib/CGI/Apache.pm3
-rw-r--r--lib/CGI/Switch.pm3
-rw-r--r--lib/Carp.pm2
-rw-r--r--lib/Carp/Heavy.pm10
-rw-r--r--lib/DirHandle.pm2
-rw-r--r--lib/Dumpvalue.pm1
-rw-r--r--lib/English.pm2
-rw-r--r--lib/Env.pm2
-rw-r--r--lib/Exporter.pm73
-rw-r--r--lib/Exporter/Heavy.pm70
-rw-r--r--lib/ExtUtils/MM_Cygwin.pm8
-rw-r--r--lib/ExtUtils/MM_OS2.pm8
-rw-r--r--lib/ExtUtils/MM_Unix.pm8
-rw-r--r--lib/ExtUtils/MM_VMS.pm10
-rw-r--r--lib/ExtUtils/MM_Win32.pm6
-rw-r--r--lib/File/CheckTree.pm114
-rw-r--r--lib/File/DosGlob.pm53
-rw-r--r--lib/File/Find.pm6
-rw-r--r--lib/File/stat.pm2
-rw-r--r--lib/FileCache.pm2
-rw-r--r--lib/I18N/Collate.pm12
-rw-r--r--lib/Net/hostent.pm1
-rw-r--r--lib/Net/netent.pm1
-rw-r--r--lib/Net/protoent.pm1
-rw-r--r--lib/Net/servent.pm1
-rw-r--r--lib/Pod/Functions.pm20
-rw-r--r--lib/Pod/Html.pm1
-rw-r--r--lib/Search/Dict.pm27
-rw-r--r--lib/SelectSaver.pm2
-rw-r--r--lib/Term/Cap.pm4
-rw-r--r--lib/Term/Complete.pm9
-rw-r--r--lib/Term/ReadLine.pm24
-rw-r--r--lib/Text/Abbrev.pm2
-rw-r--r--lib/Tie/Hash.pm2
-rw-r--r--lib/Tie/RefHash.pm2
-rw-r--r--lib/Tie/Scalar.pm2
-rw-r--r--lib/Tie/SubstrHash.pm2
-rw-r--r--lib/Time/Local.pm84
-rw-r--r--lib/Time/tm.pm2
-rw-r--r--lib/UNIVERSAL.pm2
-rw-r--r--lib/User/grent.pm1
-rw-r--r--lib/User/pwent.pm1
-rw-r--r--lib/bytes.pm2
-rw-r--r--lib/charnames.pm3
-rwxr-xr-xlib/diagnostics.pm2
-rw-r--r--lib/filetest.pm2
-rw-r--r--lib/integer.pm2
-rw-r--r--lib/less.pm2
-rw-r--r--lib/locale.pm2
-rw-r--r--lib/open.pm2
-rw-r--r--lib/overload.pm2
-rw-r--r--lib/subs.pm2
-rw-r--r--lib/utf8.pm2
-rw-r--r--lib/vars.pm2
-rw-r--r--lib/warnings/register.pm2
56 files changed, 360 insertions, 256 deletions
diff --git a/lib/AnyDBM_File.pm b/lib/AnyDBM_File.pm
index 58ffda768e..ce850491e5 100644
--- a/lib/AnyDBM_File.pm
+++ b/lib/AnyDBM_File.pm
@@ -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;
diff --git a/lib/CGI/Apache.pm b/lib/CGI/Apache.pm
index dced8664b4..550c6e433b 100644
--- a/lib/CGI/Apache.pm
+++ b/lib/CGI/Apache.pm
@@ -1,4 +1,7 @@
use CGI;
+
+our $VERSION = '1.00';
+
1;
__END__
diff --git a/lib/CGI/Switch.pm b/lib/CGI/Switch.pm
index b16b9c0658..e754fdedce 100644
--- a/lib/CGI/Switch.pm
+++ b/lib/CGI/Switch.pm
@@ -1,4 +1,7 @@
use CGI;
+
+our $VERSION = '1.00';
+
1;
__END__
diff --git a/lib/Carp.pm b/lib/Carp.pm
index f7e9bf136a..69d477b486 100644
--- a/lib/Carp.pm
+++ b/lib/Carp.pm
@@ -1,5 +1,7 @@
package Carp;
+our $VERSION = '1.00';
+
=head1 NAME
carp - warn of errors (from perspective of caller)
diff --git a/lib/Carp/Heavy.pm b/lib/Carp/Heavy.pm
index 36bdcd49a3..dac9c751ab 100644
--- a/lib/Carp/Heavy.pm
+++ b/lib/Carp/Heavy.pm
@@ -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;
diff --git a/lib/DirHandle.pm b/lib/DirHandle.pm
index 047755dc17..12ee6c6343 100644
--- a/lib/DirHandle.pm
+++ b/lib/DirHandle.pm
@@ -1,5 +1,7 @@
package DirHandle;
+our $VERSION = '1.00';
+
=head1 NAME
DirHandle - supply object methods for directory handles
diff --git a/lib/Dumpvalue.pm b/lib/Dumpvalue.pm
index 475f4ff725..c8282cfbd5 100644
--- a/lib/Dumpvalue.pm
+++ b/lib/Dumpvalue.pm
@@ -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
diff --git a/lib/English.pm b/lib/English.pm
index 1ebc3de11d..77f27c5b71 100644
--- a/lib/English.pm
+++ b/lib/English.pm
@@ -1,5 +1,7 @@
package English;
+our $VERSION = '1.00';
+
require Exporter;
@ISA = (Exporter);
diff --git a/lib/Env.pm b/lib/Env.pm
index d1ee071cf8..eb9187fc90 100644
--- a/lib/Env.pm
+++ b/lib/Env.pm
@@ -1,5 +1,7 @@
package Env;
+our $VERSION = '1.00';
+
=head1 NAME
Env - perl module that imports environment variables as scalars or arrays
diff --git a/lib/Exporter.pm b/lib/Exporter.pm
index 585109e7d0..ad6cdef87e 100644
--- a/lib/Exporter.pm
+++ b/lib/Exporter.pm
@@ -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
diff --git a/lib/Exporter/Heavy.pm b/lib/Exporter/Heavy.pm
index 6647f7075c..39bce2d85e 100644
--- a/lib/Exporter/Heavy.pm
+++ b/lib/Exporter/Heavy.pm
@@ -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) = @_;
diff --git a/lib/ExtUtils/MM_Cygwin.pm b/lib/ExtUtils/MM_Cygwin.pm
index 439c67ccad..abb491f1a2 100644
--- a/lib/ExtUtils/MM_Cygwin.pm
+++ b/lib/ExtUtils/MM_Cygwin.pm
@@ -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';
diff --git a/lib/ExtUtils/MM_OS2.pm b/lib/ExtUtils/MM_OS2.pm
index 430235a0aa..501832bfec 100644
--- a/lib/ExtUtils/MM_OS2.pm
+++ b/lib/ExtUtils/MM_OS2.pm
@@ -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';
diff --git a/lib/ExtUtils/MM_Unix.pm b/lib/ExtUtils/MM_Unix.pm
index eb3ef70cf7..e926ca7d66 100644
--- a/lib/ExtUtils/MM_Unix.pm
+++ b/lib/ExtUtils/MM_Unix.pm
@@ -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';
diff --git a/lib/ExtUtils/MM_VMS.pm b/lib/ExtUtils/MM_VMS.pm
index e059d8f296..3485786bf8 100644
--- a/lib/ExtUtils/MM_VMS.pm
+++ b/lib/ExtUtils/MM_VMS.pm
@@ -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
diff --git a/lib/ExtUtils/MM_Win32.pm b/lib/ExtUtils/MM_Win32.pm
index 7f40ff7ece..513b110a4d 100644
--- a/lib/ExtUtils/MM_Win32.pm
+++ b/lib/ExtUtils/MM_Win32.pm
@@ -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';
diff --git a/lib/File/CheckTree.pm b/lib/File/CheckTree.pm
index ae1877741b..8b6ae0805a 100644
--- a/lib/File/CheckTree.pm
+++ b/lib/File/CheckTree.pm
@@ -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;
}
diff --git a/lib/File/DosGlob.pm b/lib/File/DosGlob.pm
index d7dea7b46c..3401b5fe9e 100644
--- a/lib/File/DosGlob.pm
+++ b/lib/File/DosGlob.pm
@@ -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__
diff --git a/lib/File/Find.pm b/lib/File/Find.pm
index 3a621c0269..1e33f1edec 100644
--- a/lib/File/Find.pm
+++ b/lib/File/Find.pm
@@ -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;
diff --git a/lib/File/stat.pm b/lib/File/stat.pm
index 0cf7a0b7aa..200af4ef17 100644
--- a/lib/File/stat.pm
+++ b/lib/File/stat.pm
@@ -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);
diff --git a/lib/FileCache.pm b/lib/FileCache.pm
index e1c5ec4c8a..78a3e67c31 100644
--- a/lib/FileCache.pm
+++ b/lib/FileCache.pm
@@ -1,5 +1,7 @@
package FileCache;
+our $VERSION = '1.00';
+
=head1 NAME
FileCache - keep more files open than the system permits
diff --git a/lib/I18N/Collate.pm b/lib/I18N/Collate.pm
index 64a03a284b..d18a5a5710 100644
--- a/lib/I18N/Collate.pm
+++ b/lib/I18N/Collate.pm
@@ -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];
diff --git a/lib/Net/hostent.pm b/lib/Net/hostent.pm
index 6cfde7253c..0a22389302 100644
--- a/lib/Net/hostent.pm
+++ b/lib/Net/hostent.pm
@@ -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 ();
diff --git a/lib/Net/netent.pm b/lib/Net/netent.pm
index b21cd04664..d5ce22ebb3 100644
--- a/lib/Net/netent.pm
+++ b/lib/Net/netent.pm
@@ -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 ();
diff --git a/lib/Net/protoent.pm b/lib/Net/protoent.pm
index 6aad940903..2c3db88e9b 100644
--- a/lib/Net/protoent.pm
+++ b/lib/Net/protoent.pm
@@ -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 ();
diff --git a/lib/Net/servent.pm b/lib/Net/servent.pm
index c892af0bbe..18c7fb5c92 100644
--- a/lib/Net/servent.pm
+++ b/lib/Net/servent.pm
@@ -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 ();
diff --git a/lib/Pod/Functions.pm b/lib/Pod/Functions.pm
index 44619d53d8..960b847394 100644
--- a/lib/Pod/Functions.pm
+++ b/lib/Pod/Functions.pm
@@ -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;
}
}
diff --git a/lib/Pod/Html.pm b/lib/Pod/Html.pm
index f70a42bccc..43168231f3 100644
--- a/lib/Pod/Html.pm
+++ b/lib/Pod/Html.pm
@@ -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
diff --git a/lib/Search/Dict.pm b/lib/Search/Dict.pm
index 9a229a7bc0..58c7543ced 100644
--- a/lib/Search/Dict.pm
+++ b/lib/Search/Dict.pm
@@ -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;
}
diff --git a/lib/SelectSaver.pm b/lib/SelectSaver.pm
index 5f569222fc..08104f47d4 100644
--- a/lib/SelectSaver.pm
+++ b/lib/SelectSaver.pm
@@ -1,5 +1,7 @@
package SelectSaver;
+our $VERSION = '1.00';
+
=head1 NAME
SelectSaver - save and restore selected file handle
diff --git a/lib/Term/Cap.pm b/lib/Term/Cap.pm
index 0954000e8d..6d31ab77c5 100644
--- a/lib/Term/Cap.pm
+++ b/lib/Term/Cap.pm
@@ -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
diff --git a/lib/Term/Complete.pm b/lib/Term/Complete.pm
index 445dfca02a..6cf6a0cfc5 100644
--- a/lib/Term/Complete.pm
+++ b/lib/Term/Complete.pm
@@ -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 = "";
diff --git a/lib/Term/ReadLine.pm b/lib/Term/ReadLine.pm
index fc78d7b6fa..491ce79cbe 100644
--- a/lib/Term/ReadLine.pm
+++ b/lib/Term/ReadLine.pm
@@ -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 {
diff --git a/lib/Text/Abbrev.pm b/lib/Text/Abbrev.pm
index d4f12d0b99..08143fea8f 100644
--- a/lib/Text/Abbrev.pm
+++ b/lib/Text/Abbrev.pm
@@ -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
diff --git a/lib/Tie/Hash.pm b/lib/Tie/Hash.pm
index 2244711669..7399d8b853 100644
--- a/lib/Tie/Hash.pm
+++ b/lib/Tie/Hash.pm
@@ -1,5 +1,7 @@
package Tie::Hash;
+our $VERSION = '1.00';
+
=head1 NAME
Tie::Hash, Tie::StdHash - base class definitions for tied hashes
diff --git a/lib/Tie/RefHash.pm b/lib/Tie/RefHash.pm
index d4111d92e5..8555635691 100644
--- a/lib/Tie/RefHash.pm
+++ b/lib/Tie/RefHash.pm
@@ -1,5 +1,7 @@
package Tie::RefHash;
+our $VERSION = '1.21';
+
=head1 NAME
Tie::RefHash - use references as hash keys
diff --git a/lib/Tie/Scalar.pm b/lib/Tie/Scalar.pm
index 89ad03eddc..39480c8a28 100644
--- a/lib/Tie/Scalar.pm
+++ b/lib/Tie/Scalar.pm
@@ -1,5 +1,7 @@
package Tie::Scalar;
+our $VERSION = '1.00';
+
=head1 NAME
Tie::Scalar, Tie::StdScalar - base class definitions for tied scalars
diff --git a/lib/Tie/SubstrHash.pm b/lib/Tie/SubstrHash.pm
index b8f6449c2c..3b92bd1cee 100644
--- a/lib/Tie/SubstrHash.pm
+++ b/lib/Tie/SubstrHash.pm
@@ -1,5 +1,7 @@
package Tie::SubstrHash;
+our $VERSION = '1.00';
+
=head1 NAME
Tie::SubstrHash - Fixed-table-size, fixed-key-length hashing
diff --git a/lib/Time/Local.pm b/lib/Time/Local.pm
index a4808849b0..9c81209ad3 100644
--- a/lib/Time/Local.pm
+++ b/lib/Time/Local.pm
@@ -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;
diff --git a/lib/Time/tm.pm b/lib/Time/tm.pm
index fd47ad19a9..2c308ebb41 100644
--- a/lib/Time/tm.pm
+++ b/lib/Time/tm.pm
@@ -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 }
diff --git a/lib/UNIVERSAL.pm b/lib/UNIVERSAL.pm
index f2f1fe9e7a..a66f8d5328 100644
--- a/lib/UNIVERSAL.pm
+++ b/lib/UNIVERSAL.pm
@@ -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.
diff --git a/lib/User/grent.pm b/lib/User/grent.pm
index 95e4189c9e..fd6fe568cc 100644
--- a/lib/User/grent.pm
+++ b/lib/User/grent.pm
@@ -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 ();
diff --git a/lib/User/pwent.pm b/lib/User/pwent.pm
index 8c059265c3..edd5f51dc7 100644
--- a/lib/User/pwent.pm
+++ b/lib/User/pwent.pm
@@ -1,6 +1,7 @@
package User::pwent;
use 5.006;
+our $VERSION = '1.00';
use strict;
use warnings;
diff --git a/lib/bytes.pm b/lib/bytes.pm
index f2f7e0157c..3b0268e644 100644
--- a/lib/bytes.pm
+++ b/lib/bytes.pm
@@ -1,5 +1,7 @@
package bytes;
+our $VERSION = '1.00';
+
$bytes::hint_bits = 0x00000008;
sub import {
diff --git a/lib/charnames.pm b/lib/charnames.pm
index 0ec7ec2d21..934fafddd5 100644
--- a/lib/charnames.pm
+++ b/lib/charnames.pm
@@ -1,4 +1,7 @@
package charnames;
+
+our $VERSION = '1.00';
+
use bytes (); # for $bytes::hint_bits
use warnings();
$charnames::hint_bits = 0x20000;
diff --git a/lib/diagnostics.pm b/lib/diagnostics.pm
index 884ea3ca65..f3e60f5897 100755
--- a/lib/diagnostics.pm
+++ b/lib/diagnostics.pm
@@ -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;
diff --git a/lib/filetest.pm b/lib/filetest.pm
index b52a9b484d..21252f35a6 100644
--- a/lib/filetest.pm
+++ b/lib/filetest.pm
@@ -1,5 +1,7 @@
package filetest;
+our $VERSION = '1.00';
+
=head1 NAME
filetest - Perl pragma to control the filetest permission operators
diff --git a/lib/integer.pm b/lib/integer.pm
index 86afcaf130..f019fb3534 100644
--- a/lib/integer.pm
+++ b/lib/integer.pm
@@ -1,5 +1,7 @@
package integer;
+our $VERSION = '1.00';
+
=head1 NAME
integer - Perl pragma to compute arithmetic in integer instead of double
diff --git a/lib/less.pm b/lib/less.pm
index b3afef0fcd..de0ac8f423 100644
--- a/lib/less.pm
+++ b/lib/less.pm
@@ -1,5 +1,7 @@
package less;
+our $VERSION = '0.01';
+
=head1 NAME
less - perl pragma to request less of something from the compiler
diff --git a/lib/locale.pm b/lib/locale.pm
index 6314aca59e..3e5054c99b 100644
--- a/lib/locale.pm
+++ b/lib/locale.pm
@@ -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
diff --git a/lib/open.pm b/lib/open.pm
index 82b043afc8..1e073c2e62 100644
--- a/lib/open.pm
+++ b/lib/open.pm
@@ -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 @_;
diff --git a/lib/overload.pm b/lib/overload.pm
index 2b0b99d3cd..69092a00cf 100644
--- a/lib/overload.pm
+++ b/lib/overload.pm
@@ -1,5 +1,7 @@
package overload;
+our $VERSION = '1.00';
+
$overload::hint_bits = 0x20000;
sub nil {}
diff --git a/lib/subs.pm b/lib/subs.pm
index aa332a6785..e5a9aa8827 100644
--- a/lib/subs.pm
+++ b/lib/subs.pm
@@ -1,5 +1,7 @@
package subs;
+our $VERSION = '1.00';
+
=head1 NAME
subs - Perl pragma to predeclare sub names
diff --git a/lib/utf8.pm b/lib/utf8.pm
index 6d6c0eb503..f06b893a59 100644
--- a/lib/utf8.pm
+++ b/lib/utf8.pm
@@ -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];
diff --git a/lib/vars.pm b/lib/vars.pm
index 39a15bd312..d39f19766e 100644
--- a/lib/vars.pm
+++ b/lib/vars.pm
@@ -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
diff --git a/lib/warnings/register.pm b/lib/warnings/register.pm
index f98075a5ee..d40da36053 100644
--- a/lib/warnings/register.pm
+++ b/lib/warnings/register.pm
@@ -1,5 +1,7 @@
package warnings::register ;
+our $VERSION = '1.00';
+
=pod
=head1 NAME