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