File Coverage

blib/lib/App/Cmd/Simple.pm

Criterion	Covered	Total	%
statement	48	49	97.9
branch	7	10	70.0
condition	4	6	66.6
subroutine	16	17	94.1
pod	1	1	100.0
total	76	83	91.5

use strict;
use warnings;

package App::Cmd::Simple 0.334;

use App::Cmd::Command;
BEGIN { our @ISA = 'App::Cmd::Command' }

# ABSTRACT: a helper for building one-command App::Cmd applications

use App::Cmd;
use Sub::Install;

#pod =head1 SYNOPSIS
#pod
#pod in F:
#pod
#pod   use YourApp::Cmd;
#pod   Your::Cmd->run;
#pod
#pod in F:
#pod
#pod   package YourApp::Cmd;
#pod   use parent qw(App::Cmd::Simple);
#pod
#pod   sub opt_spec {
#pod     return (
#pod       [ "blortex|X",  "use the blortex algorithm" ],
#pod       [ "recheck|r",  "recheck all results"       ],
#pod     );
#pod   }
#pod
#pod   sub validate_args {
#pod     my ($self, $opt, $args) = @_;
#pod
#pod     # no args allowed but options!
#pod     $self->usage_error("No args allowed") if @$args;
#pod   }
#pod
#pod   sub execute {
#pod     my ($self, $opt, $args) = @_;
#pod
#pod     my $result = $opt->{blortex} ? blortex() : blort();
#pod
#pod     recheck($result) if $opt->{recheck};
#pod
#pod     print $result;
#pod   }
#pod
#pod and, finally, at the command line:
#pod
#pod   knight!rjbs$ simplecmd --recheck
#pod
#pod   All blorts successful.
#pod
#pod =head1 SUBCLASSING
#pod
#pod When writing a subclass of App::Cmd:Simple, there are only a few methods that
#pod you might want to implement.  They behave just like the same-named methods in
#pod App::Cmd.
#pod
#pod =head2 opt_spec
#pod
#pod This method should be overridden to provide option specifications.  (This is
#pod list of arguments passed to C from Getopt::Long::Descriptive,
#pod after the first.)
#pod
#pod If not overridden, it returns an empty list.
#pod
#pod =head2 usage_desc
#pod
#pod This method should be overridden to provide the top level usage line.
#pod It's a one-line summary of how the command is to be invoked, and
#pod should be given in the format used for the C<$usage_desc> parameter to
#pod C in Getopt::Long::Descriptive.
#pod
#pod If not overridden, it returns something that prints out like:
#pod
#pod   yourapp [-?h] [long options...]
#pod
#pod =head2 validate_args
#pod
#pod   $cmd->validate_args(\%opt, \@args);
#pod
#pod This method is passed a hashref of command line options (as processed by
#pod Getopt::Long::Descriptive) and an arrayref of leftover arguments.  It may throw
#pod an exception (preferably by calling C) if they are invalid, or it
#pod may do nothing to allow processing to continue.
#pod
#pod =head2 execute
#pod
#pod   Your::App::Cmd::Simple->execute(\%opt, \@args);
#pod
#pod This method does whatever it is the command should do!  It is passed a hash
#pod reference of the parsed command-line options and an array reference of left
#pod over arguments.
#pod
#pod =cut

# The idea here is that the user will someday replace "Simple" in his ISA with
# "Command" and then write a standard App::Cmd package.  To make that possible,
# we produce a behind-the-scenes App::Cmd object when the user says 'use
# MyApp::Simple' and redirect MyApp::Simple->run to that.
my $i;
BEGIN { $i = 0 }

sub import {
  my ($class) = @_;
  return if $class eq __PACKAGE__;

  # This signals that something has already set the target up.
  return $class if $class->_cmd_pkg;

  my $core_execute = App::Cmd::Command->can('execute');
  my $our_execute  = $class->can('execute');
  Carp::confess(
    "App::Cmd::Simple subclasses must implement ->execute, not ->run"
  ) unless $our_execute and $our_execute != $core_execute;

  # I doubt the $i will ever be needed, but let's start paranoid.
  my $generated_name = join('::', $class, '_App_Cmd', $i++);

  {
    no strict 'refs';
    *{$generated_name . '::ISA'} = [ 'App::Cmd' ];
  }

  Sub::Install::install_sub({
    into => $class,
    as   => '_cmd_pkg',
    code => sub { $generated_name },
  });

  Sub::Install::install_sub({
      into => $class,
      as => 'command_names',
      code => sub { 'only' },
  });

  Sub::Install::install_sub({
    into => $generated_name,
    as   => '_plugins',
    code => sub { $class },
  });

  Sub::Install::install_sub({
    into => $generated_name,
    as   => 'default_command',
    code => sub { 'only' },
  });

  Sub::Install::install_sub({
    into => $generated_name,
    as   => '_cmd_from_args',
    code => sub {
      my ($self, $args) = @_;
      if (defined(my $command = $args->[0])) {
        my $plugin = $self->plugin_for($command);
        # If help was requested, show the help for the command, not the
        # main help. Because the main help would talk about subcommands,
        # and a "Simple" app has no subcommands.
        if ($plugin and $plugin eq $self->plugin_for("help")) {
          return ($command, [ $self->default_command ]);
        }
        # Any other value for "command" isn't really a command at all --
        # it's the first argument. So call the default command instead.
      }
      return ($self->default_command, $args);
    },
  });

  Sub::Install::install_sub({
    into => $class,
    as   => 'run',
    code => sub {
      $generated_name->new({
        no_help_plugin     => 0,
        no_commands_plugin => 1,
      })->run(@_);
    }
  });

  return $class;
}

sub usage_desc {
  return "%c %o"
}

sub _cmd_pkg { }

#pod =head1 WARNINGS
#pod
#pod B  Although it is probably not going
#pod to change much, don't build your business model around it yet, okay?
#pod
#pod App::Cmd::Simple is not rich in black magic, but it does do some somewhat
#pod gnarly things to make an App::Cmd::Simple look as much like an
#pod App::Cmd::Command as possible.  This means that you can't deviate too much from
#pod the sort of thing shown in the synopsis as you might like.  If you're doing
#pod something other than writing a fairly simple command, and you want to screw
#pod around with the App::Cmd-iness of your program, Simple might not be the best
#pod choice.
#pod
#pod B  if you are writing a program with the
#pod App::Cmd::Simple class embedded in it, you B call import on the class.
#pod That's how things work.  You can just do this:
#pod
#pod   YourApp::Cmd->import->run;
#pod
#pod =cut

1;

__END__