Agent-TCLI
view release on metacpan or search on metacpan
transport with users, packages and other pertinent information.
The Agent will log in, join chatrooms if in the user list,
and wait for further commands from authorized users or in a chatroom.
Test script:
A test script is written, Agent::TCLI::Testee, that loads up a Test Transport,
other necessary transports, necessary local packages, and testees.
Using testees, one creates tests ala Test::More with Agent controlling
versions of ok, is_ , and like_ tests.
These will run asynchronously after the testing starts. One must be conscious
of the asynchronous nature of the test flow.
It is necessary to call the test_master->run at the end of the test to ensure
that all tests have completed.
COPYRIGHT AND LICENCE
Copyright (C) 2007, Alcatel-Lucent
This library is free software; you can redistribute it and/or modify
bin/agent_tail.pl view on Meta::CPAN
Print a brief help message and exit.
=item B<man>
Print this command's manual page and exit.
=back
=head1 DESCRIPTION
B<agent_tail> will start a TCLI Agent running on the XMPP Transport
with the Tail and XMPP packages loaded.
Use B<agent_tail> as is or as the basis for creating Agents with different
functionaity.
=head1 SEE ALSO
L<Agent::TCLI>
=head1 AUTHOR
bin/agent_tail.pl view on Meta::CPAN
'verbose' => \$verbose, # Verbose sets level or warnings
'control_options' => {
'packages' => \@packages,
},
);
print "Starting ".$alias unless $verbose;
# Required to start the Agent
POE::Kernel->run();
print" FINISHED";
exit;
lib/Agent/TCLI.pm view on Meta::CPAN
through additional modules in collections called packages.
TCLI attempts to make writing these
modules easier by providing Base classes that offer much of the
needed functionality to support the standardized, easy to learn human
interface. The goal is to allow users to add new functionality without
having then spend a lot of time learning the particular syntax of a
new tool.
=head1 GETTING STARTED
The quickest way to start running an agent is to run the provided Tail Agent:
tail_agent user=<user> password=<example> domain=<example.com>
One must fist have created a Jabber/XMPP account for the agent to log in to.
One can then log in with a Jabber client using the same user ID and password
and communicate with the Agent. The Agnet will be logged in using the
resource 'tcli'. Jabber clients vary in how to start a chat with onself
at a different resource, so please see your Jabber client documentation
for details.
=head1 COMPONENTS
The following modules make up the core of the TCLI system.
=head2 Agent::TCLI::Control
The L<Agent::TCLI::Control> is the key broker between the Transports and the
lib/Agent/TCLI/Command.pm view on Meta::CPAN
:All('manual');
=item command
A reference to the sub routine that will execute the command
or the name of the package session that will run the command.
=cut
my @command :Field :All('command');
=item start
Deprecated: A reference to a subroutine that is necessary to intialize the command at control startup.
B<start> will only accept CODE type values.
=cut
my @start :Field :All('start')
:Type('CODE');
=item stop
Deprecated: A code reference for shutting down anything as the control shuts down.
B<stop> will only accept CODE type values.
=cut
my @stop :Field :All('stop')
:Type('CODE');
=item handler
lib/Agent/TCLI/Command.pm view on Meta::CPAN
#sub RawCommand {
# my $self = shift;
## my %cmd = validate( @_, {
## help_text => { type => Params::Validate::SCALAR }, #required
## usage => { type => Params::Validate::SCALAR }, #required
## topic => { optional => 1, type => Params::Validate::SCALAR },
## name => { type => Params::Validate::SCALAR }, #required
## command => { type => ( Params::Validate::SCALAR | Params::Validate::CODEREF ) }, #required
## context => { optional => 1, type => Params::Validate::ARRAYREF },
## style => { optional => 1, type => Params::Validate::SCALAR },
## start => { optional => 1, type => Params::Validate::CODEREF },
## handler => { optional => 1, type => Params::Validate::SCALAR },
## stop => { optional => 1, type => Params::Validate::CODEREF },
## } );
#
# my %cmdhash = (
# 'name' => $name[$$self],
# 'help' => $help[$$self],
# 'usage' => $usage[$$self],
# 'command' => $command[$$self],
# );
# $cmdhash{'topic'} = $topic[$$self] if (defined($topic[$$self]));
# $cmdhash{'contexts'} = $contexts[$$self] if (defined($contexts[$$self]));
# $cmdhash{'call_style'} = $call_style[$$self] if (defined($call_style[$$self]));
# $cmdhash{'handler'} = $handler[$$self] if (defined($handler[$$self]));
# $cmdhash{'start'} = $start[$$self] if (defined($start[$$self]));
# $cmdhash{'stop'} = $stop[$$self] if (defined($stop[$$self]));
#
# return ( \%cmdhash );
#}
=item GetoptLucid( $kernel, $request)
Returns an option hash keyed on parameter after the arguments have bee parsed
by Getopt::Lucid. Will respond itself if there is an error and return nothing.
lib/Agent/TCLI/Control.pm view on Meta::CPAN
=item registered_commands
The collection of registered_commands in the control library. Commands may
not be set, but must added with the register method.
=cut
my @registered_commands :Field :Get('registered_commands');
my @starts :Field :Get('starts');
my @stops :Field :Get('stops');
my @handlers :Field :Get('handlers');
my @start_time :Field
:Get('start_time');
my @user :Field :All('user')
:Type('Agent::TCLI::User');
my @packages :Field :All('packages');
#my @alias :Field :All('alias');
=item auth
lib/Agent/TCLI/Control.pm view on Meta::CPAN
=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
lib/Agent/TCLI/Control.pm view on Meta::CPAN
# 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') {
lib/Agent/TCLI/Control.pm view on Meta::CPAN
my $self = shift;
$self->Verbose("Register: params",4,@_);
my %cmd = validate( @_, {
help => { type => Params::Validate::SCALAR }, #required
usage => { type => Params::Validate::SCALAR }, #required
topic => { optional => 1, type => Params::Validate::SCALAR },
name => { type => Params::Validate::SCALAR }, #required
command => { type => ( Params::Validate::SCALAR | Params::Validate::CODEREF ) }, #required
contexts => { optional => 1, type => Params::Validate::HASHREF },
call_style => { optional => 1, type => Params::Validate::SCALAR },
# start => { optional => 1, type => Params::Validate::CODEREF },
handler => { optional => 1, type => Params::Validate::SCALAR },
# stop => { optional => 1, type => Params::Validate::CODEREF },
} );
# Set up a default contexts if one not provided.
$cmd{'contexts'} = { 'ROOT' => $cmd{'name'} } unless (defined ( $cmd{'contexts'}) );
$self->Verbose("Register: name ".$cmd{'name'} );
$self->RegisterContexts(\%cmd);
# # Don't want these in loop, since they only should get added once.
# push ( @{ $starts[$$self] }, \%cmd ) if ( defined ( $cmd{'start'} ) );
# push ( @{ $handlers[$$self] }, \%cmd ) if ( defined ( $cmd{'handler'} ) );
# push ( @{ $stops[$$self] }, \%cmd ) if ( defined ( $cmd{'stop'} ) );
$self->Verbose("Register: commands \n",5,$registered_commands[$$self]);
return 1;
}
=item RegisterContexts
lib/Agent/TCLI/Control.pm view on Meta::CPAN
}
else
{
$self->Verbose( "RegisterPackage: Bad package $package->dump(1) ",0 );
$self->Verbose( "RegisterPackage: Bad package commands ref(".ref($commands).") dump",0,$commands );
$txt = "Bad package $package";
}
return $txt;
}
=item _start
POE event to load up any initialization routines for commands.
=cut
sub _start {
my ($kernel, $self, $session) =
@_[KERNEL, OBJECT, SESSION];
if (!defined( $self->id ))
{
$self->Verbose("_start: OIO not done re-starting");
$kernel->yield('_start');
return;
}
$kernel->alias_set("$id[$$self]");
$self->Verbose("_start: Starting commands start routines \n");
foreach my $startcmd ( @{ $starts[$$self] } ) {
if ( ref($startcmd) eq 'HASH' )
{
if (defined ($startcmd->{'start'})) {
$self->Verbose("_start:\trunning ".$startcmd->{'name'}." 's start \n",2) ;
eval { $startcmd->{'start'}( kernel => $kernel,
object => $self,
session => $session,
) }
}
}
elsif ( ref($startcmd) =~ /Agent::TCLI::Command/ )
{
$self->Verbose("_start:\trunning ".$startcmd->name()." 's start \n",2) ;
# TODO some error checking here maybe :)
$startcmd->start( { kernel => $kernel,
object => $self,
session => $session,
} );
}
}
# Handlers are events to send the request to. The result will be returned
# to AsYouWished.
# The handler is the name of the event, and the command is the session that
# will handle the event.
# Often the handler name will not be the actual command name.
# TODO, this isn't doing anything right now. Should it? Or are we doing it in the
# _starts session creation....
$self->Verbose("_start: Insert command handler states \n");
foreach my $command ( @{ $handlers[$$self] } ) {
# if the command is not defined, the handler is assumed to be pre-loaded
if ( ref($command->{'command'}) =~ /CODE/ ) {
$self->Verbose("_start:\tregistering ".$command->{'name'}." 's handler $command->{'handler'} \n", 2 );
$kernel->state( $command->{'handler'} , $command->{'command'} );
}
}
# unless ($heap->{no_std_tie}) {
# $self->Verbose "tie STDOUT and STDERR \n" if VERBOSE;
# tie *STDOUT, __PACKAGE__."::Output", 'stdout', \&jabber_send_msg;
# tie *STDERR, __PACKAGE__."::Output", 'stderr', \&jabber_send_msg;
# }
#
# if ($heap->{ties}) {
# foreach (@{$heap->{ties}}) {
# $self->Verbose "tie $_ \n" if VERBOSE;
# tie *$_, __PACKAGE__."::Output", $_, \&jabber_send_msg;
# }
# }
if( $self->session )
{
$self->set(\@start_time, time() );
$self->Verbose( "_started: up at ".$self->start_time.
" _start completed. \n\n");
}
} # End sub _start
=item stop
Poe state that is mostly just a placeholder.
=cut
sub _stop {
my ($kernel, $self, $session) = @_[KERNEL, OBJECT, SESSION];
$self->Verbose("Stopping ".$self->id );
lib/Agent/TCLI/Control.pm view on Meta::CPAN
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();
}
lib/Agent/TCLI/Package/Base.pm view on Meta::CPAN
=over
=cut
sub _preinit :Preinit {
my ($self,$args) = @_;
$args->{'session'} = POE::Session->create(
object_states => [
$self => [qw(
_start
_stop
_shutdown
_default
establish_context
settings
show
)],
],
)
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");
$kernel->yield('_start');
# $kernel->delay('_start', 1 );
return;
}
$self->Verbose("_start: ".$self->name()." starting");
# There is only one command object per TCLI
$kernel->alias_set($self->name);
}
# This POE event handler is used to initiate a shutdown of the Control.
sub _shutdown :Cumulative {
my ($kernel, $self,) =
@_[KERNEL, OBJECT,];
$self->Verbose("_shutdown:base ".$self->name." shutting down");
lib/Agent/TCLI/Package/Tail.pm view on Meta::CPAN
}
sub _preinit :Preinit {
my ($self,$args) = @_;
$args->{'name'} = 'tcli_tail';
$args->{'session'} = POE::Session->create(
object_states => [
$self => [qw(
_start
_stop
_shutdown
_default
_child
clear
establish_context
file
log
show
lib/Agent/TCLI/Package/Tail.pm view on Meta::CPAN
name: interval
help: Seconds to wait between checks.
manual: >
Seconds to wait between checks.
type: Param
---
Agent::TCLI::Parameter:
name: seek
help: Seek forward byte count.
manual: >
The Seek parameter tells Tail how far from the start of the file to start
reading. Its value is specified in bytes, and values greater than the
file's current size will quietly cause Tail to start from the file's end.
A Seek parameter of 0 starts FollowTail at the beginning of the file.
A negative Seek parameter emulates SeekBack: it seeks backwards from
the end of the file.
Seek and SeekBack are mutually exclusive. If Seek and SeekBack are not
specified, Tail seeks 4096 bytes back from the end of the file
and discards everything until the end of the file. This helps ensure
that Tail returns only complete records.
type: Param
---
Agent::TCLI::Parameter:
name: seekback
help: Seek backwards byte count.
manual: >
The SeekBack parameter tells Tail how far back from the end of the file
to start reading. Its value is specified in bytes, and values greater
than the file's current size will quietly cause Tail to start from
the file's beginning.
A SeekBack parameter of 0 starts Tail at the end of the file.
It's recommended to omit Seek and SeekBack to start from the end of a file.
A negative SeekBack parameter emulates Seek: it seeks forwards from
the start of the file.
type: Param
---
Agent::TCLI::Parameter:
name: name
help: The name of the test.
manual: >
The name is purely cosmetic and will be returned with the test results
simliarly to the way Test::Simple operates. This might be useful
when reporting results to a group chat or log.
type: Param
lib/Agent/TCLI/Package/Tail.pm view on Meta::CPAN
=cut
sub _shutdown :Cumulative {
my ($kernel, $self,) =
@_[KERNEL, OBJECT,];
$self->Verbose("_shutdown:tail ".$self->name." shutting down");
return;
}
=item _start
This POE event handler is called when POE starts up a Package.
The B<_start> method is :Cumulative within OIO.
=cut
sub _start {
my ($kernel, $self, $session) =
@_[KERNEL, OBJECT, SESSION];
$self->Verbose("_start: Starting test_tail ");
# are we up before OIO has finished initializing object?
if (!defined( $self->name ))
{
$kernel->yield('_start');
return;
}
# There is only one command object per TCLI
$kernel->alias_set($self->name);
$kernel->delay('PruneLineCache',10);
$kernel->delay('Activate', $self->interval , 0 );
return("_start ".$self->name);
}
1;
#__END__
=back
=head3 INHERITED METHODS
This module is an Object::InsideOut object that inherits from
lib/Agent/TCLI/Package/UnixBase.pm view on Meta::CPAN
=head1 DESCRIPTION
Base class for Packages needing to run other Unix programs. It provides methods
to asnychronously call Unix programs using POW::Wheel::Run through
POE::Component::Child. This base class comes with simple
event handlers to accept the output and/or errors returned from the wheel.
Typically, one may want their subclass to replace the stdout method
with one that does more processing of the responses. One should use the
methods here as a starting point in such cases.
Commands run through these methods are run in their own processes asychonously.
Other Agent processing continues while the results of the commands are
captured and returned. Package authors need to ensure that their command
threads shut down or else they may exhaust system resources.
=head1 INTERFACE
=cut
lib/Agent/TCLI/Package/UnixBase.pm view on Meta::CPAN
# Standard class utils are inherited
=back
See Agent::TCLI::Package::Base for other attributes applicable to Packages.
=head2 METHODS
These simple methods may be used as is, or subclasses may use them as
starting point.
=over
=item RunWheelStart
This initializes the POE::Component::Child session. It may be called
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,
lib/Agent/TCLI/Package/XMPP.pm view on Meta::CPAN
=cut
sub _preinit :Preinit {
my ($self,$args) = @_;
$args->{'name'} = 'tcli_xmpp';
$args->{'session'} = POE::Session->create(
object_states => [
$self => [qw(
_start
_stop
_shutdown
_default
change
establish_context
peer
show
shutdown
)],
lib/Agent/TCLI/Package/XMPP.pm view on Meta::CPAN
This POE event handler executes the peer commands.
=cut
sub peer {
my ($kernel, $self, $sender, $request, ) =
@_[KERNEL, OBJECT, SENDER, ARG0, ];
# It seems that the proper way to handle removing users would be to delete
# the user's control and making sure that the user is authenticated before
# starting up a new control. There needs to be a remove control capability
# within a transport.
my $txt = '';
my $param;
my $command = $request->command->[0];
my $cmd = $self->commands->{'peer-'.$command};
# break down args
return unless ( $param = $cmd->Validate($kernel, $request, $self) );
lib/Agent/TCLI/Package/XMPP.pm view on Meta::CPAN
sub shutdown {
my ($kernel, $self, $sender, $request, ) =
@_[KERNEL, OBJECT, SENDER, ARG0, ];
$self->Verbose("shutdown: request ".$request->id );
$self->Verbose("shutdown: sending shutdown to transport_xmpp");
$request->Respond($kernel, "Shutting down transport_xmpp");
$kernel->post('transport_xmpp' => '_shutdown');
}
=item start
This POE event handler executes the start command. It is not exactly clear
when this would be useful currently, but we have a shutdown command and
balance must be maintained. Hopefully other transports will be available
in the future and this command might be more useful.
=back
=cut
sub start {
my ($kernel, $self, $sender, $request, ) =
@_[KERNEL, OBJECT, SENDER, ARG0, ];
$self->Verbose("start: request ".$request->id );
$self->Verbose("start: sending start to transport_xmpp");
$request->Respond($kernel, "Starting transport_xmpp");
$kernel->post('transport_xmpp' => '_start');
}
1;
#__END__
=head3 INHERITED METHODS
This module is an Object::InsideOut object that inherits from Agent::TCLI::Package::Base. It
inherits methods from both. Please refer to their documentation for more
lib/Agent/TCLI/Transport/Base.pm view on Meta::CPAN
B<controls> will only accept hash objects.
=cut
my @controls :Field
:All('controls')
:Type('hash');
=item alias
An alias that the session will be run under. Alias can't be
changed after starting.
=cut
my @alias :Field
:Get('alias');
=item peers
An array of peers
B<set_peers> will only accept ARRAYREF type values.
lib/Agent/TCLI/Transport/Base.pm view on Meta::CPAN
# my $arg = $_[0];
# return (Scalar::Util::looks_like_number($arg) &&
# (int($arg) == $arg));
# }
=back
=head2 METHODS
These methods may be used as is, or subclasses may use them as
starting point.
=over
=cut
sub _init :Init {
my ($self, $args) = @_;
}
=item _start
Get things rolling.
=cut
sub _start :Cumulative {
my ($kernel, $self, $session) =
@_[KERNEL, OBJECT, SESSION];
# are we up before OIO has finished initializing object?
if (!defined( $self->alias ))
{
$self->Verbose("_start: OIO not started delaying ",0);
$kernel->call('_start');
return;
}
# There is only one command object per TCLI
$kernel->alias_set($self->alias);
$self->Verbose("_start: Starting alias(".$self->alias.")",0);
} # End sub start
=item _stop
Mostly just a placeholder.
=cut
sub _stop :Cumulative {
my ($kernel, $self, $session) =
@_[KERNEL, OBJECT, SESSION];
lib/Agent/TCLI/Transport/Base.pm view on Meta::CPAN
$kernel->alias_remove( $self->alias );
return("_shutdown ".$self->alias );
}
sub ControlExecute {
my ($kernel, $self, $control, $request ) =
@_[KERNEL, OBJECT, ARG0, ARG1 ];
$self->Verbose("ControlExecute: control(".$control->id.") req(".$request->id.") ");
# Sometimes, control has not started, so we wiat if we have to.
if ( defined($control->start_time) )
{
$kernel->post( $control->id() => 'Execute' => $request );
}
else
{
$kernel->delay('ControlExecute' => 1 => $control, $request );
}
}
=item PackRequest
lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN
Unlike other Transports, users do not have to be defined
for Transport::Test, as it will load a default user. Local tests are
executed with a Control created for the first user in the stack. Currently,
running with users other than the default has not been tested.
Then one needs to create at least one Agent::TCLI::Testee. The testee
object will be used for the actual tests. See Agent::TCLI::Testee
for the tests available.
Within the actual tests, the Agent::TCLI::Transport::Test (as test_master) offers two
flow/control commands. B<run> is necesary at the end of the tests to start
POE completely and finish the tests. B<done> may be used within the script
to force check for completion of all prior tests. B<done> is a test itself and
will report a success or failure.
=head2 ATTRIBUTES
Unless otherwise indicated, these attrbiute methods are for internal use. They are not
yet restricted because the author does not beleive his imagination is better
than the rest of collective world's. If there are use cases for accessing
the internals, please make the author aware. In the future, they may be
lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN
=cut
my @dispatch_counter :Field
:Type('numeric')
:All('dispatch_counter');
=item dispatch_retries
The number of times to retry the dispatching of queued requests. Increments are in 5 second blocks. Default is 6 or 30 seconds. This is a user adjustable setting.
When the count is reached, the next test is dispatched without regard to the state of the previous test.
The timeout will not start until dispatching is done or exceeded its retries. This allows for other requests to complete.
B<dispatch_retries> will only contain numeric values.
=cut
my @dispatch_retries :Field
:Type('numeric')
:Arg('name'=>'dispatch_retries','default'=>6)
:Acc('dispatch_retries');
=item timeout_counter
lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN
The id of the timeout event so that it can be rescheduled if necessary.
=cut
my @timeout_id :Field
# :Type('type')
:All('timeout_id');
=item running
A flag to indicate if we've started the POE kernel fully, rather than just running slices.
This is set when B<run> is called.
B<running> should only contain boolean values.
=cut
my @running :Field
# :Type('boolean')
:Arg('name'=>'running','default'=>0)
:Acc('running');
=item last_testee
lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN
is 31 seconds if none is supplied.
It takes an option parameter of a test name.
=cut
sub done {
my ($self, $wait, $name) = @_;
$wait = 31 unless defined $wait;
my $start = time();
my $ready = 0;
$self->Verbose($self->alias.":done: start($start) wait($wait)");
# Clean out anything in kernel queue
# $poe_kernel->run_one_timeslice unless ($self->running || $wait == 0 );
# Try to finish up anything left out there.
while ( $start + $wait > time() )
{
$self->Verbose($self->alias.":done: end(".($start + $wait).")time(".time().") ",3);
# make sure there is nothing in request queue
$self->dispatch;
$ready = $self->post_it('done');
# Clean out anything in kernel queue
$poe_kernel->run_one_timeslice;
last if $ready;
next;
}
$ready = $self->post_it('done') if ($wait == 0);
lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN
is 31 seconds if none is supplied.
It takes an option parameter of a test name.
=cut
sub done_id {
my ($self, $id, $wait, $name) = @_;
$wait = 31 unless defined $wait;
my $start = time();
my $ready = 0;
# validate id
unless ( defined($id) && $id )
{
# Use last id if not supplied
$id = $self->make_id( $request_count[$$self] );
}
$self->Verbose($self->alias.":done_id: id($id) start($start) wait($wait)",1);
# Clean out anything in kernel queue
# $poe_kernel->run_one_timeslice unless ($self->running || $wait == 0 );
# Try to finish up anything left out there.
while ( $start + $wait > time() )
{
$self->Verbose($self->alias.":done_id: end(".($start + $wait).") time(".time().") ",3);
# make sure there is nothing in request queue
$self->dispatch;
$ready = $self->post_it('done');
# Clean out anything in kernel queue
$poe_kernel->run_one_timeslice;
last if $ready;
next;
}
$ready = $self->post_it('done') if ($wait == 0);
lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN
=cut
sub _preinit :PreInit {
my ($self,$args) = @_;
$args->{'alias'} = 'transport_test' unless defined( $args->{'alias'} ) ;
$args->{'session'} = POE::Session->create(
object_states => [
$self => [ qw(
_start
_stop
_shutdown
_child
_default
Dispatch
SendChangeContext
SendRequest
PostResponse
lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN
# who cares, send it now.
{
$post_it = 1;
}
$self->Verbose($self->alias.":post_it: ($post_it)");
return($post_it);
}
=item responses_contiguous ( )
Sets responses_max_contiguous correctly by starting at the last value and
incrementing until a response has not been recived. Return
responses_max_contiguous.
=cut
sub responses_contiguous {
my ($self, $id) = @_;
while ( defined($self->responses->{
$self->make_id( $self->responses_max_contiguous + 1) } ) )
lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN
# $self->Verbose($self->alias.":Dispatch: STALLED requests(".$self->depth_requests.") ",0 );
# # Stalled out
# foreach my $test ( @{$self->requests} )
# {
# $self->Verbose($self->alias.":Dispatch: test dump(".$test->dump(1).") ");
# }
# return;
# }
else
{
#start counting to doom...
$dispatch_counter[$$self]++;
$kernel->delay('Dispatch', $delay, $delay );
}
return('Dispatch_'.$self->alias);
}
=item PostRequest
B<PostReuqest> is a required POE event handler for all Transports. Well, all
lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN
=cut
sub PostResponse {
my ($kernel, $self, $sender, $response) =
@_[KERNEL, OBJECT, SENDER, ARG0];
$self->Verbose($self->alias.":PostResponse: sender(".$sender->ID.") Code(".$response->code.") \n");
# Test always terminates a response transmission. The buck stops here,
# unlike other transports
# TODO Need to figure out how to decide it is time to start checking the tests!
# Hmm. I donn't want to optimize this better with another object right now.
# Push response into a responses array in a hash keyed on id.
push( @{ $responses[$$self]->{$response->id} }, $response );
$self->Verbose($self->alias.":PostResponse: responses(".@{ $responses[$$self]->{$response->id} }.
") ",3,$responses[$$self]->{$response->id} );
# Work off of the first response for tracking.
lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN
# Put time in request for tracking
$request->set_time(time());
if ( $request->sender->[0] eq $self->alias )
{
$self->Verbose($self->alias.":SendRequest: local request \n");
$self->Verbose($self->alias.":SendRequest: request dump ".$request->dump(1),3 );
# Get a Control for the test-master user loaded into peers.
my $control = $self->GetControl( $self->peers->[0]->id, $self->peers->[0] );
# Post to our Control
# Sometimes, control has not started, so we wiat if we have to.
if ( defined($control->start_time) )
{
$kernel->post( $control->id => 'Execute' => $request );
}
else
{
$kernel->delay('ControlExecute' => 1 => $control, $request );
}
}
else
{
lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN
foreach my $package ( @{$self->control_options->{'packages'} })
{
$kernel->post( $package->name => '_shutdown' );
}
# $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);
$self->Verbose($self->alias.":_start: Starting alias(".$self->alias.")");
# Set up recording.
$self->requests_sent(0) ;
$self->requests_complete(0);
# initialize counters
$self->dispatch_counter(0);
$self->timeout_counter(0);
# This will call timeout in 5 seconds
lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN
# 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 {
my ($kernel, $session, $self) = @_[KERNEL, SESSION, OBJECT];
lib/Agent/TCLI/Transport/XMPP.pm view on Meta::CPAN
Holds the Net::XMPP::Roster if enabled. To enable the roster,
a paramater of 'roster' => 1, must be passed in with new.
B<roster> will contain a Net::XMPP::Roster object after initialization if enabled.
=cut
my @roster :Field
:All('roster');
=item server_time
The time at the server. Useful for determining if messages were sent before we started up.
B<server_time> should only contain hash values.
=cut
my @server_time :Field
# :Type('hash')
:All('server_time');
=item group_mode
The default setting to determine how to interact with groups. Options are:
lib/Agent/TCLI/Transport/XMPP.pm view on Meta::CPAN
}
sub _preinit :Preinit {
my ($self, $args) = @_;
$args->{'alias'} = 'transport_xmpp' unless defined( $args->{'alias'} );
$args->{'session'} = POE::Session->create(
object_states => [
$self => [ qw(
_start
_stop
_shutdown
_default
_child
ControlExecute
Disconnected
JoinPeerRooms
JoinChatRoom
Login
lib/Agent/TCLI/Transport/XMPP.pm view on Meta::CPAN
}
=back
=head2 METHODS
=over
=item start
Get things rolling. Starts up a POE::Component::Jabber::Client using the user
provided config info.
=cut
sub _start {
my ($kernel, $self, $session) =
@_[KERNEL, OBJECT, SESSION];
# are we up before OIO has finished initializing object?
if (!defined( $self->alias ))
{
$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'},
}
);
# $self->Verbose("_start: Setting General XMPP Callbacks" , 2 );
# $xmpp->SetCallBacks(
# 'send' => $session->postback('VerboseCallBack'),
# 'receive' => $session->postback('VerboseCallBack'),
# 'presence' => $session->postback('recv_presence'),
# 'iq' => $session->postback('recv_iq'),
# );
$self->Verbose("_start: Setting XMPP Message Callbacks" , 2 );
$xmpp->SetMessageCallBacks(
'normal' => $session->postback('recvmsg'),
'chat' => $session->postback('recvmsg'),
'groupchat' => $session->postback('recvmsgGroupchat'),
'headline' => $session->postback('recvmsgHeadline'),
'error' => $session->postback('recvmsgError'),
);
# $xmpp->SetPresenceCallBacks(
lib/Agent/TCLI/Transport/XMPP.pm view on Meta::CPAN
'get' => $session->postback('recv_iqRequest'),
# 'set' => function,
'result'=> $session->postback('recv_iqResponse'),
},
);
$self->set(\@xmpp, $xmpp);
$kernel->yield('Login') if (defined( $self->jpassword ));
return ($self->alias."_start whohoo");
} # End sub start
=item stop
Mostly just a placeholder.
=cut
sub _stop {
my ($kernel, $self, $session) =
@_[KERNEL, OBJECT, SESSION];
lib/Agent/TCLI/Transport/XMPP.pm view on Meta::CPAN
sub Online {
my ($kernel, $self, ) =
@_[KERNEL, OBJECT, ];
$self->Verbose("Online: \n" ,1);
my %server_time = $self->xmpp->TimeQuery('mode'=>'block');
$self->Verbose("Online: server_time($server_time{display})", 1,\%server_time );
$self->set(\@server_time, $server_time{utc});
# start roster
if ($self->roster)
{
$self->Verbose("Online: enabling Roster ");
$self->set(\@roster, $self->xmpp->Roster);
}
if (defined($self->control_options) )
{
$self->control_options->{'local_address'} = $self->Address
unless defined($self->control_options->{'local_address'});
lib/Agent/TCLI/Transport/XMPP.pm view on Meta::CPAN
$request->unshift_sender($self->alias);
$request->unshift_postback('PostResponse');
my $control = $self->GetControlForNode( $msg );
return unless $control;
$self->Verbose("recv_iqRequest: sending to contol(".$control->id().") \n",1);
$self->Verbose("recv_iqRequest: control dump.... \n".$control->dump(1), 5 );
# Sometimes, control has not started, so we wiat if we have to.
if ( defined($control->start_time) )
{
$kernel->post( $control->id() => 'Execute' => $request );
}
else
{
$kernel->delay('ControlExecute' => 1 => $control, $request );
}
}
sub recv_iqResponse {
lib/Agent/TCLI/Transport/XMPP.pm view on Meta::CPAN
} # end sub xmpp_send_msg
=item GetControlForNode ( node )
Determines the control from a node and returns the control object.
Takes a node parameter and returns the hash key to the proper control
object in the controls array. If the control object is not in the array,
it will add it.
When a new control object is created, a new Control session must be started
for the control and that is handled here as well.
=cut
sub GetControlForNode {
my ($self, $node) = @_;
$self->Verbose("GetControlForNode: node(".ref($node).") \n");
my $type = $node->GetType;
my $user = $node->GetFrom('jid');
lib/Agent/TCLI/User.pm view on Meta::CPAN
ID of user in a form acceptable to the protocol.
XMPP/Jabber IDs MUST not include resource information.
=cut
my @id :Field :All('id');
=item protocol
Protocol that user is allowed access on. Currently only xmpp and xmpp-groupchat
are supported by Transport::XMPP. If the protocol is xmpp-groupchat, the
Transport will automatically join the conference room at start-up.
=cut
my @protocol :Field :All('protocol');
=item auth
Authorization level of user. MUST be one of these values:
B<reader> has read access
B<writer> has write access
B<master> has root access
( run in 0.448 second using v1.01-cache-2.11-cpan-0d8aa00de5b )