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

#  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 -- [e-mail]

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;