File Coverage

blib/lib/Dependencies/Searcher.pm

Criterion	Covered	Total	%
statement	138	170	81.1
branch	24	38	63.1
condition	23	27	85.1
subroutine	24	26	92.3
pod	11	11	100.0
total	220	272	80.8

package Dependencies::Searcher;

use 5.010;
use Data::Printer;
use feature qw(say);
# Be careful, even if the Module::Corelist module is available since v5.8.9
# the is_core() method is only available since 2.99 module's version :)
# http://neilb.org/2013/09/21/adding-is-core.html
use Module::CoreList;
use Module::Version 'get_version';
use autodie;
use Moose;
use IO::File;  # This comment creates a bug
use File::HomeDir;
use Version::Compare;
use Path::Class;
use ExtUtils::Installed;
use File::Next;
use PPI;
use Term::ANSIColor;
# For test only during dev
#use Dependencies::Searcher;

our $VERSION = '0.066_005';

=head1 NAME

Dependencies::Searcher - Search for modules used by a distribution.

=cut

=head1 SYNOPSIS

    use Dependencies::Searcher;

    my $searcher = Dependencies::Searcher->new();
    my @elements = $searcher->get_files();
    my @uses = $searcher->get_modules($path, "use");
    my @uniq_modules = $searcher->uniq(@uses);

    $searcher->dissociate(@uniq_modules);

    $searcher->generate_report($searcher->non_core_modules);

    # Prints to cpanfile
    # requires 'Data::Printer', '0.35';
    # requires Moose, '2.0602';
    # requires IPC::Cmd;
    # requires Module::Version;
    # ...

   Synopsis from Dependencies::Searcher::AckRequester

    # Places to search...
    my @path = ("./lib", "./Makefile.PL", "./script");

    # Params for Ack
    my @params = ('--perl', '-hi', $pattern, @path);

    # Absolute path to the Ack binary
    my $ack_path = $requester->get_path();

    # Build the command for IPC::Cmd
    my $cmd_use = $requester->build_cmd(@params);

    # Execute the command and retrieve the output
    my @moduls = $requester->search($cmd_use);

=cut

=head1 DESCRIPTION

Maybe you don't want to have to list all the dependencies of your Perl
application by hand and want an automated way to retrieve this
list. It can also be handy sometimes to check if your Makefile.PL
contains all the prerequisite that are needed for your distribution.

This module's aim is to keep track of the list of modules your
distribution need, under the form of a L<cpanfile|cpanfile>.

Dependencies::Searcher will check for any I<requires> or I<use> in
your module repository, and report it into a cpanfile. Any duplicated
entry will be removed and modules versions will be checked and made
available. Core modules will be ommited because you don't need to
install them (except in some special cases, see C<dissociate()>
documentation).

This project has begun because I was sometimes forgetting to keep
track of my dependencies, and I just wanted to run a simple script
that updated the list in a convenient way.

=cut

=head1 Not a dependencies-tree tool

Dependencies::Searcher only finds direct dependencies, not
dependencies of dependencies, it scans recursively directories of your
module to find declared dependencies.

Once you generated a cpanfile with Dependencies::Searcher, it's
possible to pass this list to the Perl toolchain (cpanminus)
that will take care of any recursive dependencies.

=cut

# Init parameters
has 'non_core_modules' => (
    traits     => ['Array'],
    is         => 'rw',
    isa        => 'ArrayRef[Str]',
    default    => sub { [] },
    handles    => {
	add_non_core_module    => 'push',
	count_non_core_modules => 'count',
    },
);

has 'core_modules' => (
    traits     => ['Array'],
    is         => 'rw',
    isa        => 'ArrayRef[Str]',
    default => sub { [] },
    handles    => {
	add_core_module    => 'push',
	count_core_modules => 'count',
    },
);

has 'full_path' => (
  is  => 'rw',
  isa => 'Str',
);


sub get_modules {
    # @path contains files and directories
    my ($self, $pattern, @path) = @_;

    say("Search pattern : " . $pattern);

    my @moduls = $self->search($pattern, @path);
    say("Found $pattern modules : " . @moduls);

    if ( defined $moduls[0]) {
	if ($moduls[0] =~ m/^use/ or $moduls[0] =~ m/^require/) {
	    return @moduls;
	} else {
            # Not really useful since we don't use ack no more
	    die "Failed to retrieve modules with Ack";
	}
    } else {
	say "No use or require found !";
    }
}

sub get_files {
    my $self = shift;
    # Path::Class  functions allows a more portable module
    my $lib_dir = dir('lib');
    my $make_file = file('Makefile.PL');
    my $script_dir = dir('script');
    # note1 t/ is ignored
    # note2 any type of interesting file or dir should be listed here

    my @structure;

    if (-d $lib_dir) {
	$structure[0] = $lib_dir;
    } else {
	# TODO : TEST IF THE PATH IS OK ???
        # What can you do if a module don't have a lib/ dir ?
	die "Don't look like we are working on a Perl module";
    }

    if (-f $make_file) {
	$structure[1] = $make_file;
    }

    if (-d $script_dir) {
	$structure[2] = $script_dir;
    }

    return @structure;
}

# Generate a "1" when merging if one of both is empty
# Will be clean in avoid_superfluous() method
sub merge_dependencies {
    my ($self, @uses, @requires) = @_;
    my @merged_dependencies = (@uses, @requires);
    say("Merged use and require dependencies");
    return @merged_dependencies;
}

# Remove special cases that aren't need at all
sub avoid_superfluous {
    my ($self, @merged) = @_;
    my @real_modules;
    # Push everything except the special cases that are totally useless
    foreach my $module ( @merged ) {
	push(@real_modules, $module) unless

	$module =~ m/say/

	# Describes a minimal Perl version
        # BUG  #76, see above
	or $module =~ m/^use\s[0-9]\.[0-9]+?/
	or $module =~ m/^use\sautodie?/
	or $module =~ m/^use\swarnings/
	# Kind of bug generated by merge_dependencies() when there is
	# only one array to merge
	or $module =~ m/^1$/
	or $module =~ m/^use\sDependencies::Searcher/
        # Bug #76, a regex in this module created a match ("\s" module) in the
        # patterns search
        # https://git.framasoft.org/smonff/dependencies-searcher/issues/76
        or $module =~ m/\/\^use\\s/
        or $module =~m/^use\s\\s/;
    }
    return @real_modules;
}

# Clean correct lines that can't be removed
sub clean_everything {
    my ($self, @dirty_modules) = @_;
    my @clean_modules = ();

    foreach my $module ( @dirty_modules ) {

	say("Dirty module : " . $module);

	# remove the 'use' and the space next
	$module =~ s{
						use \s
				}
		    		    {}xi; # Empty subtitution

	# remove the require, quotes and the space next
	# but returns the captured module name (non-greedy)
	# i = not case-sensitive
	$module =~ s{
						requires \s
						'
						(.*?)
						'
				}{$1}xi; # Note -> don't insert spaces here

	# Remove the ';' at the end of the line
	$module =~ s/ ; //xi;

	# Remove any qw(xxxxx xxxxx) or qw[xxx xxxxx]
	# '\(' are for real 'qw()' parenthesis not for grouping
	# Also removes empty qw()

        # With spaces and parenthesis e.g. qw( foo bar )
        $module =~ s{
						\s qw
						\(
						(\s*[A-Za-z]+(\s*[A-Za-z]*))*\s*
						\)
				}{}xi;

        # Without spaces, with  parenthesis e.g. qw(foo bar) and optionnal [method_names
        $module =~ s{
						\s qw
						\(
						([A-Za-z]+(_[A-Za-z]+)*(\s*[A-Za-z]*))*
						\)
				}{}xi;

        # With square brackets e.g. qw[foo bar] and optionnal [method_names]
	$module =~ s{
						\s qw
						\[
						([A-Za-z]+(_[A-Za-z]+)*(\s*[A-Za-z]*))*
						\]
				}
		    		    {}xi; # Empty subtitution
        # With spaces and parenthesis e.g. qw/ foo bar /
	$module =~ s{
						\s qw
						\/
						(\s[A-Za-z]+(_[A-Za-z]+)*(\s*[A-Za-z]*))*\s
						\/
				}
		    		    {}xi; # Empty subtitution

	# Remove method names between quotes (those that can be used
	# without class instantiation)
	$module =~ s{
						\s
						'
						[A-Za-z]+(_[A-Za-z]+)*
						'
				}
		    		    {}xi; # Empty subtitution

	# Remove dirty bases and quotes.
	# This regex that substitute My::Module::Name
	# to a "base 'My::Module::Name'" by capturing
	# the name in a non-greedy way
	$module =~ s{
						base \s
						'
						(.*?)
						'
				}
		    		    {$1}xi;

	# Remove some warning sugar
	$module =~ s{
						([a-z]+)
						\s FATAL
						\s =>
						\s 'all'
				}
		    		    {$1}xi;

	# Remove version numbers
	# See "a-regex-for-version-number-parsing" :
	# http://stackoverflow.com/questions/82064/
	$module =~ s{
						\s
						(\*|\d+(\.\d+)
			    			    {0,2}
			    			    (\.\*)?)$
				}
		    		    {}x;

	# Remove configuration stuff like env_debug => 'LM_DEBUG' but
	# the quoted words have been removed before
	$module =~ s{
						\s
						([A-Za-z]+(_[A-Za-z]+)*( \s*[A-Za-z]*))*
						\s
						=>
				}
		    		    {}xi;


	say("Clean module : " . $module);
	push @clean_modules, $module;
    }
    return @clean_modules;
}


sub uniq {
    my ($self, @many_modules) = @_;
    my @unique_modules = ();
    my %seen = ();
    foreach my $element ( @many_modules ) {
	next if $seen{ $element }++;
	say("Uniq element added : " . $element);
	push @unique_modules, $element;
    }
    return @unique_modules;
}

sub dissociate {
    my ($self, @common_modules) = @_;

    foreach my $nc_module (@common_modules) {

	my $core_list_answer = Module::CoreList::is_core($nc_module);

	if (
	    # "$]" is Perl version
	    (exists $Module::CoreList::version{ $] }{"$nc_module"})
	    or
	    # In case module don't have a version number
	    ($core_list_answer == 1)
           ) {

	    # A module can be in core but the wanted version can be
	    # more fresh than the core one...
	    # Return the most recent version
	    my $mversion_version = get_version($nc_module);
	    # Return the corelist version
	    my $corelist_version = $Module::CoreList::version{ $] }{"$nc_module"};

	    say("Mversion version : " . $mversion_version);
	    say("Corelist version : " . $corelist_version);

	    # Version::Compare warns about versions numbers with '_'
	    # are 'non-numeric values'
	    $corelist_version =~ s/_/./;
	    $mversion_version =~ s/_/./;

	    # It's a fix for this bug
	    # https://github.com/smonff/dependencies-searcher/issues/25
	    # Recent versions of corelist modules are not include in
	    # all Perl versions corelist
	    if (&Version::Compare::version_compare(
		$mversion_version, $corelist_version
	    ) == 1) {
		say(
		    $nc_module . " version " . $mversion_version .
		    " is in use but  " .
		    $corelist_version .
		    " is in core list"
		);
		$self->add_non_core_module($nc_module);
		say(
		    $nc_module .
		    " is in core but has been added to non core " .
		    "because it's a fresh core"
		);
		next;
	    }

	    # Add to core_module

	    # The "Moose" trait way
	    # http://metacpan.org/module/Moose::Meta::Attribute::Native::Trait::Array
	    $self->add_core_module($nc_module);
	    say($nc_module . " is core");

	} else {
	    $self->add_non_core_module($nc_module);
	    say($nc_module . " is not in core");
	}
    }
}

# Open a file handle to > cpanfile
sub generate_report {

    my $self = shift;

    #
    # TODO !!! Check if the module is installed already with
    # ExtUtils::Installed. If it it not, cry that
    # Dependencies::Searcher is designed to be used in the complete env
    #

    open my $cpanfile_fh, '>', 'cpanfile' or die "Can't open cpanfile : $:!";

    foreach my $module_name ( @{$self->non_core_modules} ) {

	my $version = get_version($module_name);

	# if not undef
	if ($version) {
	    say("Module + version : " . $module_name . " " . $version);

	    # Add the "requires $module_name\n" to the next line of the file
	    chomp($module_name, $version);

	    if ($version =~ m/[0-9]\.[0-9]+/ ) {
		say $cpanfile_fh "requires '$module_name', '$version';";
	    } # else : other case ?

	} else {
	    say("Module + version : " . $module_name);
	    say $cpanfile_fh "requires '$module_name';";
	}

    }

    close $cpanfile_fh;
    say("File has been generated and is waiting for you");
}


# under rewriting since we removed Dependencies::Searcher::AckRequester
sub search {
    my ($self, $pattern, @paths) = @_;

    my @modules;

    my $iter = File::Next::files(@paths);

    # Each path is a file in the chosen hierarchy
    while ( defined ( my $path = $iter->() )) {

        my $namespace;
        my $file = file($path);

        # We have to test that we don't include namespaces of the
        # analyzed module
        my $document = PPI::Document->new($file->stringify);
        # Testing that the file is actually a module, not for example Makefile.PL
        my $is_module = $document->find_first('PPI::Statement::Package');
        if ($is_module) {
            $namespace = $is_module->namespace;
        }

        my @lines = $file->slurp;

        for my $line (@lines) {

            # if ( $line =~ /use\\s/m ) {
            #     say "$line !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!";
            #}

            # Remove carriage return
            chomp  $line;
            # Remove tabs
            $line =~ s/^\t+//;

            if ($is_module) {
                # We jump to the next line if we found the analyzed
                # package in the array of lines
                if ($line =~ /use $namespace/ ) {
                    $self->coucou("Module namespace ($line) has been ommited ")
                }
                next if $line =~ $namespace;
            }

            if ($line =~ /^$pattern\s/ ) {
                say($line);

                # Clean the result
                $line = $self->rm_comments($line);

                push(@modules, $line);
            }
        }
    }

    # TODO retrieve modules from Makefile.PL (it cannot be based on
    # the use of a "pattern" in this case)

    p @modules;
    return @modules;
}

# It could be a simplist implementation, but I didn't find something
# more clever. Comments appreciated.
sub rm_comments {

    my ($self, $dirt) = @_;

    # Case #1: "use" declaration line with a comment after
    # The regex add the terminal semicolon at the end of the line to
    # make the difference between comments and code, because "use" is
    # a word that you can find often in a POD section, more much in
    # the beginning of line than you could think
    if ( $dirt =~ /#.+/ ) {
        say("Entered rm_comment for $dirt");
        $dirt =~ s/#(.*)//;
        # Delete spaces
        $dirt =~ s/\s*//xi;
    }

    # $pattern = "$pattern" . qr/.+;$/; # <= This is an horrible bug,
                                      #    because we could have a
                                      #    comment here

    # Case #2 pod
    # TODO


    my $clean = $dirt;

    return $clean;
}

sub coucou {
    my ($self, $thing, $color) = @_;
    if (not $color) {
        $color = 'red';
    }
    say(color("$color"), $thing);
}


1;

__END__

=pod

=head1 SUBROUTINES/METHODS

=head2 get_files()

C<get_files()> returns an array containing which file or directories has
been found in the current root distribution directory. We suppose it
can find dependancies in 3 different places :

=over 2

=item * files in C<lib/> directory, recursively

=item * C<Makefile.PL>

=item * C<script/> directory, i.e. if we use a Catalyst application

=item * maybe it should look in C<t/> directory (todo)

=back

If the C<lib/> directory don't exist, the program die because we
consider we are not into a plain old Perl Module.

This is work in progress, if you know other places where we can find
stuff, please report a bug.

=cut

=head2 get_modules("pattern", @elements)

You must pass a pattern to search for, and the elements (files or
directories) where you want to search (array of strings from C<get_files()>).

These patterns should be C<^use> or C<^require>.

Then, the search() subroutine will be used to retrieve modules names
into lines containing patterns and return them into an array
(containing also some dirt).

=cut

=head2 merge_dependencies(@modules, @modules)

Simple helper method that will merge C<use> and C<require> arrays if you
search for both. Return an uniq array. It got a little caveat, see
CAVEATS.

=cut

=head2 avoid_superfluous(@modules)

Move dependencies lines from an array to an another unless it is
considered as a "superfluous" unneccessary case : minimal Perl versions, C<use autodie>,
C<use warnings>. These stuff has to be B<removed>, not cleaned. Return a I<real
modules> array (I<real interresting> modules).

=cut

=head2 clean_everything(@modules)

After removing irrelevant stuff, we need to B<clean> what is leaving
and is considered as being crap (not strictly <CName::Of::Module>) but
needs some cleaning. We are going to remove everything but the module
name (even version numbers).

This code section is well commented (because it is regex-based) so,
please refer to it directly.

It returns an array of I<clean modules>.

=cut

=head2 uniq(@modules)

Make each array element uniq, because one dependency can be found many
times. Return an array of unique modules.

=cut

=head2 dissociate(@modules)

Dissociate I<core> / I<non-core> modules using the awesome
C<Module::Corelist::is_core method>, that search in the current Perl
version if the module is from Perl core or not. Note that results can
be different according to the environment.

More, B<you can have two versions of the same module installed on your
environment> (even if you use L<local::lib|local::lib> when you
install a recent version of a file that has been integrated into Perl
core (this version hasn't necessary been merged into core).

So C<dissociate()> checks both and compares it, to be sure that the found core
module is the "integrated" version, not a fresh one that you have
installed yourself. If it is fresh, the module is considered as a I<non-core>.

This method don't return anything, but it stores found dependencies on the two
C<core_modules> and C<non_core_modules> L<Moose|Moose> attributes arrays.

=cut

=head2 generate_report()

Generate the C<cpanfile> for L<Carton|Carton>, based on data contained into
C<core_modules> and C<non_core_modules> attributes, with optionnal
version number (if version number can't be found, dependency name is
print alone).

Generate a hash containing the modules could be achieved. Someday.

=cut

=head2 get_path()

Returns the L<ack> full path if installed. Set the C<full_path>
L<Moose> attribute that will be used by ICP::Cmd. It verify also that
L<Ack> is reachable or warns about it.

=cut

=head2 build_cmd(@params)

C<build_cmd()> takes as parameter all the arguments Ack will
need. L<Dependencies::Searcher> defines it like this :

=over 4

=item * C<--perl>   : tells to search in Perl like files (C<*.pm>, C<*.pl>, etc.)

=item * C<-hi>      : suppress the prefixing filename on output + ignore
case

=item * C<$pattern> : must be passed from your implementation

=item * C<@path>    : files and directories where L<ack> will go

All these params are merged in an only array reference that is returned for
later use with L<IPC::Cmd>.

=back

=cut

=head2 ack($params_array_ref)

Execute the L<IPC::Cmd> command that calls C<ack> and returns an array of
potentially interesting lines, containing dependencies names but some
crap inside too.

=cut

=head2 rm_comments($line_that_should_be_cleaned_of_any_comment)

Supposed to remove any comment from a line.

=cut

=head2 coucou($tring, $color)

Stupid DIY logger

=cut

=head1 CAVEATS

=head2 Some are able to do it using a one-liner (fun))

Command Line Magic (@climagic) tweeted 4:17 PM on lun., nov. 25, 2013

    # Not perfect, but gives you a start on the Perl modules in use.
    grep -rh ^use --include="*.pl" --include="*.pm" . | sort | uniq -c

See original Tweet https://twitter.com/climagic/status/404992356513902592

Though, it don't really work, that's why I made this module.

=cut

=head1 SOURCE CODE

L<https://git.framasoft.org/smonff/dependencies-searcher>

=head1 BUGS, ISSUES, TODOs

The simpliest way report any bugs or feature requests is to use Gitlab:

    https://git.framasoft.org/smonff/dependencies-searcher/issues

If your prefer, you can use the very perlish way and send a mail to
C<bug-dependencies-searcher at  rt.cpan.org>, or using the web
interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Dependencies-Searcher>.
I will be notified, and then you'll automatically be notified of
progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Dependencies::Searcher

You can also look for information at:

    See https://github.com/smonff/dependencies-searcher/

=over 2

=item * RT: CPAN's request tracker (report bugs here)

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Dependencies-Searcher>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Dependencies-Searcher>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Dependencies-Searcher>

=item * Search CPAN

L<http://search.cpan.org/dist/Dependencies-Searcher/>

=back

=head1 AUTHOR

smonff, C<< <smonff at riseup.net> >>

=head1 CONTRIBUTORS

=over

=item * Nikolay Mishin (mishin) helped to make it more cross-platform

=item * Alexandr Ciornii (chorny) advises on version numbers

=back

=cut

=head1 ACKNOWLEDGEMENTS

=over

=item L<Module::Extract::Use|Module::Extract::Use>

Was the main inspiration for this one. Not recursive though...

See L<https://metacpan.org/module/Module::Extract::Use>

=item L<Module::CoreList|Module::CoreList>

What modules shipped with versions of perl. I use it extensively to detect
if the module is from Perl Core or not.

See L<http://perldoc.perl.org/Module/CoreList.html>

=back

See also :

=over 2

=item * https://metacpan.org/module/Module::ScanDeps

=item * https://metacpan.org/module/Perl::PrereqScanner

=item * http://stackoverflow.com/questions/17771725/

=item * https://metacpan.org/module/Dist::Zilla::Plugin::AutoPrereqs

=back

=head1 LICENSE AND COPYRIGHT

Copyright 2013-2016 Sebastien Feugere.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See L<http://dev.perl.org/licenses/> for more information.


=cut