view release on metacpan or  search on metacpan

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

	$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