File: Modules.pm

package info (click to toggle)
libcatmandu-perl 0.9206-1
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 1,768 kB
  • ctags: 512
  • sloc: perl: 7,798; makefile: 34
file content (111 lines) | stat: -rw-r--r-- 2,374 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
package Catmandu::Importer::Modules;

use namespace::clean;
use Catmandu::Sane;
use Module::Info;
use File::Spec;
use File::Find::Rule;
use Moo;

with 'Catmandu::Importer';

has inc => (
    is      => 'ro',
    lazy    => 1,
    default => sub { [@INC] },
    coerce  => sub {
        my $inc = $_[0];
        return $inc if ref $inc eq 'ARRAY';
        return [split ',', $inc];
    },
);

has namespace => (
    is      => 'ro',
    default => sub { "" },
);

has max_depth => (
    is        => 'ro',
    predicate => 1,
);

has pattern => (
    is => 'ro',
);

sub generator {
    my ($self) = @_;

    sub {
        state $pattern = $self->pattern;

        state $dirs = do {
            my @ns  = grep length, split(/::/, $self->namespace);
            my $inc = $self->inc;
            [ map { File::Spec->catdir($_, @ns) } @$inc ];
        };

        state $dir = shift(@$dirs) // return;

        state $rule = do {
            my $r = File::Find::Rule->new->file->name('*.pm');
            $r->maxdepth($self->max_depth) if $self->has_max_depth;
            $r->start($dir);
        };

        while (1) {
            if (defined(my $file = $rule->match)) {
                my $name = join('::', File::Spec->splitdir(File::Spec->abs2rel($file, $dir)));
                $name =~ s/\.pm$//;
                $name = join('::', $self->namespace, $name) if $self->namespace;

                next if defined $pattern && $name !~ $pattern;

                my $info = Module::Info->new_from_file($file);

                my $data = {
                    file => $file,
                    name => $name,
                };
                $data->{version} = $info->version if defined $info->version;
                return $data;
            } else {
                $dir = shift(@$dirs) // return;
                $rule->start($dir);
            }
        }
    };
}

=head1 NAME

Catmandu::Importer::Modules - list installed perl modules in a given namespace

=head1 OPTIONS

=over

=item namespace

namespace for the packages to list

=item inc

list of library paths (defaults to C<@INC>)

=item max_depth

maximum depth to recurse into the namespace e.g. if the namespace is
Catmandu::Fix then Catmandu::Fix::add_field has a depth of 1 and
Catmandu::Fix::Condition::exists a depth of 2

=item pattern

filter modules by the given regex pattern

=back

=cut

1;