Agent-TCLI
view release on metacpan or search on metacpan
bin/agent_tail.pl view on Meta::CPAN
=head1 LICENSE
Copyright (c) 2007, Alcatel Lucent, All rights resevred.
This script is free software; you may redistribute it
and/or modify it under the same terms as Perl itself.
=cut
# Useful for debugging or just seeing what the Agent is doing.
sub VERBOSE () { 0 }
# Process optional parameters from the command line and assign defaults.
use Getopt::Lucid qw(:all);
my ($opt, $verbose,$domain,$username,$password,$resource,$host);
eval {$opt = Getopt::Lucid->getopt([
Param("domain|d"),
Param("username|u"),
bin/agent_tail.pl view on Meta::CPAN
use Agent::TCLI::Transport::XMPP; # A TCLI transport
use Net::XMPP::JID; # Required for XMPP transport
# Optional Packages, without some, a bot is useless
use Agent::TCLI::Package::XMPP; # Not required, but very useful to manage Transport::XMPP
# especially if you want a graceful shutdown. :)
use Agent::TCLI::Package::Tail;
# An alias is mostly useful when debugging, and must be unique within
# active POE::Sessions
my $alias = 'agent.tail';
# Create new package objects to load for each package.
# Some packages may require extra parameters.
my @packages = (
Agent::TCLI::Package::XMPP->new(
'verbose' => \$verbose , # Optionally set verbosity for the package
# by using a reference, we can later
lib/Agent/TCLI/Base.pm view on Meta::CPAN
}
=back
=head2 METHODS
=over
=item Verbose (<message>, [ <level>, <dump_var> ] )
This method is use to output all logging and debugging commands. It will use
the sub in do_verbose to output the message if the level is less than or
equal to the current value of $self->verbose. If level is not suppiled,
it defaults to one.
If a dump_var is included, its value will be output using the Data::Dump::pp
function. This can pe useful for checking the inside of array, hashes
and objects. If the object is an OIO object, use the objects own $obj->dump(1)
method in the message.
=cut
lib/Agent/TCLI/Control.pm view on Meta::CPAN
: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
lib/Agent/TCLI/Control.pm view on Meta::CPAN
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 } )
{
lib/Agent/TCLI/Control.pm view on Meta::CPAN
{
$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);
lib/Agent/TCLI/Control.pm view on Meta::CPAN
$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']);
lib/Agent/TCLI/Control.pm view on Meta::CPAN
# 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];
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',
lib/Agent/TCLI/Package/Base.pm view on Meta::CPAN
)],
],
)
unless defined( $args->{'session'} );
}
# This POE event handler is called when POE starts up a Package.
# The B<_start> method is :Cumulative within OIO. Ideally, most command packages
# could use this Base _start method without implementing
# their own. However there seems to be a race condition between the POE
# initialization and the OIO object initialization. Until this is debugged
# one will probably have to have this _start method in every package.
sub _start :Cumulative {
my ($kernel, $self, $session) =
@_[KERNEL, OBJECT, SESSION];
# are we up before OIO has finished initializing object?
if (!defined( $self->name ))
{
$self->Verbose("_start: OIO not done re-starting");
lib/Agent/TCLI/Package/Base.pm view on Meta::CPAN
if ( defined( $commands[$$self]{ $name }->parameters ) )
{
foreach my $paramkey ( keys %{ $commands[$$self]{ $name }->parameters } )
{
if ( exists( $parameters[$$self]->{ $paramkey } ) &&
blessed($parameters[$$self]->{ $paramkey }) =~ qr(Parameter) )
{
$commands[$$self]{ $name }->parameters->{ $paramkey } =
$parameters[$$self]->{ $paramkey };
}
else # All this is just for helping to debug problems easier
{
$self->Verbose("AssCommand: $name Parameter '$paramkey' not defined. Dumping",0 );
foreach my $parameter ( %{$parameters[$$self]} )
{
if ( blessed($parameter) )
{
$self->Verbose( $parameter->dump(1),0 );
}
else
{
lib/Agent/TCLI/Package/Tail.pm view on Meta::CPAN
---
Agent::TCLI::Parameter:
name: feedback
help: Sets the feedback level for what is seen.
manual: >
Feedback sets the level of additional information about the line that is
returned. Currently it is either zero, which is nothing,
or one, which returns the whole line. Feedback occurs when a line is
matched or if a test is set for verbose. Feedback is set per test, so
if multiple tests are active and verbose is one, there is the possibility
of seeing the same line more than once. This is useful for debugging
a particular test/watch.
type: Switch
---
Agent::TCLI::Parameter:
name: test_verbose
aliases: verbose|v
help: Sets the verbosity level for a test.
manual: >
Verbose sets the level of additional information about the test that is
returned. Currently it is either zero, which is nothing,
lib/Agent/TCLI/Package/UnixBase.pm view on Meta::CPAN
from a Package's _start routine or the contents may be copied for further
modification.
=cut
sub RunWheelStart {
my $self = shift;
$self->child( POE::Component::Child->new(
alias => $self->name,
# debug => $self->verbose,
));
# $self->child->{'StdioFilter'} = POE::Filter::Stream->new;
}
=item stdout
This POE event handler is the default way stdout lines are returned from
the child command being run.
lib/Agent/TCLI/Package/XMPP.pm view on Meta::CPAN
my $self = shift;
$self->Verbose("init: loading parameters and commands" );
$self->LoadYaml(<<'...');
---
Agent::TCLI::Parameter:
name: peers
help: list the peers
manual: >
This debugging parameter can be used to list the peers currently
loaded in a transport.
type: Switch
---
Agent::TCLI::Parameter:
name: controls
help: list the controls
manual: >
This debugging parameter can be used to list the controls currently
loaded in a transport.
type: Switch
---
Agent::TCLI::Parameter:
name: xmpp_verbose
aliases: verbose|v
constraints:
- UINT
help: an integer for verbosity
manual: >
This debugging parameter can be used to adjust the verbose setting
for the XMPP transport.
type: Counter
---
Agent::TCLI::Parameter:
name: group_mode
constraints:
- ASCII
help: sets how the control processes group chats
manual: |
The group_mode tells the control how to determine if a group chat
lib/Agent/TCLI/Parameter.pm view on Meta::CPAN
sub _init :Init{
$self->LoadYaml(<<'...');
---
Agent::TCLI::Parameter:
name: test_verbose
constraints:
- UINT
help: an integer for verbosity
manual: >
This debugging parameter can be used to adjust the verbose setting
for the test transport.
type: counter
...
}
=head1 DESCRIPTION
Parameters are the arguements supplied with a command. TCLI defines them as
objects to make it easier to provide several necessary interface features
in a consistent manner. One can use the new function to create Parameters
lib/Agent/TCLI/Request.pm view on Meta::CPAN
$response = $txt;
}
else
{
$response = $self->MakeResponse( $txt, $code);
}
# If we have a control, then we really need to post to it's id.
# I could stringify control to avoid this, but that seems rather inobvious
# and I'd probably create some bug somewhere else that would be horrific
# to debug because of it.
# TODO. Can't do multple replies like this.
my $sender = $self->sender->[0];
my $postback = $self->postback->[0];
if ( ref($sender) =~ /Control/ )
{
$self->Verbose("Respond: control(".$sender->id.") pb(".$postback.
") txt($txt)",2);
$sender = $sender->id()
}
lib/Agent/TCLI/Transport/Base.pm view on Meta::CPAN
);
=cut
sub authorized {
my ($self, $id, $auth, $protocol) = @_;
$auth = defined($auth) ? $auth : qr(.*);
$protocol = defined($protocol) ? $protocol : qr(.*);
$self->Verbose("authorized: id(".$id.") auth($auth) protocol($protocol)",2);
# create a blank user as kludge to simply debugging output.
# This might be a slow memory exhaustion for lots of auth checks
# if they are not getting cleand up properly
my $authorized = Agent::TCLI::User->new(
'id' => 'no one',
'protocol' => 'none',
'auth' => 'nil',
);
# only one should match on id and we get 0 on non id match,
# so we'll just add through the whole loop of authorized peers
lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN
}
# $kernel->alias_remove( $self->alias );
return ('_shutdown '.$self->alias )
}
sub _start {
my ($kernel, $session, $self) = @_[KERNEL, SESSION, OBJECT];
# Trying to run this as cumulative is not working. Not sure why.
# Just being inefficient instead of debugging.
# are we up before OIO has finished initializing object?
if (!defined( $self->alias ))
{
$self->Verbose($session->ID.":_start: OIO not started delaying ");
$kernel->yield('_start');
return;
}
$kernel->alias_set($self->alias);
lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN
# So there is a 30 seconds delay from the sending of the last test
# before we stop by default.
$timeout_id[$$self] = $kernel->delay_set( 'Timeout', 5, 5 );
# well, tha above would be true if the kernel was running gung ho. But we're
# calling timeslices willy nilly until all requests are queued, so it turns out
# that Timeout gets called in every timeslice regardless of delay, but
# this is good because it is the one queud event that keeps everything
# from stopping.
# When debugging POE Event streams, this might help.
return('_start'.$self->alias);
}
=item _stop
This POE event handler is called when POE stops a Transport.
=cut
sub _stop {
lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN
$self->alias." test queue empty" );
$self->done(0,"Run finished, all tests completed");
# Sometime timeout is sneaking itself back onto stack during shutdown.
$self->Verbose($self->alias.":_stop: removing alarms",1,$kernel->alarm_remove_all() );
# TODO maybe hold on on all response count tests until done for overages?
# When debugging POE Event streams, this might help.
return('_stop '.$self->alias);
}
1;
#__END__
=back
=head1 AUTHOR
lib/Agent/TCLI/Transport/XMPP.pm view on Meta::CPAN
my @jserver :Field('All' => 'jserver' );
=item jpassword
The password for the transport to use to log in to the server.
B<jpassword> will only accept scalar type values.
=cut
my @jpassword :Field('All' => 'jpassword');
=item xmpp_debug
Sets the debug (verbosity) level for the XMPP libraries
=cut
my @xmpp_debug :Field :All('xmpp_debug');
=item xmpp_process_time
Sets the time in seconds to wait before calling XMPP Process to look for
more XMPP data. Defaults to 1 and shouldn't be much larger.
=cut
my @xmpp_process_time :Field
:Arg('name'=>'xmpp_process_time', 'default'=> 1 )
:Acc('xmpp_process_time');
lib/Agent/TCLI/Transport/XMPP.pm view on Meta::CPAN
$kernel->yield('_start');
return;
}
$self->Verbose("_start: ".$self->alias." Starting up");
# OK, now we can start up POE stuff.
$kernel->alias_set($self->alias);
my $xmpp = Net::Jabber::Client->new(
'debuglevel' => $xmpp_debug[$$self],
'debugfile' => 'stdout',
);
# Add a namespace for IQ nodes to embed YAML output
$xmpp->AddNamespace(
ns => "tcli:request",
tag => "tcli",
xpath => {
'Version' => { 'path' => 'version/text()' },
'Yaml' => { 'path' => 'yaml/text()' },
'Request' => { 'type' => 'master'},
lib/auto/Agent/TCLI/Control/config.xml view on Meta::CPAN
<contexts UNIVERSAL="status" />
</Command>
<Command name="exit" call_style="state" command="pre-loaded" handler="exit" help="exit the current context, returning to previous context" manual="exit, or '..' for the Unix geeks, will change the context back one level. See 'manual context' for more...
" topic="general" usage="exit or /exit">
<contexts>
<UNIVERSAL>exit</UNIVERSAL>
<UNIVERSAL>..</UNIVERSAL>
</contexts>
</Command>
<Command name="debug_request" call_style="state" command="pre-loaded" handler="general" help="show what the request object contains" topic="admin" usage="debug_request <some other args>">
<contexts UNIVERSAL="debug_request" />
</Command>
<Command name="Hi" call_style="state" command="pre-loaded" handler="general" help="Greetings" topic="general" usage="Hi/Hello">
<contexts>
<ROOT>Hi</ROOT>
<ROOT>hi</ROOT>
<ROOT>Hello</ROOT>
<ROOT>hello</ROOT>
</contexts>
</Command>
<Command name="Verbose" call_style="state" command="pre-loaded" handler="general" help="changes the verbosity of output to logs" topic="admin" usage="Verbose">
t/TCLI.Command.BuildCommandLine.t view on Meta::CPAN
show_method => 'print',
cl_option => '-i'
);
my $verbose = Agent::TCLI::Parameter->new(
name => 'test_verbose',
aliases => 'verbose|v',
constraints => ['UINT'],
help => "an integer for verbosity",
manual =>
'This debugging parameter can be used to adjust the verbose setting',
type => 'Counter',
cl_option => '-v',
);
my $switch = Agent::TCLI::Parameter->new(
name => 'switch',
help => "a switch for a parameter",
manual =>
'This parameter is used for testing the module.',
type => 'Switch',
t/TCLI.Command.GetoptLucid.t view on Meta::CPAN
'command' => ['testing', ],
'sender' => 'Control',
'postback' => 'TestResponse',
'input' => 'testing paramint 7 verbose',
});
my $verbose = Agent::TCLI::Parameter->new(
constraints => ['UINT'],
help => "an integer for verbosity",
manual => 'This debugging parameter can be used to adjust the verbose setting for the XMPP transport.',
name => 'test_verbose',
aliases => 'verbose|v',
type => 'Counter',
);
my $paramint = Agent::TCLI::Parameter->new(
constraints => ['UINT'],
help => "an integer for a parameter",
manual => 'This parameter is used to to test the Command package.',
name => 'paramint',
t/TCLI.Control.Interactive.t view on Meta::CPAN
# TASK Test suite is not complete. Need more testing for catching errors.
use Getopt::Lucid qw(:all);
sub VERBOSE () { 0 }
my ($opt, $verbose, $poe_td, $poe_te);
eval {$opt = Getopt::Lucid->getopt([
Counter("poe_debug|d"),
Counter("poe_event|e"),
Counter("verbose|v"),
Switch("blib|b"),
])};
if($@) {die "ERROR: $@";}
if ($opt->get_blib)
{
use lib 'blib/lib';
}
$verbose = $opt->get_verbose ? $opt->get_verbose : VERBOSE;
# xmpp username/password to log in with
$poe_td = $opt->get_poe_debug;
$poe_te = $opt->get_poe_event;
sub POE::Kernel::TRACE_DEFAULT () { $poe_td }
sub POE::Kernel::TRACE_EVENTS () { $poe_te }
use Agent::TCLI::Transport::Test;
use Agent::TCLI::Testee;
use POE;
BEGIN {
t/TCLI.Control.Interactive.t view on Meta::CPAN
# are we in the right place?
$t->like_body('show name',qr(base));
#$verbose = 0;
# general tests
$t->ok('status');
$t->ok('hi');
$t->like_body('echo this',qr(this) );
$t->like_body('echo that is not this',qr(that is not this) );
$t->is_body( 'context','Context: ROOT','verify root context');
$t->ok('debug_request');
$t->ok('exit');
$t->ok('root');
$t->ok('Verbose');
#help tests
$t->is_code( 'help',200, 'help');
$t->is_code( '/',200, 'root context');
$t->is_body( 'context','Context: ROOT','verify root context');
$t->is_code( 'test1',200, 'test1 context');
$t->is_body( 'context','Context: test1','verify test1 context');
t/TCLI.Control.t view on Meta::CPAN
# TASK Test suite is not complete. Need more testing for catching errors.
use Getopt::Lucid qw(:all);
sub VERBOSE () { 0 }
my ($opt, $verbose, $poe_td, $poe_te);
eval {$opt = Getopt::Lucid->getopt([
Counter("poe_debug|d"),
Counter("poe_event|e"),
Counter("verbose|v"),
Switch("blib|b"),
])};
if($@) {die "ERROR: $@";}
if ($opt->get_blib)
{
use lib 'blib/lib';
}
$verbose = $opt->get_verbose ? $opt->get_verbose : VERBOSE;
# xmpp username/password to log in with
$poe_td = $opt->get_poe_debug;
$poe_te = $opt->get_poe_event;
sub POE::Kernel::TRACE_DEFAULT () { $poe_td }
sub POE::Kernel::TRACE_EVENTS () { $poe_te }
use Agent::TCLI::Transport::Test;
use Agent::TCLI::Testee;
use POE;
BEGIN {
t/TCLI.Package.XMPP.t view on Meta::CPAN
sub VERBOSE () { 0 }
my ($opt, $verbose,$domain,$username,$password,$host, $poe_td, $poe_te);
eval {$opt = Getopt::Lucid->getopt([
Param("domain"),
Param("username|u"),
Param("password|p"),
Param("host"),
Counter("poe_debug|d"),
Counter("poe_event|e"),
Counter("xmpp_debug|x"),
Counter("verbose|v"),
])};
if($@) {die "ERROR: $@";}
$verbose = $opt->get_verbose ? $opt->get_verbose : VERBOSE;
# xmpp username/password to log in with
$username = $opt->get_username ? $opt->get_username : 'testy1';
$password = $opt->get_password ? $opt->get_password : 'testy1';
$domain = $opt->get_domain ? $opt->get_domain : 'testing.erichacker.com';
$host = $opt->get_host ? $opt->get_host : 'testing.erichacker.com';
$poe_td = $opt->get_poe_debug;
$poe_te = $opt->get_poe_event;
sub POE::Kernel::TRACE_DEFAULT () { $poe_td }
sub POE::Kernel::TRACE_EVENTS () { $poe_te }
use Agent::TCLI::Transport::Test;
use Agent::TCLI::Testee;
use Agent::TCLI::Transport::XMPP;
use Agent::TCLI::User;
use POE;
t/TCLI.Package.XMPP.t view on Meta::CPAN
# 'auth' => 'master',
# ),
);
Agent::TCLI::Transport::XMPP->new(
'jid' => Net::XMPP::JID->new($username.'@'.$domain.'/tcli'),
'jserver' => $host,
# 'jpassword'=> $password,
'peers' => \@users,
'xmpp_debug' => 0,
'xmpp_process_time'=> 1,
'verbose' => \$verbose, # Verbose sets level or warnings
'do_verbose' => sub { diag( @_ ) },
'control_options' => {
'packages' => \@packages,
},
);
t/TCLI.Parameter.t view on Meta::CPAN
# for init 'cl_option' => 't1',
ok($test2->cl_option('-i'),'$test2->cl_option init mutator');
is($test2->cl_option,'-i', '$test2->cl_option accessor');
my $verbose = Agent::TCLI::Parameter->new(
name => 'test_verbose',
aliases => 'verbose|v',
constraints => ['UINT'],
help => "an integer for verbosity",
manual =>
'This debugging parameter can be used to adjust the verbose setting',
type => 'Counter',
cl_option => '-v',
);
my $switch = Agent::TCLI::Parameter->new(
name => 'switch',
help => "a switch for a parameter",
manual =>
'This parameter is used for testing the module.',
type => 'Switch',
t/TCLI.Transport.Test.t view on Meta::CPAN
use Test::More qw(no_plan);
use warnings;
use strict;
use Getopt::Lucid qw(:all);
my ($opt, $verbose, $poe_td, $poe_te);
eval {$opt = Getopt::Lucid->getopt([
Counter("poe_debug|d"),
Counter("poe_event|e"),
Counter("verbose|v"),
Switch("blib|b"),
])};
if($@) {die "ERROR: $@";}
if ($opt->get_blib)
{
use lib 'blib/lib';
}
print "opt->get_verbose(".$opt->get_verbose." )\n";
$verbose = $opt->get_verbose ? $opt->get_verbose : 0;
print "verbose(".$verbose." )\n";
# xmpp username/password to log in with
$poe_td = $opt->get_poe_debug;
$poe_te = $opt->get_poe_event;
sub POE::Kernel::TRACE_DEFAULT () { $poe_td }
sub POE::Kernel::TRACE_EVENTS () { $poe_te }
use Agent::TCLI::Transport::Test;
use Agent::TCLI::Testee;
use POE;
use Agent::TCLI::Package::Tail;
( run in 1.811 second using v1.01-cache-2.11-cpan-49f99fa48dc )