File Coverage

blib/lib/App/Pod.pm
Criterion Covered Total %
statement 472 513 92.0
branch 130 168 77.3
condition 20 37 54.0
subroutine 76 78 97.4
pod 15 15 100.0
total 713 811 87.9


line stmt bran cond sub pod time code
1             package App::Pod;
2              
3 3     3   472980 use v5.24; # Postfix deref :)
  3         13  
4 3     3   20 use strict;
  3         7  
  3         124  
5 3     3   17 use warnings;
  3         18  
  3         178  
6 3     3   1981 use Pod::Query;
  3         345689  
  3         29  
7 3     3   13935 use Module::CoreList();
  3         645711  
  3         4667  
8 3     3   3666 use Getopt::Long qw( GetOptions );
  3         38398  
  3         14  
9 3     3   2024 use Module::Functions qw( get_full_functions );
  3         7115  
  3         223  
10 3     3   1493 use File::HomeDir qw( home );
  3         18087  
  3         260  
11 3     3   36 use File::Basename qw( basename );
  3         10  
  3         231  
12 3     3   16 use File::Spec::Functions qw( catfile );
  3         4  
  3         131  
13 3     3   14 use List::Util qw( first max );
  3         5  
  3         183  
14 3     3   1660 use Mojo::File qw( path );
  3         424661  
  3         259  
15 3     3   1556 use Mojo::JSON qw( j );
  3         79727  
  3         324  
16 3     3   1612 use Perl::OSType qw( os_type );
  3         1775  
  3         236  
17 3     3   1739 use Term::ANSIColor qw( colored );
  3         24575  
  3         2332  
18 3     3   26 use Carp qw( cluck );
  3         6  
  3         165  
19 3     3   2062 use open qw( :std :utf8 );
  3         3468  
  3         36  
20 3     3   2133 use subs qw( _sayt uniq );
  3         930  
  3         19  
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.40';
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   392 no strict 'refs';
  3         5  
  3         2270  
106 3     3   10 for my $attr ( @_ ) {
107             *$attr = sub {
108 1077 100   1077   4359 return $_[0]{$attr} if @_ == 1; # Get: return $self-<{$attr}
109 379         961 $_[0]{$attr} = $_[1]; # Set: $self->{$attr} = $val
110 379         539 $_[0]; # return $self
111             }
112 48 50       359 if not defined &$attr;
113             }
114             }
115              
116             sub import {
117 3     3   52 _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   21 require Data::Dumper;
143 2         15 my $data = Data::Dumper
144             ->new( [@_] )
145             ->Indent( 1 )
146             ->Sortkeys( 1 )
147             ->Terse( 1 )
148             ->Useqq( 1 )
149             ->Dump;
150 2 50       356 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 179727 my $self = __PACKAGE__->_new;
173              
174 32 100       89 return if $self->_process_core_flags;
175 28 100       131 return if $self->_abort;
176              
177 18 100       61 if ( $self->_non_main_flags->@* ) {
178 12         68 $self->_process_non_main;
179             }
180             else {
181 6         28 $self->_process_main;
182             }
183              
184 18         16021 $self->_dump();
185 18 100       63 $self->store_cache if $self->_dirty_cache;
186             }
187              
188             sub _new {
189 32     32   85 my ( $class ) = @_;
190 32         96 my $self = bless {}, $class;
191              
192 32         122 $self->_init;
193              
194 32         431 $self;
195             }
196              
197             sub _init {
198 32     32   69 my ( $self ) = @_;
199              
200             # Show help when no input.
201 32 100       246 @ARGV = ( "--help" ) if not @ARGV;
202              
203 32         114 my $o = _get_opts();
204 32         101 my ( $class, @args ) = @ARGV;
205              
206 32         155 $self->_opts( $o );
207 32         101 $self->_class( $class );
208 32         108 $self->_args( \@args );
209 32         120 $self->_method( $args[0] );
210              
211 32         70 my @core_flags;
212             my @non_main_flags;
213              
214 32         88 for ( $self->_define_spec() ) {
215              
216             # We are using the option and it has a handler.
217 384 100 100     972 next unless $o->{ $_->{name} } and $_->{handler};
218              
219 31 100       96 if ( $_->{core} ) {
220 9         18 push @core_flags, $_;
221             }
222             else {
223 22         58 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         322 $self->_core_flags( \@core_flags );
231              
232             # Non main flags.
233             # These are features separate from the main program.
234 32         115 $self->_non_main_flags( \@non_main_flags );
235              
236             # Explicitly force getting the real data.
237 32 100       84 $self->_dirty_cache( 1 ) if $o->{flush_cache};
238              
239             # Not sure how to handle colors in windows.
240 32 100 66     84 $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   25 no strict 'refs';
  3         5  
  3         152  
254 3     3   15 no warnings 'redefine';
  3         7  
  3         12660  
255              
256             # Pass through the args.
257 1         2 for my $color ( @colors ) {
258 6     484   31 *$color = sub { "@_" };
  484         1420  
259             }
260             }
261              
262             sub _dump {
263 18     18   49 my ( $self ) = @_;
264 18 100       57 my $dump = $self->_opts->{dump} or return;
265 2         4 my $data;
266              
267 2 50       16 if ( $dump >= 2 ) { # Dump all.
    50          
268 0         0 $data = $self;
269             }
270             elsif ( $dump >= 1 ) { # Skip lol and tree.
271 2         17 $data = {%$self}; # Shallow copy.
272 2         11 for ( keys %$data ) { # Keep the dump simple.
273 18 100 100     73 delete $data->{$_} if /^_cache_/ and !/path/;
274             }
275             }
276              
277 2         10 say "self=" . _dumper $data;
278             }
279              
280             # Spec
281              
282             sub _define_spec {
283 72     72   1250 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         183 for ( @spec ) {
354 864         2819 $_->{name} = $_->{spec} =~ s/\|.+//r;
355             }
356              
357 72         251 @spec;
358             }
359              
360             sub _get_spec_list {
361 38     38   133 map { $_->{spec} } _define_spec();
  456         1034  
362             }
363              
364             sub _get_opts {
365 32     32   64 my $opts = {};
366              
367 32 50       86 GetOptions( $opts, _get_spec_list() ) or die "$!\n";
368              
369 32         36794 $opts;
370             }
371              
372             sub _get_pod {
373 79     79   182 my ( $self ) = @_;
374              
375             # Use in-memory cache if present.
376 79         204 my $pod = $self->_cache_pod;
377 79 100       356 return $pod if $pod;
378              
379             # Otherwise, make a new Pod::Query object.
380 21         51 $pod = Pod::Query->new( $self->_class );
381              
382             # Cache it in-memory.
383 21         431228 $self->_cache_pod( $pod );
384              
385 21         77 $pod;
386             }
387              
388             #
389             # Core
390             #
391              
392             sub _process_core_flags {
393 32     32   62 my ( $self ) = @_;
394              
395 32         82 for ( $self->_core_flags->@* ) {
396 9 50       17 say "Processing: $_->{name}" if $self->_opts->{dump};
397 9         15 my $handler = $_->{handler};
398 9 100       32 return 1 if $self->$handler;
399             }
400              
401 28         91 return 0;
402             }
403              
404             # Help
405              
406             sub _show_help {
407 2     2   3 my ( $self ) = @_;
408              
409 2         5 say $self->_process_template(
410             $self->_define_help_template,
411             $self->_build_help_options,
412             );
413              
414 2         23 return 1;
415             }
416              
417             sub _define_help_template {
418 2     2   6 <<"HELP";
419              
420             ##_neon:Syntax:
421