File Coverage

blib/lib/Module/Used.pm

Criterion	Covered	Total	%
statement	105	106	99.0
branch	34	42	80.9
condition	6	6	100.0
subroutine	19	19	100.0
pod	4	4	100.0
total	168	177	94.9

package Module::Used;

use 5.008003;
use utf8;

use strict;
use warnings;

use version; our $VERSION = qv('v1.3.0');

use English qw< -no_match_vars >;
use Const::Fast qw< const >;

use Exporter qw< import >;

our @EXPORT_OK = qw<
    modules_used_in_files
    modules_used_in_string
    modules_used_in_document
    modules_used_in_modules
>;
our %EXPORT_TAGS    = (
    all => [@EXPORT_OK],
);


use Module::Path qw< module_path >;
use PPI::Document ();


sub modules_used_in_files {
    my (@files) = @_;

    my %modules;

    foreach my $file (@files) {
        my $document = _create_document_from_file($file);
        my @loaded_modules = modules_used_in_document($document);
        @modules{@loaded_modules} = (1) x @loaded_modules;
    } # end foreach

    return keys %modules;
} # end modules_used_in_files()


sub modules_used_in_modules {
    my (@modules)   = @_;
    my @files;
    my $fullpath;

    foreach my $module (@modules) {
        $fullpath = module_path($module)
            or die qq;

        push @files, $fullpath;
    }

    return modules_used_in_files(@files);
} # end modules_used_in_modules()


sub modules_used_in_string {
    my ($string) = @_;

    my $document = PPI::Document->new(\$string, readonly => 1)
        or die qq, PPI::Document->errstr(), ".\n";

    return modules_used_in_document($document);
} # end modules_used_in_string()


sub modules_used_in_document {
    my ($document) = @_;

    my %modules;

    my $includes = $document->find('PPI::Statement::Include');
    if ($includes) {
        foreach my $statement ( @{$includes} ) {
            my $module = $statement->module();
            if ($module) {
                $modules{$module} = 1;

                if ($module eq 'base' or $module eq 'parent') {
                    my @loaded_modules =
                        _modules_loaded_by_base_or_parent($statement);

                    @modules{@loaded_modules} = (1) x @loaded_modules;
                } # end if
            } # end if
        } # end foreach

        my @moose_modules;
        if ( $modules{Moose} ) {
            @moose_modules =
                _modules_loaded_by_moose_sugar($document, 'extends');
            push
                @moose_modules,
                _modules_loaded_by_moose_sugar($document, 'with');
        } elsif ( $modules{'Moose::Role'} ) {
            @moose_modules =
                _modules_loaded_by_moose_sugar($document, 'with');
        } # end if
        @modules{@moose_modules} = (1) x @moose_modules;
    } # end if

    return keys %modules;
} # end modules_used_in_document()


sub _create_document_from_file {
    my ($source) = @_;

    -e $source
        or die qq<"$source" does not exist.\n>;

    -r _
        or die qq<"$source" is not readable.\n>;

    not -d _
        or die qq<"$source" is a directory.\n>;

    if ( -z _ ) {
        # PPI barfs on empty documents for some reason.
        return PPI::Document->new();
    }

    my $document = PPI::Document->new($source, readonly => 1)
        or die qq, PPI::Document->errstr(), ".\n";

    return $document;
} # end _create_document_from_file()


const my $QUOTE_WORDS_DELIMITER_OFFSET => length 'qw<';

sub _modules_loaded_by_base_or_parent {
    my ($statement) = @_;

    my @modules;

    my @children = $statement->schildren();
    shift @children; # use/require/my
    shift @children; # 'base'/'parent'

    if (@children and $children[0] =~ m< v? [\d.]+ >xms) {
        # Skip version requirement for 'base'/'parent'.  Not worrying about
        # the potential following comma.
        shift @children;
    }

    foreach my $child (@children) {
        if ( $child->isa('PPI::Token::Quote') ) {
            push @modules, $child->string();
        } elsif ( $child->isa('PPI::Token::QuoteLike::Words') ) {
            push @modules, $child->literal();
        } # end if
    } # end foreach

    return @modules;
} # end _modules_loaded_by_base_or_parent()


sub _modules_loaded_by_moose_sugar {
    my ($document, $sugar) = @_;

    my @modules;

    my $statements = $document->find( _create_wanted_moose_sugar($sugar) );
    return if not $statements;

    foreach my $statement ( @{$statements} ) {
        my @children = $statement->schildren();
        shift @children; # 'with'

        foreach my $child (@children) {
            if ( $child->isa('PPI::Token::Quote') ) {
                push @modules, $child->string();
            } elsif ( $child->isa('PPI::Token::QuoteLike::Words') ) {
                push @modules, $child->literal();
            } # end if
        } # end foreach
    } # end foreach

    return @modules;
} # end _modules_loaded_by_moose_sugar()


sub _create_wanted_moose_sugar {
    my ($sugar) = @_;

    # Have to return 0 for false because undef tells PPI to stop searching.
    return sub {
        my (undef, $element) = @_;

        # Fix this once the next PPI version is released.  Want only vanilla
        # statements.
        return 0 if ref $element ne 'PPI::Statement';

        my $first_child = $element->schild(0);
        return 0 if not $first_child;
        return 0 if not $first_child->isa('PPI::Token::Word');

        return $first_child->content() eq $sugar;
    }; # end closure
} # end _create_wanted_moose_sugar()


1; # Magic true value required at end of module.

__END__