Agent-TCLI
view release on metacpan or search on metacpan
lib/Agent/TCLI/Control.pm view on Meta::CPAN
$self->Verbose( "RegisterContext:2a: Adding command "
.$v2c." in context ".$c1."->".$c2." ");
$registered_commands[$$self]{ $c1 }{ $c2 }{ $v2c }{'.'} = $cmd;
}
}
elsif ( $c2 eq '.' )
{
$self->Verbose( "RegisterContext:2.: Adding command "
.$v2." in context ".$c1."->");
$registered_commands[$$self]{ $c1 }{ $v2 }{'.'} = $cmd;
}
else
{
$self->Verbose( "RegisterContext:2: Adding command "
.$v2.
" in context ".$c1."->".$c2." ");
$registered_commands[$$self]{ $c1 }{ $c2 }{ $v2 }{'.'} = $cmd;
}
}
}
elsif ( ( ref( $v1 ) =~ /ARRAY/ ) )
{
foreach my $v1c ( @{$v1})
{
$self->Verbose( "RegisterContext:1a: Adding command "
.$v1c." in context ".$c1." ");
$registered_commands[$$self]{ $c1 }{ $v1c }{'.'} = $cmd;
}
}
else
{
$self->Verbose( "RegisterContext:1: Adding command "
.$v1." in context ".$c1." ");
$registered_commands[$$self]{ $c1 }{ $v1 }{'.'} = $cmd;
}
}
return 1;
}
=item FindCommand
FindCommand is an internal object method used to parse the command line
arguments and determine the appropriate command handler.
=cut
sub FindCommand {
my ($self, $args ) = @_;
$self->Verbose("FindCommand: Got args for ".$id[$$self]." in context ".
$self->print_context." \n",2,$args);
my (@c, $cmd, $txt, $code, $thisdepth);
my $depth; # How deep are we in already. Don't want to be searching
# deeper than we should.
# regex matches on /non-whitespace followed by none or more whitespace
if ( $args->[0] =~ /^\/(\S+)\s*/ )
{
# Special command option to backout context
# We won't process whole context trees (../cmd) but we should
# allow a root context to get out of poorly coded commands or whatnot
# as a one time option. Hey Cisco, can you do that?
$args->[0] = $1;
$self->Verbose( "FindCommand: Root context called, now using ".
$args->[0]." from root\n" );
push ( @c, @{$args} );
$depth = 0;
}
elsif ( $args->[0] eq '/' && scalar( @{$args} ) > 1 )
{
# 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;
}
lib/Agent/TCLI/Control.pm view on Meta::CPAN
foreach my $cmd ( keys %{ $registered_commands[$$self] } )
{
$txt .= $registered_commands[$$self]{$cmd}->dump(1);
}
}
elsif ( $request->ArgsDepth > 0 )
{
foreach my $cmd ( @{$request->args} )
{
$txt .= $registered_commands[$$self]{$cmd}->dump(1);
}
}
$request->Respond( $kernel, $txt );
} #end sub dumpcmd
#sub listcmd {
# my ($kernel, $self, $request) =
# @_[KERNEL, OBJECT, ARG0];
#
# my $command = $request->command->[0];
#
# my $txt;
# # TODO this is broken with new commands hash.
# if ( $request->depth_args == 0
# { # dump them all
# foreach my $context ( $registered_commands[$$self] )
# {
# $txt .= "\nCommands in context ".$context." \n\t";
# foreach my $command ( %{ $registered_commands[$$self]{ $context } } )
# {
# $txt .= $registered_commands[$$self]{ $context }{ $command }{'name'}.", ";
# } #end foreach command
# } #end foreach context
# }
# else
# {
# # just dump some in a context
#
# # tHIS SHOULD GRAB AN ARRAY
# my $context = $request->depth_args > 0 ? $request->args->[0] : $thread[$$self]->context;
#
# # if/eslif on size of array.
# # loop over hash1.hash2.hash3.keys getting '.'{'name'}
# # loop over wildcards too
#
# foreach my $cmd ( %{ $registered_commands[$$self]{ $context } } )
# {
# $txt .= $registered_commands[$$self]{ $context }{ $cmd }{'name'}.", ";
# }
# }
# $txt =~ s/,\s$//;
# $request->Respond( $kernel, $txt );
#} #end sub listcmd
#=item establish_context
#
#This POE event handler is the primary way to set context with a command.
#Just about any command that has subcommands will use this method as it's handler.
#An exception would be a command that sets an single handler to process all
#subcoammnds/args using the 'A*' context. See the Eliza package for an example of
#how to establish that type of context.
#
#=cut
#
#sub establish_context {
# my ($kernel, $self, $sender, $request, ) =
# @_[KERNEL, OBJECT, SENDER, ARG0, ];
# $self->Verbose("establish_context: ".$self->name." for request(".
# $request->id().")");
#
# my $txt;
# # if we have args, then the command is invalid
# if ( $request->depth_args > 0 )
# {
# $txt .= "Invalid input: ".$request->input;
# $self->Verbose("establish_context: Invalid input (".$request->input.")" );
# $request->Respond($kernel, $txt, 404) if $txt;
# return;
# }
#
# # we don't know how deep we're in already. So we'll force a full context shift.
# # by sending the entire command array back, which is revesred.
# my @context = reverse (@{$request->command});
#
# # We don't actualy set the controls context, but let change context do that.
# # It will also inform the user of change.
#
# # Post context back to sender (Control)
# $kernel->call( $sender => 'ChangeContext' => $request, \@context );
# $self->Verbose("establish_context: setting context to "
# .join(' ',@context)." ",2);
#
#}
#
#=item show
#
#This POE event handler i will accept an argument for the setting to show.
#It will also take an argument of all or * and show all settings.
#
#The parameter must be defined in the command entry's parameters or it will
#not be shown. There must also be a OIO Field defined with the same name.
#One may write their own show method if this is not sufficient.
#
#=cut
#
#sub show {
# my ($kernel, $self, $sender, $request, ) =
# @_[KERNEL, OBJECT, SENDER, ARG0, ];
# $self->Verbose("show: request(".$request->id.") ",2);
#
# my ($txt, $code, $what, $var);
# # calling with show as a command, that is the handler for show is show.
# if ( $request->command->[0] eq 'show' ) # cmd1 show arg
# # cmd1 attacks show <arg>
# {
# $what = $request->args->[0];
# }
#
# $self->Verbose("show: what(".$what.") request->args",1,$request->args);
lib/Agent/TCLI/Control.pm view on Meta::CPAN
),
'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',
'help' => 'Display general TCLI control status',
'usage' => 'status or /status',
'topic' => 'general',
'command' => 'pre-loaded',
'contexts' => {'UNIVERSAL' => 'status'},
'call_style'=> 'state',
'handler' => 'general'
),
'/' => Agent::TCLI::Command->new(
'name' => 'root',
'help' => "exit to root context, use '/command' for a one time switch",
'usage' => 'root or / ',
'manual' => "root, or '/' for the Unix geeks, will change the context back to root. See 'manual context' for more information on context. ".
"Unless otherwise noted, changing to root context does not normally clear out any default settings that were established in that context. \n\n".
"One can preceed a command directly with a '/' such as '/exit' to force the root context. ".
"Sometimes a context may independently process everything said within the context and, if misbehaving, doesn't provide a way to leave the context. ".
"Using '/exit' or '/help' should always work. The example package Eliza is known to have trouble saying Goodbye and exiting properly.",
'topic' => 'general',
'command' => 'pre-loaded',
'contexts' => { 'UNIVERSAL' => ['/','root'] },
'call_style'=> 'state',
'handler' => 'exit',
),
# {
# 'name' => 'load',
# 'help' => 'Load a new control package',
# 'usage' => 'load < PACKAGE >',
# 'topic' => 'admin',
# 'command' => sub {return ("load is currently diabled")}, #\&load,
# 'call_style'=> 'sub',
# },
# {
# 'name' => 'listcmd',
# 'help' => 'Dump the registered commands in their contexts',
# 'usage' => 'listcmd (<context>)',
# 'topic' => 'admin',
# 'command' => 'pre-loaded',
# 'contexts' => {'UNIVERSAL'},
# 'call_style' => 'state',
# 'handler' => 'listcmd',
# },
'dumpcmd' => Agent::TCLI::Command->new(
'name' => 'dumpcmd',
'help' => 'Dump the registered command hash information',
'usage' => 'dumpcmd <cmd>',
'topic' => 'admin',
'command' => 'pre-loaded',
'contexts' => {'UNIVERSAL' => 'dumpcmd'},
'call_style'=> 'state',
'handler' => 'dumpcmd',
),
'nothing' => Agent::TCLI::Command->new(
'name' => 'nothing',
'help' => 'Nothing is as it seems',
'usage' => 'nothing',
'topic' => 'general',
'contexts' => {'ROOT' => 'nothing'},
'command' => sub { return ("You said nothing, try help") },
'call_style'=> 'sub',
),
'exit' => Agent::TCLI::Command->new(
'name' => 'exit',
'help' => "exit the current context, returning to previous context",
'usage' => 'exit or /exit',
'manual' => "exit, or '..' for the Unix geeks, will change the context back one level. See 'manual context' for more information on context. ".
"Unless otherwise noted, leaving a context does not normally clear out any default settings that were established in that context. \n\n",
'topic' => 'general',
'command' => 'pre-loaded',
'contexts' => {'UNIVERSAL' => [ qw(exit ..)] },
'call_style'=> 'state',
'handler' => 'exit',
),
'ip' => Agent::TCLI::Command->new(
'name' => 'ip',
'help' => 'Returns the local ip address',
'usage' => 'ip',
( run in 0.602 second using v1.01-cache-2.11-cpan-39bf76dae61 )