File Coverage

blib/lib/Catmandu/Cmd/help.pm
Criterion Covered Total %
statement 20 66 30.3
branch 2 16 12.5
condition 1 3 33.3
subroutine 8 15 53.3
pod 3 5 60.0
total 34 105 32.3


line stmt bran cond sub pod time code
1              
2             use Catmandu::Sane;
3 14     14   119263  
  14         31  
  14         95  
4             our $VERSION = '1.2019';
5              
6             use parent 'Catmandu::Cmd';
7 14     14   110 use App::Cmd::Command::help;
  14         24  
  14         82  
8 14     14   7265 use Catmandu::Util qw(require_package pod_section);
  14         5217  
  14         390  
9 14     14   84 use namespace::clean;
  14         25  
  14         736  
10 14     14   78  
  14         29  
  14         84  
11             '%c help [ <command> | ( export | import | store | fix ) <name> ]';
12             }
13 5     5 1 87  
14              
15             my %MODULES = (
16 60     60 1 6864 Exporter => {
17             re => qr/^export(er)?$/i,
18             usage => [
19             "catmandu convert ... to %n [options]",
20             "catmandu export ... to %n [options]",
21             ],
22             },
23             Importer => {
24             re => qr/^import(er)?$/i,
25             usage => [
26             "catmandu convert %n [options] to ...",
27             "catmandu import %n [options] to ...",
28             ],
29             },
30             Store => {
31             re => qr/^(store|copy)$/i,
32             usage => [
33             "catmandu import ... to %n [options]",
34             "catmandu copy ... to %n [options]",
35             "catmandu export %n [options] ...",
36             "catmandu copy %n [options] ...",
37             ]
38             },
39             Fix => {re => qr/^fix$/i, usage => ["%n( [options] )"]},
40             'Fix::Bind' =>
41             {re => qr/^bind$/i, usage => ["do %n( [options] ) ... end"]},
42             'Fix::Condition' =>
43             {re => qr/^condition$/i, usage => ["if %n( [options] ) ... end"]},
44             );
45              
46             my ($self, $opts, $args) = @_;
47              
48             # TODO: list available Importer/Exporters/Stores/Fixes...
49              
50 5     5 1 96 if (@$args == 2) {
51              
52             # detect many forms such as:
53             # export JSON, exporter JSON, JSON export, JSON exporter
54 5 50 33     31 foreach (0, 1) {
    50          
55             foreach my $type (keys %MODULES) {
56             if ($args->[$_] =~ $MODULES{$type}->{re}) {
57             $self->help_about($type, $args->[($_ + 1) % 2]);
58 0         0 return;
59 0         0 }
60 0 0       0 }
61 0         0 }
62 0         0 }
63             elsif (@$args == 1 && $args->[0] =~ qr/^fix(es)?$/) {
64             $self->help_fixes;
65             return;
66             }
67              
68 0         0 App::Cmd::Command::help::execute(@_);
69 0         0 }
70              
71             my ($self, $type, $name) = @_;
72 5         28  
73             my $class;
74             if ($type eq 'Fix') {
75             foreach ('Fix', 'Fix::Bind', 'Fix::Condition') {
76 0     0 0   $type = $_;
77             try {
78 0           require_package($name, "Catmandu::$type");
79 0 0         $class = "Catmandu::${type}::$name";
80 0           }
81 0           catch { };
82             last if $class;
83 0     0     }
84 0           unless ($class) {
85             Catmandu::NoSuchFixPackage->throw(
86 0     0     {
87 0 0         message => "No such fix package: $name",
88             package_name =>
89 0 0         "Catmandu::Fix::(Bind::|Condition::)?$name",
90 0           fix_name => $name,
91             }
92             );
93             }
94             }
95              
96             $class = "Catmandu::${type}::$name";
97             require_package($class);
98              
99             my $about = pod_section($class, "name");
100             $about =~ s/\n/ /mg;
101 0           say ucfirst($about);
102 0            
103             say "\nUsage:";
104 0           print join "", map {s/%n/$name/g; " $_\n"} @{$MODULES{$type}->{usage}};
105 0            
106 0           my $descr = pod_section($class, "description");
107             chomp $descr;
108 0           say "\n$descr" if $descr;
109 0            
  0            
  0            
  0            
110             # TODO: include examples?
111 0            
112 0           my $options = pod_section($class, "configuration");
113 0 0         if ($options) {
114             $options =~ s/^([a-z0-9_-]+)\s*\n?/--$1, /mgi;
115             $options
116             =~ s/^(--[a-z0-9_-]+(,\s*--[a-z0-9_-]+)*),\s*([^-])/" $1\n $3"/emgi;
117 0           print "\nOptions:\n$options";
118 0 0         }
119 0           }
120 0            
121 0           my ($self) = @_;
122 0            
123             my $fixes = Catmandu->importer(
124             'Modules',
125             namespace => 'Catmandu::Fix',
126             primary => 1
127 0     0 0   )->select(name => qr/::[a-z][^:]*$/)->map(
128             sub {
129             $_[0]->{name} =~ s/.*:://;
130             $_[0];
131             }
132             );
133              
134             my $len = $fixes->max(sub {length $_[0]->{name}});
135 0     0     $fixes->sorted('name')->each(
136 0           sub {
137             say sprintf "%-${len}s %s", $_[0]->{name}, $_[0]->{about};
138 0           }
139             );
140 0     0      
  0            
141             say "\nGet additional help with: catmandu help fix <NAME>";
142             }
143 0     0      
144             1;
145 0            
146              
147 0           =pod
148              
149             =head1 NAME
150              
151             Catmandu::Cmd::help - show help
152              
153             =head1 EXAMPLES
154              
155             catmandu help convert
156             catmandu help import JSON
157             catmandu help help
158             catmandu help fix set_field
159              
160             =cut