The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# -*- coding: utf-8 -*-
# Copyright (C) 2011-2012 Rocky Bernstein <rockbcpan.org>

use warnings; no warnings 'redefine'; no warnings 'once';
use rlib '../../../../..';

package Devel::Trepan::CmdProcessor::Command::Show::Aliases;
use Devel::Trepan::CmdProcessor::Command::Subcmd::Core;

@ISA = qw(Devel::Trepan::CmdProcessor::Command::Subcmd);
# Values inherited from parent
use vars @Devel::Trepan::CmdProcessor::Command::Subcmd::SUBCMD_VARS;

## FIXME: do automatically.
our $CMD = "show aliases";
our $HELP         = <<"EOH";
$CMD [NAME1 NAME2 ...] 

If aliases names are given, show their definition. If left blank, show
all alias names
EOH

our $MIN_ABBREV = length('al');
our $SHORT_HELP = "Show defined aliases";

sub complete($$)
{
    my ($self, $prefix) = @_;
    my $proc = $self->{proc};
    my @candidates = keys %{$proc->{aliases}};
    my @matches = 
        Devel::Trepan::Complete::complete_token(\@candidates, $prefix);
    sort @matches;
}    

sub run($$) {
    my ($self, $args) = @_;
    my $proc = $self->{proc};
    my @args = @$args;
    if (scalar(@args) > 2) {
        shift @args; shift @args;
        for my $alias_name (@args) {
            if (exists $proc->{aliases}{$alias_name}) {
                my $msg = sprintf "%s: %s", $alias_name, $proc->{aliases}{$alias_name};
                $proc->msg($msg);
            } else {
                $proc->msg("$alias_name is not a defined alias");
            }
        }
    } else {
        my @aliases = keys %{$proc->{aliases}};
        if (scalar @aliases == 0) {
            $proc->msg("No aliases defined.");
        } else {
            $proc->section("List of alias names currently defined:");
            my @cmds = sort @aliases;
            $proc->msg($self->{cmd}->columnize_commands(\@cmds));
        }
   }
}

unless(caller) {
    # Demo it.
    # require_relative '../../mock';
    # my $cmd = MockDebugger::sub_setup(__PACKAGE__);
    # my $cmd->run($cmd->{prefix} + %w(u foo));
}

1;