Agent-TCLI
view release on metacpan or search on metacpan
lib/Agent/TCLI/Control.pm view on Meta::CPAN
Authorization for the user for this control. Must be separate from the
auth in the user object since that might not be the only factor at all times.
=cut
my @auth :Field
:All('auth');
=item type
Type of conversation. MUST be one of these values:
B<instant> => one time (or not specified)
B<chat> => peer to peer chat
B<group> => group chatroom
=cut
my @type :Field( 'All' => 'type' );
=item context
Contains the context of the current Command application for the control.
=cut
my @context :Field
:Type('Array')
:Arg('Name' => 'context', 'Default' => ['ROOT'] )
:Acc('context');
=item owner
Contains the owning session of the control. This allows the control to be
passed around between sessions and whatever session that has it can
send back to the top level originating session.
=cut
my @owner :Field( 'All' => 'owner' );
=item prompt
The promt that the control is displaying, when appropriate.
=cut
my @prompt :Field :All('prompt');
=item local_address
The local IP address of the system
=cut
my @local_address :Field
:All('local_address');
=item hostname
The hostname being used by the control.
=cut
my @hostname :Field
:All('hostname');
=item poe_debug
A flag to set whether to enable poe debugging if installed
=cut
my @poe_debug :Field
:All('poe_debug');
# Holds our session data. Made weak per Merlyn
# http://poe.perl.org/?POE_Cookbook/Object_Methods.
# We also don't take session on init.
#my @session :Field
# :Get('session')
# :Weak;
# Standard class utils are inherited
=back
=head2 METHODS
=over
=cut
sub _preinit :Preinit {
my ($self,$args) = @_;
$args->{'session'} = POE::Session->create(
object_states => [
$self => [qw(
_start
_stop
_shutdown
_default
ControlAddState
control_presence
AsYouWished
ChangeContext
Execute
dumpcmd
establish_context
exit
general
help
manual
net
show
settings
)],
],
'heap' => $self,
);
}
sub _init :Init {
my $self = shift;
# Validate arguments
# $self->Verbose( "spawn: Validating arguments \n" );
# my %args = validate( @_, {
# local_address => { optional => 1 },
# local_port => { optional => 1, default => 42 },
# hostname => { optional => 1, default => hostname() },
# poe_debug => { optional => 1, default => 1 },
# # if not available, silenty fails to load debug
# }
# );
$self->LoadXMLFile();
# Register default commands
$self->Verbose( "init: Registering default commands \n".$self->dump(1),3 );
foreach my $cmd ( values %{ $self->commands } )
{
$self->RegisterCommand($cmd);
}
# if available, register requested command packages
$self->Verbose( "init: Registering user packages \n" );
if ( defined($packages[$$self] ) )
{
my $txt;
foreach my $package (@{ $packages[$$self] })
{
my $txt = $self->RegisterPackage($package);
croak ($txt) if ($txt); # Load fail on start MUST die.
}
} # end if packages
# Register user commands, if requested #{{{
# $self->Verbose( "init: Registering user commands \n" );
#
# if( ref( $commands[$$self] ) =~ /ARRAY/i ) {
#
# foreach my $cmd (@{ $commands[$$self] }) {
# if ( ref($cmd) eq 'HASH') {
# $self->register($cmd);
# } elsif ( ref($cmd) =~ /Agent::TCLI::Command/ ) {
# $self->register_command($cmd);
# } else {
# $self->Verbose("init: Parameter 'commands' contains bad element");
# $self->Verbose("init: Dump of commands ", 4, $commands[$$self]);
# }
# } #end foreach
#
# } else {
#
# $self->Verbose("init: User commands not an array ref, not loaded");
# $self->Verbose("init: Dump of commands ", 4, $commands[$$self]);
#
# } #end if commands
if ( defined( $hostname[$$self] ) )
{
$self->set(\@prompt, $id[$$self]." [".$hostname[$$self]."]: ");
}
}
=item Register
Register is an internal object method used to register commands with the Control.
=cut
lib/Agent/TCLI/Control.pm view on Meta::CPAN
A POE event to handle some general commands such as context and status.
It expects a request object parameter.
=cut
sub general {
my ($kernel, $self, $sender, $request,) =
@_[KERNEL, OBJECT, SENDER, ARG0,];
$self->Verbose("general: context(".$self->print_context.")");
my $command = $request->command->[0];
$self->Verbose("general: command(".$command.") args[".
$request->print_args."] input(".$request->input.")", 3);
my $txt;
my $time = localtime($start_time[$$self]);
if ( $command eq 'context')
{
$txt = "Context: ".$self->print_context;
}
elsif ( $command eq 'echo' )
{
$txt = "I heard '".$request->input."' in context ".
$self->print_context." from ".$user[$$self]->get_name();
}
elsif ($command =~ /hi|hello/i)
{
$txt = $command." ".$user[$$self]->get_name().". Tell me what you'd like to do or ask for 'help'. ";
}
elsif ($command eq 'status')
{
$txt .= "This is a ".__PACKAGE__." v".$VERSION."\n";
$txt .= "running inside ".$0.".\n"; # with procecss id ".getppid()."\n";
$txt .= "My IP address is ".$self->local_address.".\n" if defined($self->local_address);
$txt .= "This console was spawned at ".$time.".\n";
foreach my $cmdpkg ( @{ $packages[$$self] } )
{
my $subtxt = "$cmdpkg";
$subtxt =~ s/=.*//;
$txt .= "\tPackage ".$subtxt." is loaded. \n";
}
$txt .= "You are ".$user[$$self]->get_name()." and you have "
.$self->auth()." authorization \n ";
$txt .= "\n";
}
elsif ( $command eq 'Verbose' )
{
if ( $request->args->[0])
{
$self->verbose( $request->args->[0] );
$txt = "Verbose now ".$self->verbose." in context ".
$self->print_context;
}
else
{
$txt = "Verbose: ".$self->verbose;
}
}
elsif ( $command eq 'debug_request' )
{
$txt = "Request dump: ".$request->dump(1);
}
else
{
$txt = "Uh oh, this was not supposed to happen. $command got lost."
}
$self->Verbose("general: txt($txt)",3);
$request->Respond($kernel, $txt);
} #end sub general
=item net
A POE event to execute the net commands. Takes a request object as an ARG0.
The only command it handles currently is I<ip>. This will respond with the
local_address if defined.
=cut
sub net {
my ($kernel, $self, $request, ) =
@_[KERNEL, OBJECT, ARG0, ];
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
lib/Agent/TCLI/Control.pm view on Meta::CPAN
# elsif (defined($cmd) && defined($cmd->help ) )
# {
# $txt = "No manual defined. Here is help for command '".$on."' \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 manual
=item exit
A POE event to handle context shift commands exit and /.
It expects a request object parameter.
=cut
sub exit {
my ($kernel, $self, $request, ) =
@_[KERNEL, OBJECT, ARG0, ];
# $self->Verbose("exit: command($args->[0]) args[".scalar($args)
# ."] input($input)", 4);
my $command = $request->command->[0];
$self->Verbose("exit: command($command)");
my $context;
# we're set up to handle '/' as well as exit and '..'
if ($command eq '/' || $command eq 'root' )
{
$context = '/';
}
else
{
# Used to do a lot more here, but pushed it off to change context.
$context = '..';
}
# $request->Respond( $kernel, "exiting: context now ".$context, 200 );
$kernel->yield( 'ChangeContext', $request, $context );
return ();
} #end sub exit
=item dumpcmd
A POE event to handle some debugging in band.
It expects a request object parameter.
=cut
sub dumpcmd {
my ($kernel, $self, $request) =
@_[KERNEL, OBJECT, ARG0];
my $command = $request->command->[0];
my $txt;
# dump them all if no args
if ( $request->ArgsDepth == 0 )
{
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
lib/Agent/TCLI/Control.pm view on Meta::CPAN
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',
'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',
( run in 0.897 second using v1.01-cache-2.11-cpan-39bf76dae61 )