Agent-TCLI
view release on metacpan or search on metacpan
lib/Agent/TCLI/Control.pm view on Meta::CPAN
# similar to above, except as a separate arg. Used by Request objects
# to indicate that context should be ignored. args of a single
# '/' is handled as a context shift command and not temporary.
# also used by help for lookup.
shift (@{$args});
$self->Verbose( "FindCommand: Root context called, now using ".
$args->[0]." from root\n" );
push ( @c, @{$args} );
$depth = 0;
}
else
{
# We need to mash up context and args to find out what we're supposed to do.
$depth = $self->depth_context;
@c = @{ $self->context } unless ($depth == 0);
push ( @c, @{$args} );
$self->Verbose("FindCommand: depth(".$depth.') and @c'." \n",3,\@c);
}
$self->Verbose("FindCommand: current registered_commands hash \n",4,$registered_commands[$$self]);
# Try to find a match for the context and args in the command hash
# thisdepth will tell us how deep we found something ,or if we didn't
$thisdepth = -5;
# try first four combined args
if ( defined($c[2]) &&
defined($registered_commands[$$self]{$c[0]} ) &&
defined($registered_commands[$$self]{$c[0]}{$c[1]} ) &&
defined($registered_commands[$$self]{$c[0]}{$c[1]}{$c[2]} )
)
{
if ( defined($c[3]) &&
defined($registered_commands[$$self]{$c[0]}{$c[1]}{$c[2]}{$c[3]} )
)
{
$cmd =
$registered_commands[$$self]{$c[0]}{$c[1]}{$c[2]}{$c[3]}{'.'};
$thisdepth = 3;
}
# All handler
elsif ( defined($c[3]) &&
defined($registered_commands[$$self]{$c[0]}{$c[1]}{$c[2]}{'ALL'} )
)
{
$cmd =
$registered_commands[$$self]{$c[0]}{$c[1]}{$c[2]}{'ALL'}{'.'};
$thisdepth = 3;
}
# Universal in this context
elsif ( defined($c[3]) &&
defined($registered_commands[$$self]{$c[0]}{$c[1]}{'GROUP'}) &&
defined($registered_commands[$$self]{$c[0]}{$c[1]}{'GROUP'}{$c[3]})
)
{
$cmd =
$registered_commands[$$self]{$c[0]}{$c[1]}{'GROUP'}{$c[3]}{'.'};
$thisdepth = 3;
}
# $c[3] globally Universal
elsif ( defined($c[3]) &&
defined($registered_commands[$$self]{'UNIVERSAL'}{$c[3]} )
)
{
$cmd =
$registered_commands[$$self]{'UNIVERSAL'}{$c[3]}{'.'};
$thisdepth = 3;
}
elsif (
defined($registered_commands[$$self]{$c[0]}{$c[1]}{$c[2]}{'.'} )
)
{
$cmd =
$registered_commands[$$self]{$c[0]}{$c[1]}{$c[2]}{'.'};
$thisdepth = 2;
}
else
{
$thisdepth = -4;
}
}
if ( $thisdepth < 0 && defined($c[1]) && $depth <= 2 &&
defined($registered_commands[$$self]{$c[0]} ) &&
defined($registered_commands[$$self]{$c[0]}{$c[1]} )
)
{
# All handler
if ( defined($c[2]) &&
defined($registered_commands[$$self]{$c[0]}{$c[1]}{'ALL'})
)
{
$cmd =
$registered_commands[$$self]{$c[0]}{$c[1]}{'ALL'}{'.'};
$thisdepth = 2;
}
# Universal in this context
elsif ( defined($c[2]) &&
defined($registered_commands[$$self]{$c[0]}{'GROUP'} ) &&
defined($registered_commands[$$self]{$c[0]}{'GROUP'}{$c[2]} )
)
{
$cmd =
$registered_commands[$$self]{$c[0]}{'GROUP'}{$c[2]}{'.'};
$thisdepth = 2;
}
# $c[2] globally Universal
elsif ( defined($c[2]) &&
defined($registered_commands[$$self]{'UNIVERSAL'}{$c[2]} )
)
{
$cmd =
$registered_commands[$$self]{'UNIVERSAL'}{$c[2]}{'.'};
$thisdepth = 2;
}
elsif ( defined($registered_commands[$$self]{$c[0]}{$c[1]}{'.'} )
)
{
$cmd =
$registered_commands[$$self]{$c[0]}{$c[1]}{'.'};
$thisdepth = 1;
}
else
{
$thisdepth = -3;
}
}
if ( $thisdepth < 0 && defined($c[1]) && $depth <= 1 &&
defined($registered_commands[$$self]{$c[0]} )
)
{
# All handler
if (
defined( $registered_commands[$$self]{$c[0]}{'ALL'} )
)
{
$cmd =
$registered_commands[$$self]{$c[0]}{'ALL'}{'.'};
$thisdepth = 1;
}
# Universal context
elsif (
defined( $registered_commands[$$self]{'GROUP'}{$c[1]}
) )
{
$cmd =
$registered_commands[$$self]{'GROUP'}{$c[1]}{'.'};
$thisdepth = 1;
}
# $c[1] Globally Universal
elsif (
defined($registered_commands[$$self]{'UNIVERSAL'}{$c[1]} )
)
{
$cmd =
$registered_commands[$$self]{'UNIVERSAL'}{$c[1]}{'.'};
$thisdepth = 1;
}
else
{
$thisdepth = -2;
}
}
if ( $thisdepth < 0 && defined($c[0]) && $depth == 0 )
{
lib/Agent/TCLI/Control.pm view on Meta::CPAN
my $command = $request->command->[0];
my ($txt, $code);
$self->Verbose("net: command($command)");
if ( $command eq 'ip' )
{
if (defined($self->local_address))
{
$txt = $self->local_address;
$code = 200;
}
else
{
$txt = 'Local ip address is undefined.' ;
$code = 400;
}
}
$request->Respond( $kernel, $txt, $code );
return ();
} #end sub exit
=item help
A POE event to execute the help command. Takes a request object as an ARG0.
Responds with the properly formatted help output.
=cut
sub help {
my ($kernel, $self, $sender, $request,) =
@_[KERNEL, OBJECT, SENDER, ARG0,];
$self->Verbose("help: \t"." with context(".$self->print_context.")");
$self->Verbose("help: command(".$request->command->[0].") args[".
$request->print_args."] input(".$request->input.")", 3);
my $command = $request->command->[0];
my (@help, $cmd, $cmds, $context, $txt, $code);
# No specific request, print list of commands with usage.
if ( not defined($request->args->[0]) )
{
($cmds, $txt, $code) = $self->ListCommands();
if ( $code == 200 )
{
$txt = "The following commands are available in this context. \n";
foreach $cmd ( sort keys %{$cmds} )
{
$self->Verbose("help: cmd($cmd) ");
# Need to eliminate aliases by checking something.....
$txt .= "\t".$cmd." - ".$cmds->{$cmd}->help." \n"
if ($cmds->{$cmd}->name =~ /$cmd/ ||
$cmds->{$cmd}->topic !~ /general/
);
}
}
($cmds, , ) = $self->ListCommands(['UNIVERSAL']);
if ( $code == 200 )
{
$txt .= "\nThe following global commands are available. \n";
foreach $cmd ( sort keys %{$cmds} )
{
$txt .= " ".$cmd." " unless ($cmds->{$cmd}->topic =~ /debug|admin/);
}
}
# Otherwise txt has error from first ListCommands
$request->Respond($kernel, $txt, $code );
return;
}
# Just the globals please
elsif( $request->args->[0] =~ /global/i )
{
($cmds, $txt, $code ) = $self->ListCommands(['UNIVERSAL']);
if ( $code == 200 )
{
$txt .= "\nThe following global commands are available. \n";
foreach $cmd ( sort keys %{$cmds} )
{
$txt .= "\t".$cmd." - ".$cmds->{$cmd}->help." \n";
}
}
# Otherwise txt has error from first ListCommands
$request->Respond($kernel, $txt, $code );
return;
}
# perhaps we want to ignore the current context
elsif ( $request->args->[0] eq '/' )
{
@help = @{$request->args};
}
# finally, just help
elsif ( $request->depth_args >= 1 )
{
@help = ( @{$self->context}, @{$request->args} );
unshift(@help,'/') if ($help[0] ne '/');
}
($cmd, $context, $txt, $code) = $self->FindCommand(\@help);
# FindCommand eats @help (as args) and we need what it found in context
@help = reverse(@{$context});
my $on = join(' ',@help);
if (defined($cmd) && defined($cmd->help) )
{
$txt = "Help for command '".$on."' Use 'manual ".$on."' for more info.\n";
$txt .= "\tUsage: ".$cmd->usage."\n";
$txt .= $cmd->help."\n";
if (defined( $cmd->parameters ) )
{
$txt .= "Parameters \n";
foreach my $parameter ( sort keys %{$ cmd->parameters } )
{
$txt .= "\t".$cmd->parameters->{ $parameter }->name." - ";
$txt .= $cmd->parameters->{ $parameter }->help;
}
}
}
elsif (defined($cmd) )
{
$txt = "Darn! The lazy programmer didn't supply a manual or help!"
}
# Otherwise txt has error from FindCommand
$request->Respond($kernel, $txt, $code );
} #end sub help
=item manual
A POE event to execute the manual command. Takes a request object as an ARG0.
Responds with the properl formatted manual output.
=cut
sub manual {
my ($kernel, $self, $sender, $request,) =
lib/Agent/TCLI/Control.pm view on Meta::CPAN
A POE event handler to handle events gone astray. Only does something
when verbose is turned on.
=cut
sub _default {
my ($kernel, $self, ) =
@_[KERNEL, OBJECT, ];
my $oops = "\n\n\n".
"\t OOOO OOOO PPPPPP SSSSSS ## \n".
"\t OO OO OO OO PP PP SS ## \n".
"\tOO OO OO OO PP PP SS ## \n".
"\tOO OO OO OO PPPPPP SSSSSS ## \n".
"\tOO OO OO OO PP SS ## \n".
"\t OO OO OO OO PP SS \n".
"\t OOOO OOOO PP SSSSSS ## \n";
$self->Verbose($oops);
$self->Verbose("\n\nDefault caught an unhandled $_[ARG0] event.\n");
$self->Verbose("The $_[ARG0] event was given these parameters:");
$self->Verbose("ARG1 dumped",1,$_[ARG1]) if defined($_[ARG1]);
$self->Verbose("ARG2 dumped",1,$_[ARG2]) if defined($_[ARG2]);
return(0);
}
=item _default_commands
A private object method that has all the default commands.
The ones we just can't live without. Well, maybe not all the ones we can't
live without, but all the ones that have actually be written so far.
=cut
sub _default_commands :Private {
my $self = shift;
my $dc = {
'echo' => Agent::TCLI::Command->new(
'name' => 'echo',
'help' => 'Return what was said.',
'usage' => 'echo <something> or /echo ...',
'topic' => 'general',
'command' => 'pre-loaded',
'contexts' => {'UNIVERSAL' => 'echo'},
'call_style'=> 'state',
'handler' => 'general'
),
'Hi' => Agent::TCLI::Command->new(
'name' => 'Hi',
'help' => 'Greetings',
'usage' => 'Hi/Hello',
'topic' => 'general',
'command' => 'pre-loaded',
'contexts' => {'ROOT' => [ qw(Hi hi Hello hello)]},
'call_style'=> 'state',
'handler' => 'general'
),
'context' => Agent::TCLI::Command->new(
'name' => 'context',
'help' => "displays the current context",
'usage' => 'context or /context',
'manual' => "Context can be somewhat difficult to understand when one thinks of normal command line interfaces that often retain context differently. ".
"Context is a way of nesting commands, much like a file directory, to make it easier to navigate. There are a few commands, such as 'help' or 'exit' that are global, ".
"but most commands are available only within specific contexts. Well written packages will collect groups of similar commands within a context. ".
"For instance, if one had package of attack commands, one would put them all in an 'attack' context. Instead of typing 'attack one target=example.com', ".
"one could type 'attack' to change to the attack context then type 'one target=example.com' followed by 'two target=example.com' etc. \n\n".
"Furthermore, a well written package will support the setting of default parameters for use within a context. One can then say: \n ".
"\tattack \n\tset target=example.com \n\tone \n\ttwo \n\t...\n\n".
"The full command 'attack one target=example.com' must always be supported, but using context makes it easier to do repetitive tasks manually as well as ".
"allow one to navigate through a command syntax that one's forgotten the details of without too much trouble. \n\n".
"Context has a sense of depth, as in how many commands one has in front of whatever one is currently typing. ".
"An alias to the context command is 'pwd' which stands for Present Working Depth. ".
"Though it may make the Unix geeks happy, they should remember that this is not a file directory structure that one is navigating within.",
'topic' => 'general',
'command' => 'pre-loaded',
'contexts' => {'UNIVERSAL' => [ qw( context pwd ) ]},
'call_style'=> 'state',
'handler' => 'general'
),
'Verbose' => Agent::TCLI::Command->new(
'name' => 'Verbose',
'help' => "changes the verbosity of output to logs",
'usage' => 'Verbose',
'topic' => 'admin',
'command' => 'pre-loaded',
'contexts' => {'UNIVERSAL' => 'Verbose'},
'call_style'=> 'state',
'handler' => 'general'
),
'debug_request' => Agent::TCLI::Command->new(
'name' => 'debug_request',
'help' => 'show what the request object contains',
'usage' => 'debug_request <some other args>',
'topic' => 'admin',
'command' => 'pre-loaded',
'contexts' => {'UNIVERSAL' => 'debug_request'},
'call_style'=> 'state',
'handler' => 'general'
),
'help' => Agent::TCLI::Command->new(
'name' => 'help',
'help' => 'Display help about available commands',
'usage' => 'help [ command ] or /help',
'manual' => 'The help command provides summary information about running a command and the parameters the command accepts. Help with no arguments will list the currently available commands. Help is currently broken in that it only operates wi...
'topic' => 'general',
'command' => 'pre-loaded',
'contexts' => {'UNIVERSAL' => 'help'},
'call_style'=> 'state',
'handler' => 'help'
),
'manual' => Agent::TCLI::Command->new(
'name' => 'manual',
'help' => 'Display detailed help about a command',
'usage' => 'manual [ command ]',
'manual' => 'The manual command provides detailed information about running a command and the parameters the command accepts. Manual is currently broken in that it only operates within the existing context and cannot be called with a full con...
'topic' => 'general',
'command' => 'pre-loaded',
'contexts' => {'UNIVERSAL' => ['manual', 'man'] },
'call_style'=> 'state',
'handler' => 'manual'
),
'status' => Agent::TCLI::Command->new(
'name' => 'status',
( run in 0.588 second using v1.01-cache-2.11-cpan-437f7b0c052 )