File Coverage

blib/lib/Devel/MAT/InternalTools.pm
Criterion Covered Total %
statement 38 107 35.5
branch 0 38 0.0
condition 0 2 0.0
subroutine 13 22 59.0
pod n/a
total 51 169 30.1


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2016-2018 -- leonerd@leonerd.org.uk
5              
6             package Devel::MAT::InternalTools 0.50;
7              
8 9     9   110 use v5.14;
  9         33  
9 9     9   46 use warnings;
  9         18  
  9         397  
10              
11             package Devel::MAT::Tool::help;
12              
13 9     9   66 use base qw( Devel::MAT::Tool );
  9         16  
  9         4211  
14              
15 9     9   62 use constant CMD => "help";
  9         24  
  9         479  
16 9     9   653 use constant CMD_DESC => "Display a list of available commands";
  9         34  
  9         612  
17              
18 9         7442 use constant CMD_ARGS => (
19             { name => "cmdname", help => "name of a command to display more help",
20             slurpy => 1 },
21 9     9   57 );
  9         31  
22              
23             sub run
24             {
25 0     0     my $self = shift;
26 0           my ( $cmdname, @subnames ) = @_;
27              
28 0 0         if( defined $cmdname ) {
29 0           $self->help_cmd( $cmdname, @subnames );
30             }
31             else {
32 0           $self->help_summary;
33             }
34             }
35              
36             sub help_summary
37             {
38 0     0     my $self = shift;
39              
40 0           my $pmat = $self->{pmat};
41              
42             my @commands = sort map {
43 0           my $class = "Devel::MAT::Tool::$_";
  0            
44 0 0         $class->can( "CMD" ) ? [ $class->CMD => $class->CMD_DESC ] : ()
45             } $pmat->available_tools;
46              
47             Devel::MAT::Cmd->print_table(
48             [
49             map { [
50 0           Devel::MAT::Cmd->format_note( $_->[0] ),
51             $_->[1],
52 0           ] } sort { $a->[0] cmp $b->[0] } @commands
  0            
53             ],
54             sep => " - ",
55             );
56             }
57              
58             # A join() that respects stringify overloading
59             sub _join
60             {
61 0     0     my $sep = shift;
62 0           my $ret = shift;
63 0           $ret .= "$sep$_" for @_;
64 0           return $ret;
65             }
66              
67             sub help_cmd
68             {
69 0     0     my $self = shift;
70 0           my ( $cmdname, @subnames ) = @_;
71              
72 0           my $fullname = join " ", $cmdname, @subnames;
73              
74 0           my $tool = $self->{pmat}->load_tool_for_command( $cmdname );
75 0           $tool = $tool->find_subcommand( $_ ) for @subnames;
76              
77 0           Devel::MAT::Cmd->printf( "%s - %s\n",
78             Devel::MAT::Cmd->format_note( $fullname ),
79             $tool->CMD_DESC,
80             );
81              
82 0 0         if( my $code = $tool->can( "help_cmd" ) ) {
83 0           $tool->$code();
84 0           return;
85             }
86              
87 0           my %optspec = $tool->CMD_OPTS;
88 0           my @argspec = $tool->CMD_ARGS;
89              
90 0           Devel::MAT::Cmd->printf( "\nSYNOPSIS:\n" );
91             Devel::MAT::Cmd->printf( " %s\n", join " ",
92             $fullname,
93             %optspec ? "[OPTIONS...]" : (),
94             $tool->CMD_ARGS_SV ? "[SV ADDR]" : (),
95 0 0         @argspec ? ( map { "\$\U$_->{name}" } @argspec ) : (),
  0 0          
    0          
96             );
97              
98 0 0         if( %optspec ) {
99 0           Devel::MAT::Cmd->printf( "\nOPTIONS:\n" );
100              
101             Devel::MAT::Cmd->print_table(
102             [ map {
103 0           my $optname = $_;
  0            
104 0           my $opt = $optspec{$_};
105              
106 0           my @names = $optname;
107 0 0         push @names, $opt->{alias} if $opt->{alias};
108 0           s/_/-/g for @names;
109              
110             my $synopsis = _join ", ", map {
111 0 0         Devel::MAT::Cmd->format_note( length > 1 ? "--$_" : "-$_", 1 )
  0            
112             } @names;
113              
114 0 0         if( my $type = $opt->{type} ) {
115 0 0         $synopsis .= " INT" if $type eq "i";
116 0 0         $synopsis .= " STR" if $type eq "s";
117             }
118              
119 0           [ $synopsis, $opt->{help} ],
120             } sort keys %optspec ],
121             sep => " ",
122             indent => 2,
123             );
124             }
125              
126 0 0         if( @argspec ) {
127 0           Devel::MAT::Cmd->printf( "\nARGUMENTS:\n" );
128              
129             Devel::MAT::Cmd->print_table(
130             [ map {
131 0           my $arg = $_;
  0            
132              
133             [ "\$\U$arg->{name}" . ( $arg->{slurpy} ? "..." :
134 0 0         $arg->{repeated} ? "*" : "" ), $arg->{help} ],
    0          
135             } @argspec ],
136             sep => " ",
137             indent => 2,
138             );
139             }
140             }
141              
142             package Devel::MAT::Tool::more;
143              
144 9     9   70 use base qw( Devel::MAT::Tool );
  9         19  
  9         1013  
145              
146 9     9   73 use constant CMD => "more";
  9         27  
  9         508  
147 9     9   53 use constant CMD_DESC => "Continue the previous listing";
  9         23  
  9         2149  
148              
149             my $more;
150              
151             sub run
152             {
153 0 0   0     if( $more ) {
154 0 0         $more->() or undef $more;
155             }
156             else {
157 0           Devel::MAT::Cmd->printf( "%s\n", Devel::MAT::Cmd->format_note( "No more" ) );
158             }
159             }
160              
161             sub paginate
162             {
163 0     0     shift;
164 0 0         my $opts = ( ref $_[0] eq "HASH" ) ? shift : {};
165 0           my ( $func ) = @_;
166              
167 0   0 0     $more = sub { $func->( $opts->{pagesize} // 30 ) };
  0            
168              
169 0 0         $more->() or undef $more;
170             }
171              
172             sub can_more
173             {
174 0     0     return defined $more;
175             }
176              
177             package Devel::MAT::Tool::time;
178              
179 9     9   64 use base qw( Devel::MAT::Tool );
  9         17  
  9         986  
180              
181 9     9   61 use constant CMD => "time";
  9         31  
  9         457  
182 9     9   55 use constant CMD_DESC => "Measure the runtime of a command";
  9         27  
  9         540  
183              
184 9     9   105 use Time::HiRes qw( gettimeofday tv_interval );
  9         22  
  9         103  
185              
186             sub run_cmd
187             {
188 0     0     my $self = shift;
189 0           my ( $inv ) = @_;
190              
191 0           my $cmd = $inv->pull_token;
192              
193 0           my $starttime = [gettimeofday];
194              
195 0           my $tool = $self->pmat->load_tool_for_command( $cmd );
196 0           my $loadtime = tv_interval( $starttime );
197              
198 0           $tool->run_cmd( $inv );
199              
200 0           my $runtime = tv_interval( $starttime );
201              
202 0           Devel::MAT::Cmd->printf( "\nLoaded in %.03fs, ran in %.03fs\n",
203             $loadtime, $runtime - $loadtime,
204             );
205             }
206              
207             0x55AA;