File Coverage

lib/Dist/Zilla/App/Command/lsplugins.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1 1     1   713 use 5.006;
  1         3  
  1         34  
2 1     1   4 use strict;
  1         1  
  1         28  
3 1     1   4 use warnings;
  1         7  
  1         62  
4              
5             package Dist::Zilla::App::Command::lsplugins;
6              
7             our $VERSION = '0.003000';
8              
9             # ABSTRACT: Show all dzil plugins on your system, with descriptions
10              
11             our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY
12              
13 1     1   214 use Dist::Zilla::App '-command';
  0            
  0            
14              
15             sub _inc_scanner { ## no critic (RequireArgUnpacking)
16             return $_[0]->{_inc_scanner} if exists $_[0]->{_inc_scanner};
17             return ( $_[0]->{_inc_scanner} = $_[0]->_build__inc_scanner );
18             }
19              
20             sub _plugin_dirs { ## no critic (RequireArgUnpacking)
21             return $_[0]->{_plugin_dirs} if exists $_[0]->{_plugin_dirs};
22             return ( $_[0]->{_plugin_dirs} = $_[0]->_build__plugin_dirs );
23             }
24              
25             sub _build__inc_scanner {
26             require Path::ScanINC;
27             return Path::ScanINC->new();
28             }
29              
30             sub _build__plugin_dirs {
31             my ($self) = @_;
32             return [ $self->_inc_scanner->all_dirs( 'Dist', 'Zilla', 'Plugin' ) ];
33             }
34              
35             sub _plugin_dir_iterator {
36             my ($self) = @_;
37             my @dirs = @{ $self->_plugin_dirs };
38             return sub {
39             return unless @dirs;
40             return shift @dirs;
41             };
42             }
43              
44             sub _plugin_all_files_iterator {
45             my ($self) = @_;
46             my $dir_iterator = $self->_plugin_dir_iterator;
47             my $dir;
48             my $file_iterator;
49             my $code;
50             $code = sub {
51             if ( not defined $dir ) {
52             if ( not defined( $dir = $dir_iterator->() ) ) {
53             return;
54             }
55             require Path::Tiny;
56             $file_iterator = Path::Tiny->new($dir)->iterator(
57             {
58             recurse => 1,
59             follow_symlinks => 0,
60             },
61             );
62             }
63             my $file = $file_iterator->();
64             if ( not defined $file and defined $dir ) {
65             $dir = undef;
66             goto $code;
67             }
68             return [ $dir, $file ];
69             };
70             return $code;
71             }
72              
73             sub _plugin_iterator {
74             my ($self) = @_;
75              
76             my $file_iterator = $self->_plugin_all_files_iterator;
77              
78             my $is_plugin = sub {
79             my ($file) = @_;
80             return unless $file =~ /[.]pm\z/msx;
81             return if -d $file;
82             return 1;
83             };
84              
85             my $code;
86             my $end;
87             $code = sub {
88             return if $end;
89             my $file = $file_iterator->();
90             if ( not defined $file ) {
91             $end = 1;
92             return;
93             }
94             if ( $is_plugin->( $file->[1] ) ) {
95             require Dist::Zilla::lsplugins::Module;
96             return Dist::Zilla::lsplugins::Module->new(
97             file => $file->[1],
98             plugin_root => $file->[0],
99             plugin_basename => 'Dist::Zilla::Plugin',
100             );
101             }
102             goto $code;
103             };
104             return $code;
105             }
106              
107              
108              
109              
110              
111              
112              
113              
114              
115              
116              
117              
118              
119              
120              
121              
122              
123              
124              
125              
126              
127              
128              
129              
130              
131              
132              
133              
134              
135              
136              
137              
138              
139              
140              
141              
142              
143              
144              
145              
146              
147              
148              
149              
150              
151              
152              
153              
154              
155              
156              
157              
158              
159             sub opt_spec {
160             return (
161             [ q[sort!], q[Sort by module name] ],
162             [ q[versions!], q[Show versions] ],
163             [ q[abstract!], q[Show Abstracts] ],
164             [ q[roles=s], q[Show applied roles] ],
165             [ q[with=s], q[Filter plugins to ones that 'do' the specified role] ]
166             );
167             }
168              
169             sub _filter_dzil {
170             my ($value) = @_;
171             return ( $value =~ /(\A|[|])Dist::Zilla::Role::/msx );
172             }
173              
174             sub _shorten_dzil {
175             my ($value) = @_;
176             $value =~ s/(\A|[|])Dist::Zilla::Role::/$1-/msxg;
177             return $value;
178             }
179              
180             sub _process_plugin {
181             my ( undef, $plugin, $opt, undef ) = @_;
182             if ( defined $opt->with ) {
183             return unless $plugin->loaded_module_does( $opt->with );
184             }
185             printf q[%s], $plugin->plugin_name;
186             if ( $opt->versions ) {
187             printf q[ (%s)], $plugin->version;
188             }
189             if ( $opt->abstract ) {
190             printf q[ - %s], $plugin->abstract || ' NO ABSTRACT DEFINED';
191             }
192             if ( defined $opt->roles ) {
193             if ( 'all' eq $opt->roles ) {
194             printf q{ [%s]}, join q[, ], @{ $plugin->roles };
195             }
196             elsif ( 'dzil-full' eq $opt->roles ) {
197             printf q{ [%s]}, join q[, ], grep { _filter_dzil($_) } @{ $plugin->roles };
198             }
199             elsif ( 'dzil' eq $opt->roles ) {
200             printf q{ [%s]}, join q[, ], map { _shorten_dzil($_) } grep { _filter_dzil($_) } @{ $plugin->roles };
201             }
202             }
203             printf "\n";
204             return;
205             }
206              
207              
208              
209              
210              
211              
212              
213              
214              
215             sub execute {
216             my ( $self, $opt, $args ) = @_;
217              
218             if ( !$opt->sort ) {
219             my $plugin_iterator = $self->_plugin_iterator;
220              
221             while ( my $plugin = $plugin_iterator->() ) {
222             $self->_process_plugin( $plugin, $opt, $args );
223             }
224             return 0;
225             }
226              
227             my $plugin_iterator = $self->_plugin_iterator;
228             my @plugins;
229             while ( my $plugin = $plugin_iterator->() ) {
230             push @plugins, $plugin;
231             }
232             for my $plugin ( sort { $a->plugin_name cmp $b->plugin_name } @plugins ) {
233             $self->_process_plugin( $plugin, $opt, $args );
234             }
235             return 0;
236              
237             }
238              
239             1;
240              
241             __END__
242              
243             =pod
244              
245             =encoding UTF-8
246              
247             =head1 NAME
248              
249             Dist::Zilla::App::Command::lsplugins - Show all dzil plugins on your system, with descriptions
250              
251             =head1 VERSION
252              
253             version 0.003000
254              
255             =head1 SYNOPSIS
256              
257             dzil lsplugins # see a list of all plugins on your system
258             dzil lsplugins --version # with versions!
259             dzil lsplugins --sort # sort them!
260             dzil lsplugins --abstract # show their ABSTRACTs!
261             dzil lsplugins --with=-FilePruner # show only file pruners
262             dzil lsplugins --roles=dzil # show all the dzil related role data!
263              
264             =head1 METHODS
265              
266             =head2 C<opt_spec>
267              
268             Supported parameters:
269              
270             =over 4
271              
272             =item * C<--sort>
273              
274             Sorting.
275              
276             =item * C<--no-sort>
277              
278             No Sorting ( B<Default> )
279              
280             =item * C<--versions>
281              
282             Versions
283              
284             =item * C<--no-versions>
285              
286             No Versions ( B<Default> )
287              
288             =item * C<--abstract>
289              
290             Show abstracts
291              
292             =item * C<--no-abstract>
293              
294             Don't show abstracts ( B<Default> )
295              
296             =item * C<--roles=all>
297              
298             Show all roles, un-abbreviated.
299              
300             =item * C<--roles=dzil-full>
301              
302             Show only C<dzil> roles, un-abbreviated.
303              
304             =item * C<--roles=dzil>
305              
306             Show only C<dzil> roles, abbreviated.
307              
308             =item * C<--with=$ROLENAME>
309              
310             Show only plugins that C<< does($rolename) >>
311              
312             ( A - prefix will be expanded to C<Dist::Zilla::Role::> for convenience )
313              
314             =back
315              
316             =for Pod::Coverage execute
317              
318             =head1 AUTHOR
319              
320             Kent Fredric <kentnl@cpan.org>
321              
322             =head1 COPYRIGHT AND LICENSE
323              
324             This software is copyright (c) 2014 by Kent Fredric <kentfredric@gmail.com>.
325              
326             This is free software; you can redistribute it and/or modify it under
327             the same terms as the Perl 5 programming language system itself.
328              
329             =cut