summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChris Williams <chris@bingosnet.co.uk>2010-04-22 22:37:09 +0100
committerJesse Vincent <jesse@bestpractical.com>2010-05-07 14:12:41 -0400
commit34d43d09d1ae6c52dc4261f05c8307d457dd2abb (patch)
treedaeafd1c48c87c670486d8229f96d38d4c84a5b4
parentf0c183a58af9ad9bc77b19cffa6e484922856ee8 (diff)
downloadperl-34d43d09d1ae6c52dc4261f05c8307d457dd2abb.tar.gz
Fixes and new functions for Module::CoreList
Fixed functions will edge-case involving querying for Module::CoreList itself. Pointed out by Ilmari. Added removed_from() and removed_from_by_date() functions for querying which release a module was removed from core. Amended corelist utility to use new removed from functions when stating when a module entered core ( and when it left it ). Added tests to the testsuite to cover the edge-cases and new funcs. (cherry picked from commit 044d64a877be884e81013d53b56accbddfe731cc)
-rw-r--r--dist/Module-CoreList/corelist7
-rw-r--r--dist/Module-CoreList/lib/Module/CoreList.pm38
-rw-r--r--dist/Module-CoreList/t/corelist.t38
-rw-r--r--dist/Module-CoreList/t/find_modules.t5
4 files changed, 83 insertions, 5 deletions
diff --git a/dist/Module-CoreList/corelist b/dist/Module-CoreList/corelist
index f1210e8454..08f198f4ac 100644
--- a/dist/Module-CoreList/corelist
+++ b/dist/Module-CoreList/corelist
@@ -173,10 +173,15 @@ sub module_version {
my $msg = $mod;
$msg .= " $ver" if $ver;
+ my $rem = $Opts{d}
+ ? Module::CoreList->removed_from_by_date($mod)
+ : Module::CoreList->removed_from($mod);
+
if( defined $ret ) {
$msg .= " was ";
$msg .= "first " unless $ver;
- $msg .= "released with perl $ret"
+ $msg .= "released with perl " . format_perl_version($ret);
+ $msg .= " and removed from " . format_perl_version($rem) if $rem;
} else {
$msg .= " was not in CORE (or so I think)";
}
diff --git a/dist/Module-CoreList/lib/Module/CoreList.pm b/dist/Module-CoreList/lib/Module/CoreList.pm
index 11df5ebc28..a78549fe26 100644
--- a/dist/Module-CoreList/lib/Module/CoreList.pm
+++ b/dist/Module-CoreList/lib/Module/CoreList.pm
@@ -82,6 +82,18 @@ Available in version 2.22 and above.
Returns true if MODULE is marked as deprecated in PERL_VERSION. If PERL_VERSION is
omitted, it defaults to the current version of Perl.
+=item C<removed_from( MODULE )>
+
+Takes a module name as an argument, returns the first perl version where that module
+was removed from core. Returns undef if the given module was never in core or remains
+in core.
+
+=item C<removed_from_by_date( MODULE )>
+
+Takes a module name as an argument, returns the first perl version by release date where that module
+was removed from core. Returns undef if the given module was never in core or remains
+in core.
+
=back
=head1 DATA STRUCTURES
@@ -193,7 +205,8 @@ END {
sub first_release_raw {
my $module = shift;
- $module = shift if $module->isa(__PACKAGE__);
+ $module = shift if $module->isa(__PACKAGE__)
+ and scalar @_ and $_[0] =~ m#\A[a-zA-Z_][0-9a-zA-Z_]*(?:(::|')[0-9a-zA-Z_]+)*\z#;
my $version = shift;
my @perls = $version
@@ -240,13 +253,34 @@ sub find_version {
sub is_deprecated {
my $module = shift;
- $module = shift if $module->isa(__PACKAGE__);
+ $module = shift if $module->isa(__PACKAGE__)
+ and scalar @_ and $_[0] =~ m#\A[a-zA-Z_][0-9a-zA-Z_]*(?:(::|')[0-9a-zA-Z_]+)*\z#;
my $perl_version = shift;
$perl_version ||= $];
return unless $module && exists $deprecated{$perl_version}{$module};
return $deprecated{$perl_version}{$module};
}
+sub removed_from {
+ my @perls = &removed_raw;
+ return shift @perls;
+}
+
+sub removed_from_by_date {
+ my @perls = sort { $released{$a} cmp $released{$b} } &removed_raw;
+ return shift @perls;
+}
+
+sub removed_raw {
+ my $mod = shift;
+ $mod = shift if $mod->isa(__PACKAGE__)
+ and scalar @_ and $_[0] =~ m#\A[a-zA-Z_][0-9a-zA-Z_]*(?:(::|')[0-9a-zA-Z_]+)*\z#;
+ return unless my @perls = sort { $a cmp $b } first_release_raw($mod);
+ my $last = pop @perls;
+ my @removed = grep { $_ > $last } sort { $a cmp $b } keys %version;
+ return @removed;
+}
+
# When things escaped.
# NB. If you put version numbers with trailing zeroes here, you
# should also add an alias for the numerical ($]) version; see
diff --git a/dist/Module-CoreList/t/corelist.t b/dist/Module-CoreList/t/corelist.t
index a79e58c1d3..0b85904e1c 100644
--- a/dist/Module-CoreList/t/corelist.t
+++ b/dist/Module-CoreList/t/corelist.t
@@ -1,7 +1,7 @@
#!perl -w
use strict;
use Module::CoreList;
-use Test::More tests => 13;
+use Test::More tests => 24;
BEGIN { require_ok('Module::CoreList'); }
@@ -29,6 +29,15 @@ is(Module::CoreList->first_release('File::Spec'), 5.00405,
is(Module::CoreList->first_release('File::Spec', 0.82), 5.006_001,
"File::Spec reached 0.82 with 5.006_001");
+is(Module::CoreList::first_release_by_date('File::Spec'), 5.005,
+ "File::Spec was first bundled in 5.005");
+
+is(Module::CoreList::first_release('File::Spec'), 5.00405,
+ "File::Spec was released in perl with lowest version number 5.00405");
+
+is(Module::CoreList::first_release('File::Spec', 0.82), 5.006_001,
+ "File::Spec reached 0.82 with 5.006_001");
+
is_deeply([ sort keys %Module::CoreList::released ],
[ sort keys %Module::CoreList::version ],
"have a note of everythings release");
@@ -50,3 +59,30 @@ for my $family (values %Module::CoreList::families) {
}
is( $consistent, 1,
"families seem consistent (descendants have same modules as ancestors)" );
+
+# Check the function API for consistency
+
+is(Module::CoreList->first_release_by_date('Module::CoreList'), 5.009002,
+ "Module::CoreList was first bundled in 5.009002");
+
+is(Module::CoreList->first_release('Module::CoreList'), 5.008009,
+ "Module::CoreList was released in perl with lowest version number 5.008009");
+
+is(Module::CoreList->first_release('Module::CoreList', 2.18), 5.010001,
+ "Module::CoreList reached 2.18 with 5.010001");
+
+is(Module::CoreList::first_release_by_date('Module::CoreList'), 5.009002,
+ "Module::CoreList was first bundled in 5.009002");
+
+is(Module::CoreList::first_release('Module::CoreList'), 5.008009,
+ "Module::CoreList was released in perl with lowest version number 5.008009");
+
+is(Module::CoreList::first_release('Module::CoreList', 2.18), 5.010001,
+ "Module::CoreList reached 2.18 with 5.010001");
+
+is(Module::CoreList->removed_from('CPANPLUS::inc'), 5.010001,
+ "CPANPLUS::inc was removed from 5.010001");
+
+is(Module::CoreList::removed_from('CPANPLUS::inc'), 5.010001,
+ "CPANPLUS::inc was removed from 5.010001");
+
diff --git a/dist/Module-CoreList/t/find_modules.t b/dist/Module-CoreList/t/find_modules.t
index 243e0dcdda..4dbb8c26fc 100644
--- a/dist/Module-CoreList/t/find_modules.t
+++ b/dist/Module-CoreList/t/find_modules.t
@@ -1,7 +1,7 @@
#!perl -w
use strict;
use Module::CoreList;
-use Test::More tests => 5;
+use Test::More tests => 6;
BEGIN { require_ok('Module::CoreList'); }
@@ -18,3 +18,6 @@ is_deeply([ Module::CoreList->find_modules(qr/Module::/, 5.008008) ], [], 'qr/Mo
is_deeply([ Module::CoreList->find_modules(qr/Test::H.*::.*s/, 5.006001, 5.007003) ],
[ qw(Test::Harness::Assert Test::Harness::Straps) ],
'qr/Test::H.*::.*s/ at 5.006001 and 5.007003');
+
+is_deeply([ Module::CoreList::find_modules(qr/Module::CoreList/) ], [ qw(Module::CoreList) ],
+ 'Module::CoreList functional' );