File Coverage

blib/lib/Module/Which.pm

Criterion	Covered	Total	%
statement	38	46	82.6
branch	6	14	42.8
condition			n/a
subroutine	9	10	90.0
pod	2	4	50.0
total	55	74	74.3

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

require Exporter;

our @ISA = qw( Exporter );
our @EXPORT = qw( which );

#use Module::Find;
use Module::Which::List qw(list_pm_files);
use Data::Hash::Transform qw(hash_em);

#sub pm_require {
#    my $pm = shift;
#    my $verbose = shift;
#    eval "require $pm";
#    if ($@) { # error
#        warn "'require $pm' failed: $@" if $verbose;
#        return (0, $@);
#    }
#    return 1
#}

#sub pm_version {
#    my $pm = shift;
#    no strict 'refs';
#    return ${"${pm}::VERSION"};
#}

use ExtUtils::MakeMaker;

=begin private

=item B

  $v = pm_version($pm);

Parses a PM file and return what it thinks is $VERSION
in this file. (Actually implemented with
Cparse_version($file)>.)
C<$pm> is the filename (eg., F).

=end private

=cut
sub pm_version {
    my $pm = shift;
    my $v;
    eval { $v = MM->parse_version($pm); };
    return $@ ? undef : $v;
}

sub pm_info {
    my $pm = shift; # --- { pm: (pm), path: (path), base: (base), }
    my $options = shift;

    my $version = pm_version($pm->{path});

    return {
        version => $version,
        pm      => $pm->{pm},
        path    => $pm->{path},
        base    => $pm->{base}
    };
}

#sub is_wildcard {
#    return shift =~ /::\*$/;
#}

#sub expand_wildcard {
#    my $wildcard = shift;
#    $wildcard =~ s/::\*$//;
#    return findallmod $wildcard;
#}

# turns an array of hashes to a hash of hashes
sub hashify (\@$) {
    my ($ary, $opt_meth) = @_;
    our %meth = ( 'HASH' => 'f', 'HASH(FIRST)' => 'f', 'HASH(MULTI)' => 'm', 'HASH(LIST)' => 'a' );
    my $meth = $meth{$opt_meth}
        or die "hash strategy '$opt_meth' unknown";
    return hash_em($ary, 'pm', $meth);
}


# which(@pm)
# which(@pm, $options) where $options is a hash ref
sub which {
    my $options = {};
    $options = pop @_ if ref $_[-1];
    $options->{return} = 'HASH' unless $options->{return};

    my @pm = @_;

    my @info;
    for my $pm (@pm) {

        # special case: 'perl'
        if ( $pm eq 'perl' ) {
            push @info, {
                pm => 'perl',
                version => sprintf("%vd", $^V), #$],
                path => $^X,
                base => '', # XXX ?!
             };
             next;
        }

        #push @info, pm_info($_, $options) for list_pm_files($pm, recurse => 1);

        my @pm_files = list_pm_files($pm, recurse => 1, include => $options->{include});
        if (@pm_files) {
            push @info, pm_info($_, $options) for @pm_files;
        } else {
            push @info, { pm => $pm };
        }

        #if (is_wildcard($pm)) {
        #    push @info, pm_info($_, $options) for expand_wildcard($pm);
        #} else {
        #    push @info, pm_info($pm, $options);
        #}
    }
    return \@info if $options->{return} eq 'ARRAY';

    return hashify(@info, $options->{return});
}

1;

__END__