Timeout results from the CPAN

Timeout

Agent-TCLI

view release on metacpan or search on metacpan

lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN

A hash keyed on request_id to hold responses when multiple responses per request are expected.
B<responses> will only contain hash values.

=cut
my @responses		:Field
					:Type('hash')
					:Arg('name'=>'responses', 'default'=> { } )
					:Acc('responses');

=item responses_max_contiguous

This field hold a numeric value corellating to the response ID of the
maximum response received that had at least one response received
for all previous requests.
B<responses_max contiguous> will only contain numeric values.

=cut
my @responses_max_contiguous	:Field
					:Type('numeric')
					:Arg('name'=>'responses_max_contiguous', 'default'=> 1)
					:Acc('responses_max_contiguous');


=item dispatch_counter

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');


=item timeout_counter

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');

=item timeout_id

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

Internally used when building a new test to check what the last testee was.
B<last_testee> will only contain scalar values.

=cut
my @last_testee		:Field
#					:Type('scalar')
					:Arg('name'=>'last_testee','default'=>'')
					:Acc('last_testee');

=item dispatch_id

Holds the POE event ID for the Dispatch so it can be rescheduled.
B<dispatch_id> should only contain scalar values.

=cut
my @dispatch_id			:Field
#					:Type('scalar')
					:All('dispatch_id');

# Standard class utils are inherited

=back

=head2 METHODS

Most of these methods are for internal use within the TCLI system and may
be of interest only to developers trying to enhance TCLI.

lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN

			next TEST;
		}

		# any other test must fail if there is no response

		$self->builder->ok( 0, $test->[3] );
		$self->builder->diag("Response not recieved for this test's request.");

	}

	if ( defined($name) && $name ne '' )
	{
		$test_count[$$self]++;
		$self->builder->ok( $ready, $name );
	}
	$self->Verbose($self->alias.":done: ready($ready) ");

	return ($ready);
}


=item load_testee ( <testee> )

The preferred way to load a testee is to set 'test_master' when the testee is
created. Testee will then call this function on initializtion. A testee is
an Agent::TCLI::Testee object.

=cut

sub load_testee {
	my ($self, $testee) = @_;
#func#	my $self = ( ref $_[0] && (ref $_[0]) =~ /Agent::TCLI::.*TEST/ )
#func#		? shift : $TCLI_TEST;
	$self->Verbose($self->alias.":load_testee: dump ".$testee->dump(1),3);

	$self->push_testees($testee);
}

=item run

B<run> is called at the end of the test script. It will call POE::Kernel->run
to finish off all of the requests. Other POE event handlers will ensure that all
queued requests are dispatched and all requests dispatched are completed.

Running does not take any parameters and does not return anything.

=cut

sub run {
	my $self = shift;
	$self->Verbose($self->alias.":run: running (".$self->depth_requests.") requests " );

	# requests still left in queue (How could there not be?)
	if ( $self->depth_requests > 0 )
	{
		# Whatever's left in the queue is bigger than us little synchronous
		# calls. Send it over to the big Dispatch.
		$poe_kernel->post($self->alias, 'Dispatch', 1 );
	}

	# set running state for Timeout.
	$self->running(1);

	$poe_kernel->run;
}

=item preinit

This private Object::InsideOut (OIO) method is used for object initialization.

=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
        	    Timeout
        	)],
        ],
  	);

	$args->{'peers'} = [ Agent::TCLI::User->new({
		'id'		=> 'test-master@localhost',
		'protocol'	=> 'test',
		'auth'		=> 'master',
	})] unless defined($args->{'peers'});

	$args->{'do_verbose'} = sub { diag( @_ ) } unless defined($args->{'do_verbose'});

}

=item _init

This private OIO method is used for object initialization.

=cut

sub _init :Init {
	my ($self, $args) = @_;

	$self->set(\@default_request, Agent::TCLI::Request->new({
		'id'		=> 1,
#		'args'		=> ,
#		'command'	=> ,
		'sender'	=> [$self->alias],
		'postback'	=> ['PostResponse'],
		'input'		=> '',

		'response_verbose' 	=> 1,  # Must be set to get test back with response
		'verbose'			=> $self->verbose,
		'do_verbose'		=> $self->do_verbose,
	})) unless defined( $self->default_request );

	$self->control_options->{'local_address'} = '127.0.0.1'
		unless defined($self->control_options->{'local_address'});

	# Load up control now, before requests come in, since we must be local
	# if loading packages.
	# Get a Control for the test-master user loaded into peers.
	$self->GetControl(	$self->peers->[0]->id, $self->peers->[0] );

	# Get the packages and control going but come back for the requests.
	$poe_kernel->run_one_timeslice;
}

=item build_test

This object method is used to build the test, as a Agent::TCLI::Request, and put it
on the queue. It is called by the Testee. Some of this functionality may be
pushed to the Testee soon, so expect this API to change.

=cut

sub build_test {
	my ($self, $testee, $test, $input, $exp1, $exp2, $name) = @_;
	$self->Verbose($self->alias.":build_test: testee(".$testee->addressee.
		")\n\t test($test) input($input)\n\t exp($exp1)",1);

lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN

sub SendRequest {
	my ($kernel,  $self, $sender, $request) =
  	  @_[KERNEL, OBJECT,  SENDER, 	ARG0  ];
	$self->Verbose($self->alias.":SendRequest: sender(".$sender->ID.") request(".$request->id.") \n");
	$self->Verbose($self->alias.":SendRequest: request dump \n",3,$request);

	# send request
		# Need to think about sender stack...

		# if there is nothing on the stack, it get's populated with
		# test and posted to control.

		# if another transport is on the stack, it puts itself on the bottom?
		# Then sends it to the local transport for handling.

		# The local transport will send it to the remote transport, putting
		# itself (the local) on the stack as well. No, it needs to take off the remote when it sends it there.

		# we're not via headers here. We just need to know where to go
		# Transport should take themselves out and put in where they got the request
		# so it can go back.


	# 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
	{
		$self->Verbose($self->alias.":SendRequest: punting the request \n");
		# Take off Sender and postback and put us at the end.
		# assuming here that wherever this is going, we don't have to
		# worry about setting up the Control....
		my $sender = $request->shift_sender;
		my $postback = $request->shift_postback;
		$request->push_sender($self->alias);
		$request->push_postback('PostResponse');

		$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.") ");

	# Is Dispatch done with the queue?
	# We wait until running before using an empty queue as goood enough.
	if ( ( $self->running && $self->depth_requests == 0 ) ||
		$dispatch_counter[$$self] == $dispatch_retries[$$self] )
	{
		if ( $request_count[$$self] == $requests_complete[$$self] ||
			 $timeout_counter[$$self] == $timeout_retries[$$self] )
		{
			$kernel->yield('_shutdown');
			return;
		}
		else
		{
			$kernel->delay( 'Timeout', $delay, $delay, );
			$timeout_counter[$$self]++;
		}
	}
	# Dispatch now taking care of requests still in queue and we'll just wait until
	# it is done.
	else
	{
		$kernel->delay( 'Timeout', $delay, $delay, );
	}
}

=item GetControl ( id )

Inherited from Agent::TCLI::Trasnport::Base

=cut

=item _shutdown

Shutdown begins the shutdown of all child processes.

=cut

sub _shutdown :Cumulative {
    my ($kernel,  $self, $session) =
    @_[KERNEL, OBJECT,  SESSION];
	$self->Verbose($self->alias.':_shutdown:');

	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
	# 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 {
	my ($kernel, $session, $self) = @_[KERNEL, SESSION, OBJECT];
	$self->Verbose($self->alias.":".":stop session stopped...\n" );

	# did we send all requests?
	$self->builder->is_num( $self->depth_requests, 0,
		$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

Eric Hacker	 hacker can be emailed at cpan.org

=head1 BUGS

There is no separation between users running tests, which means it
could be very ugly to have multiple users try to run tests on one TCLI Agent.

Test scripts not thorough enough.

Probably many others.

=head1 LICENSE

Copyright (c) 2007, Alcatel Lucent, All rights resevred.

This package is free software; you may redistribute it
and/or modify it under the same terms as Perl itself.

=cut

( run in 0.395 second using v1.01-cache-2.11-cpan-a5abf4f5562 )