From: Chris Williams <chris@bingosnet.co.uk>
Date: Thu, 22 Apr 2010 21:37:09 +0000 (+0100)
Subject: Fixes and new functions for Module::CoreList
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=044d64a877be884e81013d53b56accbddfe731cc;p=p5sagit%2Fp5-mst-13.2.git

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.
---

diff --git a/dist/Module-CoreList/corelist b/dist/Module-CoreList/corelist
index f1210e8..08f198f 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 11df5eb..a78549f 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 a79e58c..0b85904 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 243e0dc..4dbb8c2 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' );