App-MatrixTool

 view release on metacpan or  search on metacpan

lib/App/MatrixTool.pm  view on Meta::CPAN

C<App::MatrixTool> - commands to interact with a Matrix home-server

=head1 SYNOPSIS

Usually this would be used via the F<matrixtool> command

 $ matrixtool server-key matrix.org

=head1 DESCRIPTION

Provides the base class and basic level support for commands that interact
with a Matrix home-server. See individual command modules, found under the
C<App::MatrixTool::Command::> namespace, for details on specific commands.

=cut

readonly_struct ArgSpec => [qw( name print_name optional eatall )];
sub ARGSPECS
{
   map {
      my $name = $_;
      my $optional = $name =~ s/\?$//;
      my $eatall   = $name =~ m/\.\.\.$/;

      ( my $print_name = uc $name ) =~ s/_/-/g;

      ArgSpec( $name, $print_name, $optional||$eatall, $eatall )
   } shift->ARGUMENTS;
}

readonly_struct OptSpec => [qw( name print_name shortname getopt description )];
sub OPTSPECS
{
   pairmap {
      my ( $name, $desc ) = ( $a, $b ); # allocate new SVtPVs to placate odd COW-related bug in 5.18

      my $getopt = $name;

      $name =~ s/=.*//;

      my $shortname;
      $name =~ s/^(.)\|// and $shortname = $1;

      my $printname = $name;
      $name =~ s/-/_/g;

      OptSpec( $name, $printname, $shortname, $getopt, $desc )
   } shift->OPTIONS;
}

sub new
{
   my $class = shift;
   return bless { @_ }, $class;
}

sub sock_family
{
   my $self = shift;
   return AF_INET if $self->{inet4};
   return AF_INET6 if $self->{inet6};
   return AF_UNSPEC;
}

sub _pkg_for_command
{
   my $self = shift;
   my ( $cmd ) = @_;

   my $class = ref $self || $self;

   my $base = $class eq __PACKAGE__ ? "App::MatrixTool::Command" : $class;

   # Allow hyphens in command names
   $cmd =~ s/-/_/g;

   my $pkg = "${base}::${cmd}";
   use_package_optimistically( $pkg );
}

sub run
{
   my $self = shift;
   my @args = @_;

   my %global_opts;
   $opt_parser->getoptionsfromarray( \@args,
      'inet4|4' => \$global_opts{inet4},
      'inet6|6' => \$global_opts{inet6},
      'print-request'  => \$global_opts{print_request},
      'print-response' => \$global_opts{print_response},
   ) or return 1;

   my $cmd = @args ? shift @args : "help";

   my $pkg = $self->_pkg_for_command( $cmd );
   $pkg->can( "new" ) or
      return $self->error( "No such command '$cmd'" );

   my $runner = $pkg->new( %global_opts );

   $self->run_command_in_runner( $runner, @args );
}

sub run_command_in_runner
{
   my $self = shift;
   my ( $runner, @args ) = @_;

   my @argvalues;

   if( $runner->can( "OPTIONS" ) ) {
      my %optvalues;

      $opt_parser->getoptionsfromarray( \@args,
         map { $_->getopt => \$optvalues{ $_->name } } $runner->OPTSPECS
      ) or exit 1;

      push @argvalues, \%optvalues;
   }

   my @argspecs = $runner->ARGSPECS;
   while( @argspecs ) {
      my $spec = shift @argspecs;

      if( !@args ) {
         last if $spec->optional;

         return $self->error( "Required argument '${\ $spec->print_name }' missing" );
      }

      if( $spec->eatall ) {
         push @argvalues, @args;
         @args = ();
      }
      else {
         push @argvalues, shift @args;
      }
   }
   @args and return $self->error( "Found extra arguments" );

   my $ret = $runner->run( @argvalues );
   $ret = $ret->get if blessed $ret and $ret->isa( "Future" );
   $ret //= 0;

   return $ret;
}

sub output

lib/App/MatrixTool.pm  view on Meta::CPAN

{
   my $self = shift;

   return $self->{client_token_store} ||= do {
      require App::MatrixTool::ServerIdStore;
      App::MatrixTool::ServerIdStore->new(
         path => $self->client_token_store_path,
         encode => "raw", # client tokens are already base64 encoded
      );
   };
}

sub JSON_pretty { $JSON_pretty }

## Builtin commands

package
   App::MatrixTool::Command::help;
use base qw( App::MatrixTool );

use List::Util qw( max );

use constant DESCRIPTION => "Display help information about commands";
use constant ARGUMENTS => ( "command...?" );

use Struct::Dumb qw( readonly_struct );
readonly_struct CommandSpec => [qw( name description argspecs optspecs package )];

sub commands
{
   my $mp = Module::Pluggable::Object->new(
      require => 1,
      search_path => [ "App::MatrixTool::Command" ],
   );

   my @commands;

   foreach my $module ( sort $mp->plugins ) {
      $module->can( "DESCRIPTION" ) or next;

      my $cmd = $module;
      $cmd =~ s/^App::MatrixTool::Command:://;
      $cmd =~ s/_/-/g;
      $cmd =~ s/::/ /g;

      push @commands, CommandSpec(
         $cmd,
         $module->DESCRIPTION,
         [ $module->ARGSPECS ],
         $module->can( "OPTIONS" ) ? [ $module->OPTSPECS ] : undef,
         $module,
      );
   }

   return @commands;
}

my $GLOBAL_OPTS = <<'EOF';
Global options:
   -4 --inet4             Use only IPv4
   -6 --inet6             Use only IPv6
      --print-request     Print sent HTTP requests in full
      --print-response    Print received HTTP responses in full
EOF

sub help_summary
{
   my $self = shift;

   $self->output( <<'EOF' . $GLOBAL_OPTS );
matrixtool [<global options...>] <command> [<command options...>]

EOF

   my @commands = $self->commands;

   my $namelen = max map { length $_->name } @commands;

   $self->output( "Commands:\n" .
      join "\n", map { sprintf "  %-*s    %s", $namelen, $_->name, $_->description } @commands
   );
}

sub _argdesc
{
   shift;
   my ( $argspec ) = @_;
   my $name = $argspec->print_name;
   return $argspec->optional ? "[$name]" : $name;
}

sub _optdesc
{
   my ( $optspec, $namelen ) = @_;

   my $shortname = $optspec->shortname;

   join "",
      ( defined $shortname ? "-$shortname " : "   " ),
      sprintf( "--%-*s", $namelen, $optspec->print_name ),
      "    ",
      $optspec->description,
}

sub help_detailed
{
   my $self = shift;
   my ( $cmd ) = @_;

   my $pkg = App::MatrixTool->_pkg_for_command( $cmd );
   $pkg->can( "new" ) or
      return $self->error( "No such command '$cmd'" );

   my @argspecs = $pkg->ARGSPECS;

   $self->output( join " ", "matrixtool",
      "[<global options...>]",
      $cmd,
      ( map $self->_argdesc($_), @argspecs ),
      "[<command options...>]"
   );



( run in 0.259 second using v1.01-cache-2.11-cpan-eab888a1d7d )