File Coverage

blib/lib/Module/Collect.pm

Criterion	Covered	Total	%
statement	66	66	100.0
branch	18	20	90.0
condition	3	4	75.0
subroutine	14	14	100.0
pod	0	2	0.0
total	101	106	95.2

package Module::Collect;
use 5.006_002;
use strict;
use warnings;
our $VERSION = '0.06';

use Text::Glob qw(glob_to_regex);

use Carp;
use File::Find;
use File::Spec;
use Module::Collect::Package;

sub new {
    my($class, %args) = @_;

    $args{modules}   = [];
    $args{pattern} ||= '*.pm';

    if($args{prefix}){
        $args{prefix} .= '::';
    }
    else{
        $args{prefix} = '';
    }

    my $self = bless { %args }, $class;
    $self->_find_modules;

    $self;
}

sub _find_modules {
    my $self = shift;

    my $path = $self->{path} || return;

    my $pattern = glob_to_regex($self->{pattern});

    my @modules;

    my $wanted  = sub{
        return unless -f;
        return unless /$pattern/;
        push @modules, File::Spec->canonpath($File::Find::name);
    };

    for my $dir(ref($path) eq 'ARRAY' ? @{$path} : $path){
        next unless -d $dir;
        find($wanted, $dir);
    }

    for my $modulefile(@modules){
        $self->_add_module($modulefile);
    }
}

sub _add_module {
    my($self, $modulefile) = @_;
    my @packages = $self->_extract_package($modulefile);
    return unless @packages;
    for (@packages) {
        push @{ $self->{modules} }, Module::Collect::Package->new(
            package => $_,
            path    => $modulefile,
        );
    }
}

sub _extract_package {
    my($self, $modulefile) = @_;

    open my $fh, '<', $modulefile or croak "$modulefile: $!";
    my $prefix = $self->{prefix};

    my $multiple = $self->{multiple};
    my @packages;

    while (<$fh>) {
        next if /\A =\w/xms .. /\A =cut \b/xms; # skip pod sections

        if(/\A \s* package \s+ ($prefix \S*) \s* ;/xms){
            push @packages, $1;

            last unless $multiple;
        }
    }
    return @packages;
}


sub modules {
    my $self = shift;
    $self->{modules};
}

1;
__END__