package Module::Which::List;

use 5.006;
use strict;
use warnings;

require Exporter;

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

our $VERSION = '0.0204';

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__

=head1 NAME

Module::Which::List - Lists C<.pm> files under specified library paths

=head1 SYNOPSIS

  use Module::Which::List qw(list_pm_files);

  my @files = list_pm_files('XML::', 'lib1/', 'lib2/');
  # return all modules XML::* installed under 'lib1/' and 'lib2/'

  my @files = list_pm_files('Data::Dumper'); # uses @INC

=head1 DESCRITION

Yes, I know: it is a mess down below. But release early, release often
(before my breath disappears).


    pm_glob => 'File::Which'
    pm_root => 'File::Which::'


    list_files($pm_glob, { recurse => '0|1', include => \@INC })

        prefixes - take a look at Module::List
        pod      - take a look at Module::List

    list_files('Module::Which')

    => [ { pm => 'Module::Which', path => '/usr/lib/perl5/site_perl/5.8/Module/Which.pm' } ]

    list_files('Module::')

    => [ 
        { pm => 'Module::Build', path => '/usr/lib/perl5/site_perl/5.8/Module/Build.pm' } 
        { pm => 'Module::Find', path => '/usr/lib/perl5/site_perl/5.8/Module/Find.pm' }, 
        { pm => 'Module::Which', path => '/usr/lib/perl5/site_perl/5.8/Module/Which.pm' } 
       ]

=head1 BUGS

This documentation, in such a status, is a bug.

Please report bugs via CPAN RT L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Which>.

=head1 AUTHOR

Adriano R. Ferreira, E<lt>ferreira@cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2005 by Adriano R. Ferreira

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.


=cut