In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/044d64a877be884e81013d53b56accbddfe731cc?hp=8162142bfe8ad55439ff878b28c85e654d9a67d3>
- Log ----------------------------------------------------------------- commit 044d64a877be884e81013d53b56accbddfe731cc Author: Chris Williams <[email protected]> Date: Thu Apr 22 22:37:09 2010 +0100 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. ----------------------------------------------------------------------- Summary of changes: dist/Module-CoreList/corelist | 7 ++++- dist/Module-CoreList/lib/Module/CoreList.pm | 38 +++++++++++++++++++++++++- dist/Module-CoreList/t/corelist.t | 38 ++++++++++++++++++++++++++- dist/Module-CoreList/t/find_modules.t | 5 +++- 4 files changed, 83 insertions(+), 5 deletions(-) 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' ); -- Perl5 Master Repository
