From: Michael G. Schwern Date: Tue, 5 Dec 2000 21:23:28 +0000 (-0500) Subject: $VERSION crusade, strict, tests, etc... all over lib/ X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b75c8c73cd7f3c92a16e03fb046f4e2a99363bc7;p=p5sagit%2Fp5-mst-13.2.git $VERSION crusade, strict, tests, etc... all over lib/ Message-ID: <20001205212328.C6473@blackrider.aocn.com> Carp::Heavy parts not very applicable because of recent changes. p4raw-id: //depot/perl@8013 --- diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm index 841120c..6a5e30d 100644 --- a/ext/Opcode/Opcode.pm +++ b/ext/Opcode/Opcode.pm @@ -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 diff --git a/lib/AnyDBM_File.pm b/lib/AnyDBM_File.pm index 58ffda7..ce85049 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 dced866..550c6e4 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 b16b9c0..e754fde 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 f7e9bf1..69d477b 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 36bdcd4..dac9c75 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 047755d..12ee6c6 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 475f4ff..c8282cf 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 1ebc3de..77f27c5 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 d1ee071..eb9187f 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 585109e..ad6cdef 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('',)) 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 6647f70..39bce2d 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 439c67c..abb491f 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 430235a..501832b 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 eb3ef70..e926ca7 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 e059d8f..3485786 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 7f40ff7..513b110 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 ae18777..8b6ae08 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 d7dea7b..3401b5f 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 3a621c0..1e33f1e 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 0cf7a0b..200af4e 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 e1c5ec4..78a3e67 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 64a03a2..d18a5a5 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 6cfde72..0a22389 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 b21cd04..d5ce22e 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 6aad940..2c3db88 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 c892af0..18c7fb5 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 44619d5..960b847 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 () { 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 f70a42b..4316823 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 9a229a7..58c7543 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; - if $mid; # probably a partial line - $_ = ; + <$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; - if $min; + <$fh> if $min; for (;;) { - $min = tell(FH); - defined($_ = ) + $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 5f56922..08104f4 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 0954000..6d31ab7 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 445dfca..6cf6a0c 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 fc78d7b..491ce79 100644 --- a/lib/Term/ReadLine.pm +++ b/lib/Term/ReadLine.pm @@ -159,10 +159,13 @@ particular used C 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 d4f12d0..08143fe 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 2244711..7399d8b 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 d4111d9..8555635 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 89ad03e..39480c8 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 b8f6449..3b92bd1 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 a480884..9c81209 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 fd47ad1..2c308eb 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 f2f1fe9..a66f8d5 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 95e4189..fd6fe56 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 8c05926..edd5f51 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 f2f7e01..3b0268e 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 0ec7ec2..934fafd 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 884ea3c..f3e60f5 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 b52a9b4..21252f3 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 86afcaf..f019fb3 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 b3afef0..de0ac8f 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 6314aca..3e5054c 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 82b043a..1e073c2 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 2b0b99d..69092a0 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 aa332a6..e5a9aa8 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 6d6c0eb..f06b893 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 39a15bd..d39f197 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 f98075a..d40da36 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 diff --git a/t/lib/attrs.t b/t/lib/attrs.t index 440122c..18a02ab 100644 --- a/t/lib/attrs.t +++ b/t/lib/attrs.t @@ -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"; diff --git a/t/lib/syslog.t b/t/lib/syslog.t index 05d8b22..04adb6b 100755 --- a/t/lib/syslog.t +++ b/t/lib/syslog.t @@ -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); +} diff --git a/warnings.pl b/warnings.pl index 0c2d2ec..be520ee 100644 --- a/warnings.pl +++ b/warnings.pl @@ -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