#!/usr/bin/perl

package JMX::Jmx4Perl::J4psh::CommandHandler;

use strict;
use Data::Dumper;
use Term::ANSIColor qw(:constants);
use Module::Find;

=head1 NAME 

JMX::Jmx4Perl::J4psh::CommandHandler - Handler for j4psh commands

=head1 DESCRIPTION

This object is responsible for managing L<JMX::Jmx4Perl::Command> objects which
are at the heart of j4psh and provide all features. During startup it
registeres commands dynamically and pushes the L<JMX::Jmx4Perl::Shell> context to them
for allowing to access the agent and other handlers.

Registration is occurs in two phases:

...

It also keeps a stack of so called navigational I<context> which can be used to
provide a menu like structure (think of it like directories which can be
entered). If the stack contains elements, the navigational commands C<..> and
C</> are added to traverse the stack. C</> will always jump to the top of the
stack (the I<root directory>) whereas C<..> will pop up one level in the stack
(the I<parent directory>). Commands which want to manipulate the stack like
pushing themselves on the stack should use the methods L</push_on_stack> or
L</reset_stack> (for jumping to the top of the menu).

=cut

=head1 METHODS

=over

=item $command_handler = new JMX::Jmx4Perl::Shell::CommandHandler($context,$ui)

Create a new command handler object. The arguments to be passed are the context
object (C<$context>) and the shell object (C<$shell>) in order to update the
shell's current command set.

=cut 

sub new { 
    my $class = shift;
    my $context = shift || "No context object given";    
    my $shell = shift || "No shell given";
    my $extra = shift;
    $extra = { $extra, @_ } unless ref($extra) eq "HASH";
    my $self = {
                context => $context,
                shell => $shell,
                %{$extra}
               };
    $self->{stack} = [];
    bless $self,(ref($class) || $class);
    $shell->term->prompt($self->_prompt);
    $self->_register_commands;
    return $self;
}

=item $comand_handler->push_on_stack($context,$cmds)

Update the stack with an entry of name C<$context> which provides the commands
C<$cmds>. C<$cmds> must be a hashref as known to L<Term::ShellUI>, whose
C<commands> method is used to update the shell. Additionally it updates the
shell's prompt to reflect the state of the stack.

=cut 

sub push_on_stack {
    my $self = shift;
    # The new context
    my $context = shift;
    # Sub-commands within the context
    my $sub_cmds = shift;
    my $separator = shift || "/";
    my $contexts = $self->{stack};
    push @$contexts,{ name => $context, cmds => $sub_cmds, separator => $separator };
    #print Dumper(\@contexts);

    my $shell = $self->{shell};
    # Set sub-commands
    $shell->commands
      ({
        %$sub_cmds,
        %{$self->_global_commands},
        %{$self->_navigation_commands},
       }
      );    
}

=item $command_handler->reset_stack

Reset the stack and install the top and global commands as collected from the
registered L<OSGi::Osgish::Command>.

=cut

sub reset_stack {
    my $self = shift;
    my $shell = $self->{shell};
    $shell->commands({ %{$self->_top_commands}, %{$self->_global_commands}});
    $self->{stack} = [];
}

=item $command = $command_handler->command($command_name) 

Get a registered command by name

=cut 

sub command {
    my $self = shift;
    my $name = shift || die "No command name given";
    return $self->{commands}->{$name};
}

=back

=cut

# ============================================================================

sub _top_commands {
    my $self = shift;
    my $top = $self->{top_commands};
    my @ret = ();
    for my $command (values %$top) {
        push @ret, %{$command->top_commands};        
    }
    return { @ret };
}

sub _global_commands {
    my $self = shift;
    my $globals = $self->{global_commands};
    my @ret = ();
    for my $command (values %$globals) {
        push @ret, %{$command->global_commands};        
    }
    return { @ret };
}


sub _navigation_commands {
    my $self = shift;
    my $shell = $self->{shell};
    my $contexts = $self->{stack};
    if (@$contexts > 0) {
        return 
            {".." => {
                      desc => "Go up one level",
                      proc => 
                      sub { 
                          $self->pop_off_stack();
                      }
                     },
             "/" => { 
                     desc => "Go to the top level",
                     proc => 
                     sub { 
                         $self->reset_stack();
                     }
                    }
            };
    } else {
        return {};
    }
}

# Go up one in the hierarchy
sub pop_off_stack {
    my $self = shift;
    my $shell = $self->{shell};
    my $stack = $self->{stack};
    my $parent = pop @$stack;
    if (@$stack > 0) {
        $shell->commands
          ({
            %{$stack->[$#{$stack}]->{cmds}},
            %{$self->_global_commands},
            %{$self->_navigation_commands},
           }
          );    
    } else { 
        $shell->commands({ 
                          %{$self->_top_commands},
                          %{$self->_global_commands},
                         });
    }
}

sub _register_commands { 
    my $self = shift;
    my $context = $self->{context};
    my $modules = $self->find_commands();
    my $commands = {};
    my $top = {};
    my $globals = {};
    for my $module (@$modules) {
        my $file = $module;
        $file =~ s/::/\//g;
        require $file . ".pm";
        $module->import;
        my $command = eval "$module->new(\$context)";
        die "Cannot register $module: ",$@ if $@;
        $commands->{$command->name} = $command;
        my $top_cmd = $command->top_commands;
        if ($top_cmd) {
            $top->{$command->name} = $command;
        }
        my $global_cmd = $command->global_commands;
        if ($global_cmd) {
            $globals->{$command->name} = $command;
        }
    }
    $self->{commands} = $commands;
    $self->{top_commands} = $top;
    $self->{global_commands} = $globals;
    $self->reset_stack;
}

sub find_commands { 
    my $self = shift;
    my $command_pkgs = ref($self->{command_packages}) eq "ARRAY" ? $self->{command_packages} : [ $self->{command_packages} ];
    my @modules = ();
    for my $pkg (@{$command_pkgs}) {
        for my $command (findsubmod $pkg) {
            next unless $command;
            push @modules,$command;
        }
    }
    if ($self->{command_modules}) {
        my $command_modules = 
          ref($self->{command_modules}) eq "ARRAY" ? $self->{command_modules} : [ $self->{command_modules} ];
        for my $command (@$command_modules) {
            push @modules,$command;
        }
    }
    return \@modules;
}

sub _prompt {
    my $self = shift;
    my $context = $self->{context};
    my $shell = $self->{shell};
    return sub {
        my $term = shift;
        my $stack = $self->{stack};
        my $agent = $context->agent;
        my ($c_host,$c_context,$c_empty,$reset) = 
          $self->{no_color_prompt} ? ("","","","") : $shell->color("host","prompt_context","prompt_empty",RESET,{escape => 1});
        my $p = "[";
        $p .= $agent ? $c_host . $context->server : $c_empty . $context->name;
        $p .= $reset;
        $p .= " " . $c_context if @$stack;
        for my $i (0 .. $#{$stack}) {
            $p .= $stack->[$i]->{name};
            $p .= $i < $#{$stack} ? $stack->[$i]->{separator} : $reset;
        }
        $p .= "] : ";
        return $p;
    };
}

=head1 LICENSE

This file is part of jmx4perl.

Jmx4perl is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 2 of the License, or
(at your option) any later version.

jmx4perl is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with jmx4perl.  If not, see <http://www.gnu.org/licenses/>.

A commercial license is available as well. Please contact roland@cpan.org for
further details.

=head1 PROFESSIONAL SERVICES

Just in case you need professional support for this module (or Nagios or JMX in
general), you might want to have a look at
http://www.consol.com/opensource/nagios/. Contact roland.huss@consol.de for
further information (or use the contact form at http://www.consol.com/contact/)

=head1 AUTHOR

roland@cpan.org

=cut

1;