diff --git a/lib/Dist/Requires.pm b/lib/Dist/Requires.pm index 47878a1..cffb605 100644 --- a/lib/Dist/Requires.pm +++ b/lib/Dist/Requires.pm @@ -100,6 +100,30 @@ has filter => ( #----------------------------------------------------------------------------- +=attr filter_installed => $ARRAYREF + +Given an arrayref of paths to search (for example, C<\@INC>), any distribution +requirements that have the same version or less than those found +installed in the search path will be excluded from the output. + +=cut + +has filter_installed => ( + is => 'ro', + isa => 'ArrayRef', + default => sub { [] }, +); + +# internal cache +has _installed_versions => ( + is => 'ro', + isa => 'HashRef', + init_arg => undef, + default => sub { +{} }, +); + +#----------------------------------------------------------------------------- + sub _build_filter { my ($self) = @_; @@ -292,8 +316,15 @@ sub _extract_requires { sub _filter_requires { my ($self, %requires) = @_; - my $filter = $self->filter(); + # break reference + my $filter = { %{ $self->filter() } }; + my $check_installed = @{ $self->filter_installed() }; + while ( my ($package, $version) = each %requires ) { + if ( $check_installed && ! exists $filter->{$package} ) { + my ($found, $have) = $self->_find_installed_version($package); + $filter->{$package} = $have if $found; + } next if not exists $filter->{$package}; delete $requires{$package} if $version <= $filter->{$package}; }; @@ -306,6 +337,22 @@ sub _filter_requires { #----------------------------------------------------------------------------- +sub _find_installed_version { + my ($self, $module) = @_; + + my $version = $self->_installed_versions->{$module} ||= do { + require Module::Metadata; + my $meta = Module::Metadata->new_from_module($module, inc => $self->filter_installed) + # short-circuit + or return (0, undef); + (__versionize_values($module => $meta->version))[1]; + }; + + return (1, $version); +} + +#----------------------------------------------------------------------------- + sub _run_cmd { my ( $self, $cmd ) = @_; diff --git a/t/01-functional.t b/t/01-functional.t index f2cbaa7..6107d45 100644 --- a/t/01-functional.t +++ b/t/01-functional.t @@ -55,6 +55,25 @@ my @builders = qw(EUMM MB); } } +#-------------------------------------------------------------------------- +# Filter installed + +{ + my $expect = {Foo => 'v1.0.3', Baz => 0}; + + for my $builder (@builders) { + my $dist = $dists_dir->subdir($builder)->file("$builder-0.1.tar.gz"); + my $dr = Dist::Requires->new(filter_installed => [$dists_dir->subdir('inc')]); + my %got = $dr->prerequisites(dist => $dist); + + # Ignore prereqs imposed by toolchain + delete $got{'ExtUtils::MakeMaker'}; + delete $got{'Module::Build'}; + + is_deeply(\%got, $expect, "Filtered installed prereqs for $dist"); + } +} + #-------------------------------------------------------------------------- # Failures diff --git a/t/dists/inc/Bar.pm b/t/dists/inc/Bar.pm new file mode 100644 index 0000000..e2b56cc --- /dev/null +++ b/t/dists/inc/Bar.pm @@ -0,0 +1,2 @@ +package Bar; +our $VERSION = '1.004_01';