File Coverage

blib/lib/App/Pod.pm
Criterion Covered Total %
statement 474 515 92.0
branch 129 166 77.7
condition 20 37 54.0
subroutine 77 79 97.4
pod 15 15 100.0
total 715 812 88.0


line stmt bran cond sub pod time code
1             package App::Pod;
2              
3 3     3   223568 use v5.24; # Postfix deref :)
  3         24  
4 3     3   19 use strict;
  3         6  
  3         71  
5 3     3   22 use warnings;
  3         5  
  3         99  
6 3     3   1752 use Pod::Query;
  3         204535  
  3         20  
7 3     3   10724 use Module::CoreList();
  3         326080  
  3         2023  
8 3     3   3204 use Getopt::Long qw( GetOptions );
  3         30827  
  3         17  
9 3     3   2101 use Module::Functions qw( get_full_functions );
  3         6546  
  3         200  
10 3     3   1633 use File::HomeDir qw( home );
  3         17166  
  3         203  
11 3     3   21 use File::Basename qw( basename );
  3         6  
  3         274  
12 3     3   32 use File::Spec::Functions qw( catfile );
  3         7  
  3         142  
13 3     3   18 use List::Util qw( first max );
  3         4  
  3         196  
14 3     3   1475 use Mojo::File qw( path );
  3         481146  
  3         243  
15 3     3   1541 use Mojo::JSON qw( j );
  3         70455  
  3         215  
16 3     3   1391 use Perl::OSType qw( os_type );
  3         1291  
  3         221  
17 3     3   1450 use Term::ANSIColor qw( colored );
  3         20334  
  3         1531  
18 3     3   22 use Carp qw( cluck );
  3         6  
  3         130  
19 3     3   1272 use open qw( :std :utf8 );
  3         2421  
  3         23  
20 3     3   2087 use subs qw( _sayt uniq );
  3         71  
  3         15  
21              
22             # Catch eval warnings better.
23             $SIG{__WARN__} = sub { cluck shift };
24              
25             =head1 LOGO
26              
27             ~ __ ~
28             ~ ____ ____ ____/ / ~
29             ~ / __ \/ __ \/ __ / ~
30             ~ / /_/ / /_/ / /_/ / ~
31             ~ / .___/\____/\__,_/ ~
32             ~ /_/ ~
33              
34             =head1 NAME
35              
36             App::Pod - Quickly show available class methods and documentation.
37              
38             =cut
39              
40             our $VERSION = '0.34';
41              
42              
43             =head1 SYNOPSIS
44              
45             View summary of Mojo::UserAgent:
46              
47             % pod Mojo::UserAgent
48              
49             View summary of a specific method.
50              
51             % pod Mojo::UserAgent get
52              
53             Edit the module
54              
55             % pod Mojo::UserAgent -e
56              
57             Edit the module and jump to the specific method definition right away.
58             (Press "n" to next match if neeeded).
59              
60             % pod Mojo::UserAgent get -e
61              
62             Run perldoc on the module (for convenience).
63              
64             % pod Mojo::UserAgent -d
65              
66             List all available methods.
67             If no methods are found normally, then this will automatically be enabled.
68             (pod was made to work with Mojo pod styling).
69              
70             % pod Mojo::UserAgent -a
71              
72             List all Module::Build actions.
73              
74             % pod Module::Build --query head1=ACTIONS/item-text
75              
76             Can do the same stuff with a file
77              
78             % pod my.pod --query head1
79              
80             Show help.
81              
82             % pod
83             % pod -h
84              
85              
86             =head1 DESCRIPTION
87              
88             Basically, this is a tool that can quickly summarize the contents of a perl module.
89              
90             =head1 SUBROUTINES/METHODS
91              
92             =cut
93              
94             #
95             # Method maker
96             #
97              
98             =head2 _has
99              
100             Generates class accessor methods (like Mojo::Base::attr)
101              
102             =cut
103              
104             sub _has {
105 3     3   375 no strict 'refs';
  3         5  
  3         2110  
106 3     3   8 for my $attr ( @_ ) {
107             *$attr = sub {
108 1077 100   1077   3626 return $_[0]{$attr} if @_ == 1; # Get: return $self-<{$attr}
109 379         770 $_[0]{$attr} = $_[1]; # Set: $self->{$attr} = $val
110 379         515 $_[0]; # return $self
111             }
112 48 50       296 if not defined &$attr;
113             }
114             }
115              
116             sub import {
117 3     3   41 _has qw(
118             _class
119             _args
120             _method
121             _opts
122             _core_flags
123             _non_main_flags
124             _cache_from_file
125             _cache_pod
126             _cache_path
127             _cache_name_and_summary
128             _cache_version
129             _cache_isa
130             _cache_events
131             _cache_methods
132             _cache_method_and_doc
133             _dirty_cache
134             );
135             }
136              
137             #
138             # Debug
139             #
140              
141             sub _dumper {
142 2     2   24 require Data::Dumper;
143 2         12 my $data = Data::Dumper
144             ->new( [@_] )
145             ->Indent( 1 )
146             ->Sortkeys( 1 )
147             ->Terse( 1 )
148             ->Useqq( 1 )
149             ->Dump;
150 2 50       272 return $data if defined wantarray;
151 0         0 say $data;
152             }
153              
154             #
155             # Run
156             #
157              
158             =head2 run
159              
160             Run the main program.
161              
162             use App::Pod;
163             App::Pod->run;
164              
165             Or just use the included script:
166              
167             % pod
168              
169             =cut
170              
171             sub run {
172 32     32 1 32363 my $self = __PACKAGE__->_new;
173              
174 32 100       87 return if $self->_process_core_flags;
175 28 100       77 return if $self->_abort;
176              
177 18 100       50 if ( $self->_non_main_flags->@* ) {
178 12         33 $self->_process_non_main;
179             }
180             else {
181 6         22 $self->_process_main;
182             }
183              
184 18         11208 $self->_dump();
185 18 100       54 $self->store_cache if $self->_dirty_cache;
186             }
187              
188             sub _new {
189 32     32   77 my ( $class ) = @_;
190 32         75 my $self = bless {}, $class;
191              
192 32         97 $self->_init;
193              
194 32         376 $self;
195             }
196              
197             sub _init {
198 32     32   56 my ( $self ) = @_;
199              
200             # Show help when no input.
201 32 100       152 @ARGV = ( "--help" ) if not @ARGV;
202              
203 32         69 my $o = _get_opts();
204 32         94 my ( $class, @args ) = @ARGV;
205              
206 32         122 $self->_opts( $o );
207 32         88 $self->_class( $class );
208 32         96 $self->_args( \@args );
209 32         121 $self->_method( $args[0] );
210              
211 32         74 my @core_flags;
212             my @non_main_flags;
213              
214 32         76 for ( $self->_define_spec() ) {
215              
216             # We are using the option and it has a handler.
217 384 100 100     897 next unless $o->{ $_->{name} } and $_->{handler};
218              
219 31 100       68 if ( $_->{core} ) {
220 9         23 push @core_flags, $_;
221             }
222             else {
223 22         51 push @non_main_flags, $_;
224             }
225             }
226              
227             # Core flags.
228             # These do not need any error checks
229             # and will be processed early.
230 32         256 $self->_core_flags( \@core_flags );
231              
232             # Non main flags.
233             # These are features separate from the main program.
234 32         116 $self->_non_main_flags( \@non_main_flags );
235              
236             # Explicitly force getting the real data.
237 32 100       96 $self->_dirty_cache( 1 ) if $o->{flush_cache};
238              
239             # Not sure how to handle colors in windows.
240 32 100 66     72 $self->_no_colors() if $self->_opts->{no_colors} or os_type eq "Windows";
241             }
242              
243             sub _no_colors {
244 1     1   6 my @colors = qw(
245             _red
246             _yellow
247             _green
248             _grey
249             _neon
250             _reset
251             );
252              
253 3     3   21 no strict 'refs';
  3         7  
  3         98  
254 3     3   45 no warnings 'redefine';
  3         9  
  3         10452  
255              
256             # Pass through the args.
257 1         3 for my $color ( @colors ) {
258 6     490   28 *$color = sub { "@_" };
  490         1445  
259             }
260             }
261              
262             sub _dump {
263 18     18   51 my ( $self ) = @_;
264 18 100       45 my $dump = $self->_opts->{dump} or return;
265 2         19 my $data;
266              
267 2 50       13 if ( $dump >= 2 ) { # Dump all.
    50          
268 0         0 $data = $self;
269             }
270             elsif ( $dump >= 1 ) { # Skip lol and tree.
271 2         26 $data = {%$self}; # Shallow copy.
272 2         11 for ( keys %$data ) { # Keep the dump simple.
273 18 100 100     67 delete $data->{$_} if /^_cache_/ and !/path/;
274             }
275             }
276              
277 2         9 say "self=" . _dumper $data;
278             }
279              
280             # Spec
281              
282             sub _define_spec {
283 72     72   896 my @spec = (
284              
285             # If given a handler, will be auto processed.
286             # Core options will be processed early.
287              
288             # Core.
289             {
290             spec => "help|h",
291             description => "Show this help section.",
292             handler => "_show_help",
293             core => 1,
294             },
295             {
296             spec => "version|v",
297             description => "Show this tool version.",
298             handler => "_show_version",
299             core => 1,
300             },
301             {
302             spec => "tool_options|to",
303             description => "List tool options.",
304             handler => "list_tool_options",
305             core => 1,
306             },
307              
308             # Non main.
309             {
310             spec => "class_options|co",
311             description => "Class events and methods.",
312             handler => "list_class_options",
313             },
314             {
315             spec => "doc|d",
316             description => "View class documentation.",
317             handler => "doc_class",
318             },
319             {
320             spec => "edit|e",
321             description => "Edit the source code.",
322             handler => "edit_class",
323             },
324             {
325             spec => "query|q=s",
326             description => "Run a pod query.",
327             handler => "query_class",
328             },
329             {
330             spec => "dump|dd+",
331             description => "Dump extra info (adds up).",
332             core => 1,
333             },
334             {
335             spec => "all|a",
336             description => "Show all class functions.",
337             },
338             {
339             spec => "no_colors",
340             description => "Do not output colors.",
341             },
342             {
343             spec => "no_error",
344             description => "Suppress some error message.",
345             },
346             {
347             spec => "flush_cache|f",
348             description => "Flush cache file(s).",
349             },
350             );
351              
352             # Add the name.
353 72         181 for ( @spec ) {
354 864         2610 $_->{name} = $_->{spec} =~ s/\|.+//r;
355             }
356              
357 72         219 @spec;
358             }
359              
360             sub _get_spec_list {
361 38     38   77 map { $_->{spec} } _define_spec();
  456         758  
362             }
363              
364             sub _get_opts {
365 32     32   51 my $opts = {};
366              
367 32 50       70 GetOptions( $opts, _get_spec_list() ) or die "$!\n";
368              
369 32         27158 $opts;
370             }
371              
372             sub _get_pod {
373 79     79   133 my ( $self ) = @_;
374              
375             # Use in-memory cache if present.
376 79         161 my $pod = $self->_cache_pod;
377 79 100       293 return $pod if $pod;
378              
379             # Otherwise, make a new Pod::Query object.
380 21         43 $pod = Pod::Query->new( $self->_class );
381              
382             # Cache it in-memory.
383 21         303938 $self->_cache_pod( $pod );
384              
385 21         70 $pod;
386             }
387              
388             #
389             # Core
390             #
391              
392             sub _process_core_flags {
393 32     32   62 my ( $self ) = @_;
394              
395 32         72 for ( $self->_core_flags->@* ) {
396 9 50       16 say "Processing: $_->{name}" if $self->_opts->{dump};
397 9         15 my $handler = $_->{handler};
398 9 100       36 return 1 if $self->$handler;
399             }
400              
401 28         85 return 0;
402             }
403              
404             # Help
405              
406             sub _show_help {
407 2     2   8 my ( $self ) = @_;
408              
409 2         10 say $self->_process_template(
410             $self->_define_help_template,
411             $self->_build_help_options,
412             );
413              
414 2         25 return 1;
415             }
416              
417             sub _define_help_template {
418 2     2   5 <<"HELP";
419              
420             ##_neon:Syntax:
421