File Coverage

lib/Module/New/Command/Help.pm
Criterion Covered Total %
statement 21 51 41.1
branch 0 8 0.0
condition 0 5 0.0
subroutine 7 9 77.7
pod n/a
total 28 73 38.3


line stmt bran cond sub pod time code
1             package Module::New::Command::Help;
2            
3 1     1   634 use strict;
  1         1  
  1         24  
4 1     1   3 use warnings;
  1         1  
  1         29  
5 1     1   5 use Carp;
  1         2  
  1         70  
6 1     1   4 use Module::New::Meta;
  1         1  
  1         7  
7 1     1   61 use Module::New::Queue;
  1         1  
  1         17  
8 1     1   3 use Path::Tiny;
  1         1  
  1         35  
9 1     1   3 use String::CamelCase 'decamelize';
  1         1  
  1         341  
10            
11             functions {
12             help => sub () { Module::New::Queue->register(sub {
13 0     0     my ($self, $target) = @_;
14            
15 0           my $context = Module::New->context;
16            
17 0           my %descriptions;
18 0           my $max_length = 0;
19 0           foreach my $inc ( @INC ) {
20 0           foreach my $base ( $context->loader->_base ) {
21 0           $base .= '::Recipe';
22 0           (my $path = $base) =~ s|::|/|g;
23 0           my $dir = path($inc, $path);
24 0 0         next unless $dir->exists;
25 0           foreach my $recipe ( $dir->children ) {
26 0           my $basename = $recipe->basename;
27 0           $basename =~ s/\.pm$//;
28 0           my $package = "$base\::$basename";
29 0           my $command = decamelize($basename);
30            
31 0 0         if ( $target ) {
32 0 0         next if $command ne $target;
33            
34 0           require Pod::Simple::Text;
35 0           Pod::Simple::Text->filter("$recipe");
36 0           return;
37             }
38            
39 0           my $source = $recipe->slurp;
40 0           my ($description) = $source =~ /=head1 NAME\s+$package\s+\-\s+(.+?)\s+=head1/s;
41 0   0       $description ||= '';
42 0   0       $descriptions{$command} ||= $description;
43 0           my $length = length $command;
44 0 0         $max_length = $length if $max_length < $length;
45             }
46             }
47             }
48            
49 0           foreach my $command (sort keys %descriptions) {
50 0           my $padding = ' ' x ($max_length - (length $command));
51 0           print " $command$padding - $descriptions{$command}\n";
52             }
53            
54 0     0     })}
55             };
56            
57             1;
58            
59             __END__