From b93e5536ce5c3bc01c4ef9b5dc8ebe31eef6f214 Mon Sep 17 00:00:00 2001 From: Paul Cochrane Date: Fri, 29 Jul 2016 17:32:15 +0200 Subject: [PATCH 1/3] Add 'dirs' option to module_path() As requested in issue #17, being able to search in a list of user-supplied directories instead of just in `@INC` would be helpful. This implements the functionality in the main module and updates the POD and tests appropriately. --- lib/Module/Path.pm | 24 ++++++++++++++++++------ t/02-module-path.t | 30 +++++++++++++++++++++++++++++- 2 files changed, 47 insertions(+), 7 deletions(-) diff --git a/lib/Module/Path.pm b/lib/Module/Path.pm index db569b7..d9d02c4 100644 --- a/lib/Module/Path.pm +++ b/lib/Module/Path.pm @@ -26,15 +26,18 @@ BEGIN { sub module_path { - my $module = shift; + my ($module, $options) = @_; my $relpath; my $fullpath; ($relpath = $module) =~ s/::/$SEPARATOR/g; $relpath .= '.pm' unless $relpath =~ m!\.pm$!; + my @dirs_to_check = + $options->{'dirs'} ? @{$options->{'dirs'}} : @INC; + DIRECTORY: - foreach my $dir (@INC) { + foreach my $dir (@dirs_to_check) { next DIRECTORY if not defined($dir); # see 'perldoc -f require' on why you might find @@ -76,15 +79,24 @@ Module::Path - get the full path to a locally installed module print "Danger Will Robinson!\n"; } + # specify a directory to search in, instead of @INC + $path = module_path('Test::More', { dirs => ['my/local/path'] }); + if (defined($path)) { + print "Test::More found at $path\n"; + } else { + print "Here be dragons!\n"; + } + =head1 DESCRIPTION This module provides a single function, C, which takes a module name and finds the first directory in your C<@INC> path +(or a path specified via the C option) where the module is installed locally. It returns the full path to that file, resolving any symlinks. It is portable and only depends on core modules. -It works by looking in all the directories in C<@INC> +It works by looking in all the directories in the search path (by default C<@INC>) for an appropriately named file: =over 4 @@ -96,19 +108,19 @@ separator for your operating system. =item -Iterate over C<@INC>, ignoring any references +Iterate over the search paths, ignoring any references (see L<"perlfunc"/"require"> if you're surprised to hear that you might find references in C<@INC>). =item -For each directory in C<@INC>, append the partial path (C), +For each directory in the search paths, append the partial path (C), again using the correct directory path separator. If the resulting file exists, return this path. =item -If a directory in C<@INC> is a symlink, then we resolve the path, +If a directory in the given search paths is a symlink, then we resolve the path, and return a path containing the linked-to directory. =item diff --git a/t/02-module-path.t b/t/02-module-path.t index c0acf36..989f3b7 100644 --- a/t/02-module-path.t +++ b/t/02-module-path.t @@ -3,10 +3,12 @@ use strict; use warnings; -use Test::More 0.88 tests => 3; +use Test::More 0.88 tests => 6; use Module::Path 'module_path'; use Cwd qw/ abs_path /; +use File::Temp qw/ tempfile tempdir /; +use File::Spec; my $expected_path; @@ -37,3 +39,29 @@ ok(!$@ && module_path('Test/More.pm') eq $expected_path, # module_path() returns undef if module not found in @INC ok(!defined(module_path('No::Such::Module')), "non-existent module should result in undef"); + +{ + my $temp_dir = tempdir( CLEANUP => 1 ); + my ( $fh, $filename ) = tempfile( DIR => $temp_dir, SUFFIX => '.pm' ); + my $module_name = ( File::Spec->splitpath($filename) )[-1]; + $module_name =~ s/\.pm$//; + ok( + module_path( $module_name, { dirs => [$temp_dir] } ) eq $filename, + "check locally specified files can be found" + ); + + my $other_temp_dir = tempdir( CLEANUP => 1 ); + my ( $other_fh, $other_filename ) = + tempfile( DIR => $other_temp_dir, SUFFIX => '.pm' ); + my $other_module_name = ( File::Spec->splitpath($other_filename) )[-1]; + $other_module_name =~ s/\.pm//; + ok( + module_path( $other_module_name, + { dirs => [ $temp_dir, $other_temp_dir ] } ) eq + $other_filename, + "check locally specified files can be found in multiple paths" + ); + + ok( !defined( module_path( 'My::Module', { dirs => [] } ) ), + "check empty local dirs list returns undef" ); +} From c6a69b129443985b97b88dfd602ba49f44dd0996 Mon Sep 17 00:00:00 2001 From: Paul Cochrane Date: Fri, 29 Jul 2016 17:35:22 +0200 Subject: [PATCH 2/3] Update mpath to accept the --dirs option ... which then allows the user to specify a list of directories in which to search for modules. The POD and the tests for `mpath` have been updated so that the new functionality is documented and checked for correctness. --- bin/mpath | 17 +++++++++++++++-- t/03-mpath.t | 28 ++++++++++++++++++++++++++++ 2 files changed, 43 insertions(+), 2 deletions(-) diff --git a/bin/mpath b/bin/mpath index 7f054b0..496dd98 100755 --- a/bin/mpath +++ b/bin/mpath @@ -6,7 +6,7 @@ use Module::Path qw(module_path); use Getopt::Long qw(GetOptions); use Pod::Usage qw(pod2usage); -GetOptions(\my %opts, 'help|h|?', 'quiet|q', 'full|f') +GetOptions(\my %opts, 'help|h|?', 'quiet|q', 'full|f', 'dirs|d=s') or pod2usage 2; if ($opts{help}) { @@ -24,8 +24,14 @@ elsif (!@ARGV) { my $all_found = 1; +my @search_dirs; +@search_dirs = split( /,/, $opts{dirs} ) if $opts{dirs}; + for my $module (@ARGV) { - my $path = module_path($module); + my $path = + $opts{dirs} + ? module_path($module, { dirs => \@search_dirs }) + : module_path($module); if (!defined($path)) { $all_found = 0; print "$module not found\n" unless $opts{quiet}; @@ -59,6 +65,9 @@ mpath - display the full path to a perl module (installed locally) /usr/local/lib/perl5/site_perl/5.16.0/darwin-2level/Moose.pm /usr/local/lib/perl5/site_perl/5.16.0/Moo.pm + % mpath --dirs=/path/to/local/perl/modules Module::Path + /home/user/perl/perlbrew/perls/5.16.0/site_perl/5.16.0/Module/Path.pm + =head1 DESCRIPTION mpath displays the full path to a perl module on the local system. @@ -92,6 +101,10 @@ Print module name. Don't print any error when one of the module requested could not be found. +=item B<-d>, B<--dirs> + +Use the comma separated list of directories to search in instead of C<@INC>. + =back =head1 SEE ALSO diff --git a/t/03-mpath.t b/t/03-mpath.t index 0898fa0..1812a27 100644 --- a/t/03-mpath.t +++ b/t/03-mpath.t @@ -8,6 +8,8 @@ use FindBin 0.05; use File::Spec::Functions; use Devel::FindPerl qw(find_perl_interpreter); use Cwd qw/ abs_path /; +use File::Temp qw{ tempfile tempdir }; +use File::Spec; my $PERL = find_perl_interpreter() || die "can't find perl!\n"; my $MPATH = catfile( $FindBin::Bin, updir(), qw(bin mpath) ); @@ -80,4 +82,30 @@ is( "module name should be printed right before its path if the option --full is specified" ); +{ + my $temp_dir = tempdir( CLEANUP => 1 ); + my ( $fh, $filename ) = tempfile( DIR => $temp_dir, SUFFIX => '.pm' ); + my $module_name = ( File::Spec->splitpath($filename) )[-1]; + $module_name =~ s/\.pm$//; + my $INC_PATH = catfile( $FindBin::Bin, updir(), 'lib' ); + my $command = + "$PERL -I$INC_PATH $MPATH --dirs='$temp_dir' $module_name 2>&1"; + chomp( $path = qx{$command} ); + + ok( $? == 0, 'exit status is zero' ); + ok( defined($path), 'path is defined' ); + + is( $path, $filename, "--dirs option returns expected path" ); + + $command = "$PERL -I$INC_PATH $MPATH " + . "--dirs='$temp_dir,\'another/path\'' $module_name 2>&1"; + chomp( $path = qx{$command} ); + + ok( $? == 0, 'exit status is zero' ); + ok( defined($path), 'path is defined' ); + + is( $path, $filename, + "--dirs option returns expected path with multiple input dirs" ); +} + done_testing; From 8d425e400a3be1d07d918710362eb86443e5cd74 Mon Sep 17 00:00:00 2001 From: Paul Cochrane Date: Fri, 29 Jul 2016 17:37:26 +0200 Subject: [PATCH 3/3] Update cpanfile after addition of tests for dirs option --- cpanfile | 2 ++ 1 file changed, 2 insertions(+) diff --git a/cpanfile b/cpanfile index e340425..4e3ee94 100644 --- a/cpanfile +++ b/cpanfile @@ -9,7 +9,9 @@ requires "warnings" => "0"; on 'test' => sub { requires "Devel::FindPerl" => "0"; + requires "File::Spec" => "0"; requires "File::Spec::Functions" => "0"; + requires "File::Temp" => "0"; requires "FindBin" => "0.05"; requires "Test::More" => "0.88"; };