view release on metacpan or  search on metacpan

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

            $self->_print( $ex->why(), "\n" );
            $self->command_hint;
        }
        else
        {
            die $ex;
        }
    };
    return;
}

sub command_list
{
    my ( $self ) = @_;
    return $self->{_command_sorter}->( $self->{table}->command_list() );
}

sub command_hint
{
    my ( $self ) = @_;
    return $self->{_helper}->hint() if defined $self->{_helper};
    $self->_print( "Commands: ", join( ', ', $self->command_list() ), "\n" );
    return;
}

sub hint
{
    my ( $self, $arg ) = @_;
    eval {
        $self->run( 'hint', $arg );
        1;
    } or do
    {
        return $self->{_helper}->hint( $arg ) if defined $self->{_helper};
        $self->_print( "Commands: ", join( ', ', $self->command_list() ), "\n" );
    };
    return;
}

sub help
{
    my ( $self, $arg ) = @_;
    eval {
        $self->run( 'help', $arg );
        1;
    } or do
    {
        return $self->{_helper}->help( $arg ) if defined $self->{_helper};
        $self->_print( "Commands: ", join( ', ', $self->command_list() ), "\n" );
    };
    return;
}

sub alias_list { return $_[0]->{table}->alias_list(); }

sub shell
{
    my ( $self ) = @_;

    $self->_print( "Enter a command or 'quit' to exit:\n" );
    while ( my $line = $self->_prompt( '> ' ) )
    {
        chomp $line;
        next unless $line =~ /\S/;
        last if $line eq 'quit';
        $self->run( split /\s+/, $line );
    }
    return;
}

sub _print
{
    my $self = shift;
    return $self->{io}->print( @_ );
}

sub _prompt
{
    my $self = shift;
    return $self->{io}->prompt( @_ );
}

sub _initialize_config
{
    my ( $self, $config_file ) = @_;
    my $conf = Config::Tiny->read( $config_file );
    %{ $self->{config} } = (
        ( $conf->{_} ? %{ delete $conf->{_} } : () ),    # first extract the top level
        %{$conf},                # Keep any multi-levels that are not aliases
        %{ $self->{config} },    # Override with supplied parameters
    );
    return;
}

sub _initialize_io_object
{
    my ( $self ) = @_;

    my $io = delete $self->{config}->{'io'};
    if( !defined $io )
    {
        eval {
            $io = App::CmdDispatch::IO->new();
        } or do {
            $io = App::CmdDispatch::MinimalIO->new();
        };
        die "Unable to create an IO object for CmdDispatch.\n" unless defined $io;
    }
    elsif( !_is_valid_io_object( $io ) )
    {
        die "Object supplied as io parameter does not supply correct interface.\n";
    }

    $self->{io} = $io;
    return;
}

sub _is_valid_io_object
{
    my ( $io ) = @_;
    return unless ref $io;
    return 2 == grep { $io->can( $_ ) } qw/print prompt/;
}

sub _setup_commands
{
    my ( $self, $commands ) = @_;
    $commands = { %{$commands} };

    return $commands unless $self->{config}->{default_commands};

    foreach my $def ( split / /, $self->{config}->{default_commands} )
    {
        if( $def eq 'shell' )
        {
            $commands->{shell} = {
                code     => \&App::CmdDispatch::shell,
                clue     => 'shell',
                abstract => 'Launch an interactive command shell.',
                help     => 'Execute commands as entered until quit.',
            };
        }
        elsif( $def eq 'help' )
        {
            require App::CmdDispatch::Help;
            $self->{_helper} = App::CmdDispatch::Help->new( $self, $commands, $self->{config} );
        }
        else
        {
            die "Unrecognized default command: '$def'\n";
        }
    }
    return $commands;
}

1;

__END__

=encoding utf-8

=head1 NAME

App::CmdDispatch - Handle command line processing for programs with subcommands

=head1 VERSION

This document describes C<App::CmdDispatch> version 0.44

=head1 SYNOPSIS

    use App::CmdDispatch;

    my %cmds = (
        start => {
            code => sub { my $app = shift; print "start: @_\n"; },
            clue => 'start [what]',
            abstract => 'Start something',
            help => 'Start whatever is to be run.',
        },
        stop => {
            code => sub { my $app = shift; print "stop @_\n"; },

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

This optional parameter gives a short (less than a line) explanation of the
command. The idea is to give a hint of the functionality to remind someone who
is mostly familiar with the commands.

When B<hint> is invoked, the C<abstract> is displayed on the same line as the
C<clue>.

If the parameter is not supplied and B<hint> is invoked, nothing is used by
default.

=item help

This optional parameter gives a fuller explanation of the command. It often
extends across several lines. The idea is to explain the functionality of the
command to someone that is not familiar with it.

When B<help> is invoked, the C<help> text is displayed after the line
containing the C<clue>.

If the parameter is not supplied and B<help> is invoked, nothing is used by
default.

=back

=head3 The $options hash

This hash determines some of the default behavior of the C<App::CmdDispatch>
object.

=over 4

=item config_file

This option is the name of a configuration file that is read using the format
specified in L<Config::Tiny>. This sets default configuration parameters and
aliases.

=item default_commands

This string provides a space separated list of default command behaviors.
The two supported behaviors are:

=over 4

=item help

Provide a B<help> command and a B<hint> command through the
L<App::CmdDispatch::Help> module.

=item shell

Prove a shell interface that loops asking for subcommands. Each command
is executed and contol returns to the loop.

=back

=item io

An object supplying input and output services for the CmdDispatcher. This
object must provide both a C<print> method and a C<prompt> method. See
L<App::CmdDispatch::IO> for more information on the interface.

=item help:*

The options beginning with the string 'help:' are described in the docs for
L<App::CmdDispatch::Help>.

=back

=head2 run( $cmd, @args )

This method looks up the supplied command and executes it.

=head2 command_hint( $cmd )

This method prints a short hint listing all commands and aliases or just the
hint for the supplied command.

=head2 hint( $cmd )

This method prints a short hint listing all commands and aliases or just the
hint for the supplied command.

=head2 help( $cmd )

This method prints help for the program or just help on the supplied command.

=head2 shell()

This method start a read/execute loop which supports running multiple commands
in the same execution of the main program.

=head2 get_config()

This method returns a reference to the configuration hash for the dispatcher.

=head2 command_list()

This method returns the list of commands in a defined order.

=head2 alias_list()

This method returns the list of aliases in sorted order.

=head1 CONFIGURATION AND ENVIRONMENT

C<App::CmdDispatch> can read a configuration file specified in a
L<Config::Tiny> supported format. Should be specified in the config parameter.

=head1 DEPENDENCIES

Config::Tiny
Term::Readline

=head1 INCOMPATIBILITIES

None reported.

=head1 BUGS AND LIMITATIONS