Agent-TCLI
view release on metacpan or search on metacpan
lib/Agent/TCLI/Command.pm view on Meta::CPAN
Brief illustration of usage. Complex commands may want to show how to call
help / manual instead.
B<set_usage> will only accept SCALAR type values.
=cut
my @usage :Field :All('usage');
=item manual
A long desciption of the command and its use. This text will be followed
by the command's parameter's manul sections if provided.
B<manual> will only contain scalar values.
=cut
my @manual :Field
# :Type('scalar')
:All('manual');
=item command
A reference to the sub routine that will execute the command
lib/Agent/TCLI/Command.pm view on Meta::CPAN
'poe' means the command is called directly with the normal POE KERNEL
HEAP and ARGs. 'session' means that a POE event handler is called.
B<call_style> will only accept SCALAR type values.
=cut
my @call_style :Field :All('call_style');
=item contexts
A hash of the contexts that the command may be called from. This needs to
be written up much better in a separate section, as it is very complicated.
B<contexts> will only accept hash type values.
=cut
my @contexts :Field
:All('contexts')
:Type('Hash');
=item parameters
A hash of parameter objects that the command accepts.
lib/Agent/TCLI/Command.pm view on Meta::CPAN
=head1 BUGS
When naming commands in the preinit commands hash or loading from loadyaml()
it is easy to accidentally
duplicate names and cause commands not to load. The author expects that when he
makes this a habit, he'll try to fix it by doing something better than a loading
a hash with no validation.
Most command packages process args in an eval statement which will sometimes
return rather gnarly detailed traces back to the user. This is not a security issue
because open source software is not a black box where such obscurity might
be relied upon (albeit ineffectively), but it is a bug.
SHOULDS and MUSTS are currently not always enforced.
Test scripts not thorough enough.
Probably many others.
=head1 LICENSE
lib/Agent/TCLI/Package/Tail.pm view on Meta::CPAN
B<line_max_cache> will only contain numeric values.
=cut
my @line_max_cache :Field
:Type('numeric')
:Arg('name'=>'line_max_cache','default'=>10)
:Acc('line_max_cache');
=item line_hold_time
Time to hold lines in the cache, in seconds.
B<line_hold_time> will only contain numeric values.
=cut
my @line_hold_time :Field
:Type('numeric')
:Arg('name'=>'line_hold_time','default'=>30)
:Acc('line_hold_time');
=item test_max_lines
lib/Agent/TCLI/Package/Tail.pm view on Meta::CPAN
Since actions are asynchronous, it is a good idea to have at least some
line cache so that a tail test will work when the action to generate the
log ocurred before the test was in place.
type: Param
---
Agent::TCLI::Parameter:
name: line_hold_time
alaises: hold_time
constraints:
- UINT
help: The time, in seconds, to keep lines in the cache.
manual: >
The line_hold_time parameter sets how many seconds to keep lines in
the line_cache. This is not an exact amount but rather the minimum,
The purge_line_cache process does not run every second, but lines that
exceeed the hold_time will be purged when it does run.
type: Param
---
Agent::TCLI::Parameter:
name: test_max_lines
alaises: max_lines
help: The maximum number of lines to check before failing.
manual: >
The max_lines parameter sets how many lines to check before giving up
and failing. For tests, the default is ten, which is the default size
lib/Agent/TCLI/Package/Tail.pm view on Meta::CPAN
help: The numer of times the a match must be found.
manual: >
The match_times parameter sets how many times a line must match
in order to pass. For tests, the default is one. For watches, the default is
zero, which means it ignores match_times and stays active.
type: Param
---
Agent::TCLI::Parameter:
name: test_ttl
aliases: ttl
help: The time-to-live in seconds.
manual: >
The ttl parameter sets how many seconds to wait before giving up
and failing. For tests, the default is 30. For watches, the default is
zero, which means it does not ever expire.
type: Param
---
Agent::TCLI::Parameter:
name: ordered
help: Set the order for processing tests.
manual: >
Ordered is a boolean switch indicating how to process the tests. If set
a test will not be checked against a line until the previous test has
lib/Agent/TCLI/Request.pm view on Meta::CPAN
}
}
}
return $response;
}
=item Respond ( <poe_kernel>, <text> [, <code>]) or ( <poe_kernel>, <response obj> )
Respond is the proper way to return a response to a request. It requires a
reference to the poe_kernel as the first parameter. The second parameter
may be either some text for the response or a Response object. The third
parameter is the resposne code. If not provided, it defaults to 200. While not
required, it is best to always fill in the response code. The response code
will be ignored if a Response object is provided.
=cut
sub Respond {
# using Respond to return anything. That way it will
# be easier to change/override how to return later on,
lib/Agent/TCLI/Testee.pm view on Meta::CPAN
=item * name - a name to identify the test in the output
=back
Thus the complete test looks like:
$testee->is_code("status", 200,"status ok");
The ok and not_ok tests check if the response code falls within a range of
values indicating success or failure, repsectively. One does not need to supply
an expected response code value with these tests.
$testee->ok("status","status ok");
There are times when a single request may elicit multiple responses. One can use
a blank request to add tests for additional responses to the prior request. One cannot
test both the code and the body on the same response. One can test the code of
the first response and the body of the second. All additional tests must
immediately follow the original populated request.
A request is not actually sent until a new request is made or a test_master
command like run or done is called.
When there are multiple responses per request, the tests will be executed
on the responses in the order that they are written in the script. However, the
test script is usually running asnchronously, and other responses to later
requests may be processed before all responses to earlier requests have arrived.
lib/Agent/TCLI/Testee.pm view on Meta::CPAN
*not_ok = \&is_error;
#=item do / is_trying
#
# do ( 'some request', <timeout>, <test_name> );
#
#Some commands, such as setting a tail or watch, will not return response
#with content immediately. These may however return a response with a
#seies 100 code for Trying. B<do> makes a request of the testee and passes
#if a Trying response is received within the timeout in seconds.
#B<do> is really just an alias for B<is_trying>
#and they can be used interchangably. If the test fails, the response body
#will be output with the diagnostics.
#One must follow up with other tests if checking actual responses is necesary.
#
#
#=cut
# Need to fix do_test as well as check for other issues before enabling
#sub is_trying {
# my $self = shift;
lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN
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
restricted to reduce the need for error checking and for security.
=over
=cut
use warnings;
use strict;
use vars qw($VERSION @EXPORT %EXPORT_TAGS );
lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN
A running counter of Dispatch attempts to prevent stalling.
B<dispatch_counter> will only contain numeric values.
=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');
lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN
A running counter for timing out all requests.
B<timeout_counter> will only contain numeric values.
=cut
my @timeout_counter :Field
:Type('numeric')
:All('timeout_counter');
=item timeout_retries
The number of times to retry the timeout. Increments are in 5 second blocks. Default is 6 or 30 seconds.
Timeout checks periodically to make sure we're still running requests. It begins the countdown when
all requests have been dispatched, so that we don't wait forever for something to complete. This is user adjustable.
B<timeout_retries> will only contain numeric values.
=cut
my @timeout_retries :Field
:Type('numeric')
:Arg('name'=>'timeout_retries','default'=>6)
:Acc('timeout_retries');
lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN
=over
=item done( <timeout>, <name> )
When B<done> is called, it will attempt to complete all previous requests before
continuing. If done is provided a name parameter, it will report its
results as a test. That is, it will pass if all previous tests are
completed before the timeout. In either case, it will return true if all tests
are complete and false otherwise.
It takes an optional timeout parameter, an integer in seconds. The default timeout
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();
lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN
return ($ready);
}
=item done_id(<id>, <timeout>, <name> )
B<done_id> works similarly to B<done> except that it waits only for the
results from one request, as specified by the id. If a request id is not
supplied, it will default to the last request made.
It takes an optional timeout parameter, an integer in seconds. The default timeout
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();
lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN
$kernel->call( $sender => $postback => $request );
}
return( );
}
=item Timeout
B<Timeout> is a POE event handler that makes sure that a test script completes
and no requests leave the system waiting too long for a response. It takes
an argument of the delay, in seconds, that it will wait until checking again.
=cut
sub Timeout {
my ($kernel, $self, $session, $delay, ) =
@_[KERNEL, OBJECT, SESSION, ARG0, ];
$self->Verbose($self->alias.":Timeout: {".$delay.
"} run(".$self->running.") dc(".$dispatch_counter[$$self].") dr(".
$dispatch_retries[$$self].") tc(".$timeout_counter[$$self].") tr".
$timeout_retries[$$self].") requests(".$self->depth_requests.") ");
lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN
$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
# 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.
lib/Agent/TCLI/Transport/XMPP.pm view on Meta::CPAN
=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');
=item peers
An array of peers
lib/Agent/TCLI/Transport/XMPP.pm view on Meta::CPAN
=cut
my @connection_retries
:Field
:Arg('name'=>'connection_retries','default'=>10)
:Acc('connection_retries')
:Type('NUMERIC' );
=item connection_delay
How long to wait beteen connection attempts when failed. Defaults to 30 seconds.
B<connection_delay> will only accept NUMERIC type values.
=cut
my @connection_delay
:Field
:Arg('name'=>'connection_delay','default'=>30)
:Acc('connection_delay')
:Type('NUMERIC' );
=item roster
lib/Agent/TCLI/Transport/XMPP.pm view on Meta::CPAN
sub Disconnected {
my ($kernel, $self, $count ) =
@_[KERNEL, OBJECT, ARG0 ];
# if connection retries is zero, then we shutdown with no delay.
# This is important when we try to shutdown and the
# xmpp->Disconnect is called. :)
if ( !defined( $count ) && $connection_retries[$$self] > 0 )
{
$kernel->delay_set('Disconnected', $connection_delay[$$self], 1 );
$self->Verbose("Disconnected: got XMPP disconnect waiting ".$connection_delay[$$self]." seconds" );
return;
}
else
{
$count++;
$self->Verbose("Disconnected: count ($count) \n" );
}
if ( $count >= $connection_retries[$$self] )
{
lib/Agent/TCLI/Transport/XMPP.pm view on Meta::CPAN
if ( defined( $self->controls ) &&
exists( $self->controls->{ $user->id.'-groupchat' } ) )
{
# should already be logged on?
$self->Verbose("JoinPeerRooms: already connected to ".$user->id ,2);
return;
}
$kernel->yield('JoinChatRoom',
$user->get_name, # room name
$user->get_domain, # server
$user->password, # secret
)
}
}
}
sub JoinChatRoom {
my ($kernel, $self, $room, $server, $secret) =
@_[KERNEL, OBJECT, ARG0, ARG1, ARG2];
$self->Verbose("JoinChatroom: $room at $server ",2);
$self->xmpp->MUCJoin(
'room' => $room,
'server' => $server,
'nick' => $self->jid->GetUserID,
'password' => defined($secret) ? $secret : undef,
);
}
sub Login {
my ($kernel, $self, ) =
@_[KERNEL, OBJECT, ];
my $txt = '';
# make connection
lib/Agent/TCLI/Transport/XMPP.pm view on Meta::CPAN
return;
}
if ($msg->DefinedX('jabber:x:delay') )
{
$self->Verbose("recvmsgGroupchat: delayed message, ignoring \n",2);
return;
}
# # The server will hold older messages. We need to ignore these.
# # Giving a 10 second window for past.
# my $msgtime = str2time( $msg->GetTimeStamp );
# $self->Verbose("recvmsgGroupchat: ts (".$msg->GetTimeStamp.") msgtime (".$msgtime.") time(".time().") ");
# if ( $msgtime < time - 10 )
# {
# $self->Verbose("recvmsgGroupchat: ignoring past messages \n");
# return;
# }
my $control = $self->GetControlForNode( $msg );
return unless $control;
t/TCLI.Package.Tail.t view on Meta::CPAN
$t->ok( 'log "'.$function.' 1 test pass"'); # 1 0 0
$t->ok( 'log "'.$function.' 2 test 2pass"'); # 1 1
$test_master->done(31, "finish testing $function" );
#$t->ok('show active');
#print $test_master->get_responses('',5);
#$t->ok('show test_queue');
#print $t->get_responses('',5);
#$verbose = 0;
# the first pass should remove 4 lines before the second sees them
$function = "max_lines simultaneously passing, line cache";
$t->ok( 'log "'.$function.' 1 test 2pass"'); # 1 1
$t->ok( 'log "'.$function.' 2 test pass"'); # 2 1
$t->ok( 'log "'.$function.' 3 test"'); # 3 2
$t->ok( 'log "'.$function.' 4 test"'); # 4 3
$t->ok( 'log "'.$function.' 5 test pass"'); # 5 3
$t->ok( 'log "'.$function.' 6 test pass"'); # 6 3
$t->ok( 'log "'.$function.' 7 test 2pass"'); # 7 4
$t->ok( 'log "'.$function.' 8 test pass"'); # 8 4
$t->ok( 'log "'.$function.' 9 test 2pass"'); # 5
( run in 0.779 second using v1.01-cache-2.11-cpan-39bf76dae61 )