File Coverage

blib/lib/Module/Which/List.pm

Criterion	Covered	Total	%
statement	50	68	73.5
branch	8	22	36.3
condition	0	3	0.0
subroutine	10	12	83.3
pod	0	4	0.0
total	68	109	62.3

package Module::Which::List;
$Module::Which::List::VERSION = '0.04';
use 5.006;
use strict;
use warnings;

require Exporter;

our @ISA = qw(Exporter);
our @EXPORT_OK = qw(list_pm_files);

use File::Glob qw(bsd_glob);
#use File::Spec::Functions qw(abs2rel);
require File::Spec::Unix;
use File::Find qw(find);

# returns a list with no duplicates
sub uniq {
    my %h;
    return grep { ! $h{$_}++ } @_;
}


# my @files = _plain_list_files('File/*', @INC);
sub _plain_list_files {
    my $glob = shift;
    my @INC = @_;
    my @files;
    #push @files, bsd_glob("$_/$glob") for @INC;
    for my $base (@INC) {
        #print "bsd_glob($_/$glob)\n";
        push @files,
             map { { path => $_, rpath => File::Spec::Unix->abs2rel($_, $base), base => $base } }
             grep { -e } bsd_glob("$base/$glob")
    }

    return @files if wantarray;
    return \@files;
}

# my @files = _deep_list_files('Data/**.pm', @INC)
sub _deep_list_files {
    my $glob = shift;
    my @INC = @_;

    #print "deep_list_files: ...\n";

    my $root = $glob;
    $root =~ s/\*\*\.pm$//;

    my $base;
    my @files;

    my $wanted = sub {
        if (/\.pm$/) {
            push @files, { path => $_, rpath => File::Spec::Unix->abs2rel($_, $base), base => $base };
        }
    };

    for (@INC) {
        $base = $_;
        if (-e "$base/$root" && -d "$base/$root") {
            find({ wanted => $wanted, no_chdir => 1 }, "$base/$root");
        }
    }

    return @files if wantarray;
    return \@files;

}

sub list_files {
    my $glob = shift;
    my %options = @_;
    my @include;
    @include = ($options{include}) ? @{$options{include}} : @INC;
    @include = uniq @include
        if exists $options{uniq} ? $options{uniq} : 1; # FIXME: need documentation !!!!
    #print "include: @include\n";
    my @files;
    if ($glob =~ /\*\*\.pm$/) {
        return _deep_list_files($glob, @include);
    } else {
        return _plain_list_files($glob, @include);
    }
}

sub file_to_pm {
    my $rpath = shift;
    $rpath =~ s|\.pm$||;
    $rpath =~ s|/|::|g;
    return $rpath;
}

sub list_pm_files {
    my $pm_glob = shift;
    my %options = @_;

    my $glob = $pm_glob;
    $glob =~ s|::$|::*| unless $options{recurse};
    $glob =~ s|::$|::**| if $options{recurse};
    $glob =~ s|::|/|g;
    $glob =~ s|$|.pm|;
    #print "glob: $glob\n";

    my @pm_files = list_files($glob, @_);

    my @pm;
    for (@pm_files) {
        push @pm, {
             pm => file_to_pm($_->{rpath}),
             path => $_->{path},
             base => $_->{base}
        };
    }

    return @pm if wantarray;
    return \@pm;

}

1;

__END__