# You may distribute under the terms of either the GNU General Public License
# or the Artistic License (the same terms as Perl itself)
#
# (C) Paul Evans, 2016-2018 -- leonerd@leonerd.org.uk
package Devel::MAT::InternalTools 0.51;
use v5.14;
use warnings;
package Devel::MAT::Tool::help;
use base qw( Devel::MAT::Tool );
use constant CMD => "help";
use constant CMD_DESC => "Display a list of available commands";
use constant CMD_ARGS => (
{ name => "cmdname", help => "name of a command to display more help",
slurpy => 1 },
);
sub run
{
my $self = shift;
my ( $cmdname, @subnames ) = @_;
if( defined $cmdname ) {
$self->help_cmd( $cmdname, @subnames );
}
else {
$self->help_summary;
}
}
sub help_summary
{
my $self = shift;
my $pmat = $self->{pmat};
my @commands = sort map {
my $class = "Devel::MAT::Tool::$_";
$class->can( "CMD" ) ? [ $class->CMD => $class->CMD_DESC ] : ()
} $pmat->available_tools;
Devel::MAT::Cmd->print_table(
[
map { [
Devel::MAT::Cmd->format_note( $_->[0] ),
$_->[1],
] } sort { $a->[0] cmp $b->[0] } @commands
],
sep => " - ",
);
}
# A join() that respects stringify overloading
sub _join
{
my $sep = shift;
my $ret = shift;
$ret .= "$sep$_" for @_;
return $ret;
}
sub help_cmd
{
my $self = shift;
my ( $cmdname, @subnames ) = @_;
my $fullname = join " ", $cmdname, @subnames;
my $tool = $self->{pmat}->load_tool_for_command( $cmdname );
$tool = $tool->find_subcommand( $_ ) for @subnames;
Devel::MAT::Cmd->printf( "%s - %s\n",
Devel::MAT::Cmd->format_note( $fullname ),
$tool->CMD_DESC,
);
if( my $code = $tool->can( "help_cmd" ) ) {
$tool->$code();
return;
}
my %optspec = $tool->CMD_OPTS;
my @argspec = $tool->CMD_ARGS;
Devel::MAT::Cmd->printf( "\nSYNOPSIS:\n" );
Devel::MAT::Cmd->printf( " %s\n", join " ",
$fullname,
%optspec ? "[OPTIONS...]" : (),
$tool->CMD_ARGS_SV ? "[SV ADDR]" : (),
@argspec ? ( map { "\$\U$_->{name}" } @argspec ) : (),
);
if( %optspec ) {
Devel::MAT::Cmd->printf( "\nOPTIONS:\n" );
Devel::MAT::Cmd->print_table(
[ map {
my $optname = $_;
my $opt = $optspec{$_};
my @names = $optname;
push @names, $opt->{alias} if $opt->{alias};
s/_/-/g for @names;
my $synopsis = _join ", ", map {
Devel::MAT::Cmd->format_note( length > 1 ? "--$_" : "-$_", 1 )
} @names;
if( my $type = $opt->{type} ) {
$synopsis .= " INT" if $type eq "i";
$synopsis .= " STR" if $type eq "s";
}
[ $synopsis, $opt->{help} ],
} sort keys %optspec ],
sep => " ",
indent => 2,
);
}
if( @argspec ) {
Devel::MAT::Cmd->printf( "\nARGUMENTS:\n" );
Devel::MAT::Cmd->print_table(
[ map {
my $arg = $_;
[ "\$\U$arg->{name}" . ( $arg->{slurpy} ? "..." :
$arg->{repeated} ? "*" : "" ), $arg->{help} ],
} @argspec ],
sep => " ",
indent => 2,
);
}
}
package Devel::MAT::Tool::more;
use base qw( Devel::MAT::Tool );
use constant CMD => "more";
use constant CMD_DESC => "Continue the previous listing";
my $more;
sub run
{
if( $more ) {
$more->() or undef $more;
}
else {
Devel::MAT::Cmd->printf( "%s\n", Devel::MAT::Cmd->format_note( "No more" ) );
}
}
sub paginate
{
shift;
my $opts = ( ref $_[0] eq "HASH" ) ? shift : {};
my ( $func ) = @_;
$more = sub { $func->( $opts->{pagesize} // 30 ) };
$more->() or undef $more;
}
sub can_more
{
return defined $more;
}
package Devel::MAT::Tool::time;
use base qw( Devel::MAT::Tool );
use constant CMD => "time";
use constant CMD_DESC => "Measure the runtime of a command";
use Time::HiRes qw( gettimeofday tv_interval );
sub run_cmd
{
my $self = shift;
my ( $inv ) = @_;
my $cmd = $inv->pull_token;
my $starttime = [gettimeofday];
my $tool = $self->pmat->load_tool_for_command( $cmd );
my $loadtime = tv_interval( $starttime );
$tool->run_cmd( $inv );
my $runtime = tv_interval( $starttime );
Devel::MAT::Cmd->printf( "\nLoaded in %.03fs, ran in %.03fs\n",
$loadtime, $runtime - $loadtime,
);
}
0x55AA;