File Coverage

blib/lib/App/CmdDispatch/Table.pm

Criterion	Covered	Total	%
statement	62	62	100.0
branch	26	26	100.0
condition	5	5	100.0
subroutine	12	12	100.0
pod	7	7	100.0
total	112	112	100.0

package App::CmdDispatch::Table;

use warnings;
use strict;
use App::CmdDispatch::Exception;

our $VERSION = '0.42';

sub new
{
    my ( $class, $commands, $aliases ) = @_;
    $aliases ||= {};
    die "Command definition is not a hashref.\n" unless ref $commands eq ref {};
    die "No commands specified.\n"               unless keys %{$commands};
    die "Aliases definition is not a hashref.\n" unless ref $aliases eq ref {};

    my $self = bless {
        cmds    => {},
        alias   => {},
    }, $class;

    $self->_ensure_valid_command_description( $commands );
    $self->_ensure_valid_aliases( $aliases );

    return $self;
}

sub run
{
    my ( $self, $base, $cmd, @args ) = @_;

    die App::CmdDispatch::Exception::MissingCommand->new if !defined $cmd || $cmd eq '';

    # Handle alias if one is supplied
    if( exists $self->{alias}->{$cmd} )
    {
        ( $cmd, @args ) = ( ( split / /, $self->{alias}->{$cmd} ), @args );
    }

    # Handle builtin commands
    die App::CmdDispatch::Exception::UnknownCommand->new( $cmd ) unless $self->{cmds}->{$cmd};
    $self->{cmds}->{$cmd}->{'code'}->( $base, @args );

    return;
}

sub _ensure_valid_command_description
{
    my ( $self, $cmds ) = @_;
    while ( my ( $key, $val ) = each %{$cmds} )
    {
        next if $key eq '';
        if( !defined $val )
        {
            delete $self->{cmds}->{$key};
            next;
        }
        die "Command '$key' is an invalid descriptor.\n" unless ref $val eq ref {};
        die "Command '$key' has no handler.\n" unless ref $val->{code} eq 'CODE';

        my $desc = { %{$val} };
        $self->{cmds}->{$key} = $desc;
    }

    return;
}

sub _ensure_valid_aliases
{
    my ( $self, $aliases ) = @_;
    while ( my ( $key, $val ) = each %{$aliases} )
    {
        next if $key eq '';
        if( !defined $val )
        {
            delete $self->{alias}->{$key};
            next;
        }
        die "Alias '$key' mapping is not a string.\n" if ref $val;
        $self->{alias}->{$key} = $val;
    }

    return;
}

sub command_list
{
    my ($self) = @_;
    return sort keys %{$self->{cmds}};  ## no critic - intended to return list
}

sub alias_list
{
    my ($self) = @_;
    return sort keys %{$self->{alias}};  ## no critic - intended to return list
}

sub get_command
{
    my ($self, $cmd) = @_;
    return $self->{cmds}->{$cmd};
}

sub get_alias
{
    my ($self, $alias) = @_;
    return $self->{alias}->{$alias};
}

sub has_aliases
{
    my ($self) = @_;
    return 0 != keys %{ $self->{alias} };
}

1;
__END__