view release on metacpan or  search on metacpan

lib/Agent/TCLI/Package/Tail.pm  view on Meta::CPAN

					:Arg('name'=>'tests_complete','default'=>0)
					:Acc('tests_complete');

=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 this module.

=over

=item Append <input>, <wheel_id>

This POE Event handler receives the tail events and creates the
line objects to insert into the line_cache.  It typically
accepts events from POE::Wheel::FollowTail. It may also be
called directly from another POE Session, in which case only
the input to be logged should be provided. It will insert the
sending POE Session as the line->source if no wheel_id is provided.

=cut

sub Append {
    my ($kernel,   $self, $sender, $input, $wheel_id) =
      @_[KERNEL,  OBJECT,  SENDER,  ARG0,      ARG1];

	# This and Log are virtually identical. Maybe merge someday?

	return unless defined $input;

	# assign source to either a wheel or another POE session
	my $source = defined($wheel_id)
		? $self->GetWheelKey($wheel_id, 'source')
		: $sender ;

	$self->Verbose("append: input(".$input.") from ".$source, 2 );

	$line_count[$$self]++;

	my $type = ref($input);
	$type = "line" if ($type  eq '');

	# push line onto cache
	$self->push_line_cache( Agent::TCLI::Package::Tail::Line->new(
		'input'			=>	$input,
		'count'			=>  $line_count[$$self],
		'birth_time'	=>  time(),
		'ttl'			=>  time()+ $self->line_hold_time,
		'source'		=>	$source,
		'type'			=>	$type,
	 ));

	# remove first-in line if total line count exceeded.
	if ( $self->depth_line_cache > $self->line_max_cache )
	{
		$self->Verbose('Too many lines, removing...');
		shift ( @{$self->line_cache} );
	}

	# post new event to active states
	foreach my $state ( sort keys %{$self->active} )
	{
		$kernel->yield( $state => 'Append', $self->line_count );
	}
}

=item Activate

This POE event handler activates tests in the queue by registering an
event with SimpleLog and creating an event handler.
This whole process is currently ineffecient and will hopefully get
redone sometime.

=cut

sub Activate {
   my ($kernel,   $self,  ) =
      @_[KERNEL,  OBJECT,  ];

	my $counter = $self->activated_count;

	$self->Verbose('Activate: counter('.$counter.')  ',2);

	# remember that counter is an array index and is one less than the size...
	if ($self->depth_test_queue == 0 || $counter >= $self->depth_test_queue )
	{
		$kernel->delay('Activate',$self->interval );
		return('nothing activated');
	}

	my $test = $self->test_queue->[$counter];
	$self->Verbose('Activate: counter('.$counter.')  dump ',4,$self->test_queue);
	$self->Verbose('Activate: test_num('.$test->num.')  dump '.$test->dump(1),4);

	$self->increment_activated_count;

	$kernel->delay('Activate',$self->interval );

	my $num = $test->num;

	#put into active list
	$self->active->{$num} = $test;

	# set up test TTL. We add the time so that we now know the exact
	# expiration of this event.
	# Note that a sufficiently large number for TTL could get a test to last
	# for years...
	$test->increment_ttl( time() ) if ( $test->ttl != 0 );

	$self->Verbose('Activate: counter('.$counter.') time('.time().') test dump ',3,$test );

	# Set up state to receive an event for this test
	$kernel->state( $num => $self => $test->handler );
	$self->Verbose('Activate: state('.$num.') handler('.$test->handler.')',1);

	# kick off state to process cache
	$kernel->yield( $num );

	return('activated '.$num );
}

=item Check

The POE event handler is what does the actual test/watch on the line
objects.

=cut

sub Check {
    my ($kernel,   $self, $sender, $session, $state ) =
      @_[KERNEL,  OBJECT,  SENDER,  SESSION,  STATE ];

    # Note the right now we're ignoring the ARGS which has the
    # Line number, since we keep track of that in each test.
    # The line number is not supplied if we're processing the cache
    # This might be used for optimization in the future

	$self->Verbose('Check: state('.$state.') lines('.$self->depth_line_cache.
		') completed('.$self->tests_complete.') ',1);
	$self->Verbose('Check: state('.$state.') test queue dump ',5,$self->test_queue );

	# OK, so I actually had a bug where I created a Check event with no event name.
	return unless defined ($state);

	my $test = $self->test_queue->[$state -1];
	$self->Verbose('Check: state('.$state.') test dump ',4,$test );

	# Catch any events posted after this test completed
	return if ( $test->complete );

	# if ordered, make sure previous test has completed
	# BUG This only works if all previous tests are ordered.
	# Though it mostly does it right.
	$self->Verbose('Check: ordered('.$test->ordered.') state('.$state.
		') previous complete('.$self->test_queue->[$state - 2]->complete.
		') complete('.$self->tests_complete.')',1);

	if ( $test->ordered && ( $state > 1 ) &&
		 !$self->test_queue->[$state - 2]->complete
	)
	{
		$self->Verbose('Check: state('.$state.') ordered is on, previous not complete.');
		return;
	}

	# Get time here so that all checking uses same time
	my $time = time();

	my ($because, $comment, $code, $input, $matchline);
	my $ok;

	#loop over line of input (in order)
	my $line_index = 0;
	LINE: while ( $line_index < @{$line_cache[$$self]} )
	{
		my $line = $self->line_cache->[$line_index];
		$ok = 0;
		$self->Verbose('Check: state('.$state.') LINE dump  ',4,$line );
		# if line.index_counter > test.index_counter
		# this is a line we haven't checked out
		$self->Verbose('Check: num('.$test->num.') $line->count('.$line->count.
			') $test->last_line('.$test->last_line.')', 1 - $test->verbose );
		if ($line->count > $test->last_line )
		{
			$input = $line->input;
	    	# get test
			$code = $test->code;

			$self->Verbose('Check: state('.$state.') input('.$input.
				') $code->($input) = ('.$code->( $input ).')',2);
			$self->Verbose('Check: num('.$test->num.') input('.$input.
 				   ') $code->($input) = ('.$code->( $input ).')',0)
 				   if ($test->verbose);

			# remove line if match, increment count
			if ( $code->( $input ) )
			{
				$ok = 1;
				$test->increment_match_count;
				# TODO insert optional line pruning...
				$matchline = splice( @{$self->line_cache}, $line_index, 1 );
				$self->Verbose("Check: lc(".$line->count.") ok($ok".
					") li($line_index) matchline ".$matchline->dump(1),2 )
 				   if ($test->verbose);
			}
#			$self->Verbose('Check: in loop('.$line->count.') ( test dump ',2,$test );

    		# set test.index_counter to line's
    		$test->last_line ($line->count);

			$test->increment_line_count;

			# report line if feedback and match or verbose
			if ($test->feedback && ( $ok || $test->verbose) )
			{
				$test->request->Respond( $kernel, $input, 200);
			}

			$self->Verbose('Check: num('.$test->num.') line_count('.
				$test->line_count.') max_lines('.$test->max_lines.
				") passed(".$test->match_count.") last_line{".
				$test->last_line.')',0 )
 				if ($test->verbose);

			# check if we passed enough times
			if ( $ok && $test->match_count == $test->match_times )
			{
				$self->Verbose('Check: passed, skipping rest of lines',2);
				$test->success(1);
				last LINE;
			}

			#check lines_seen and indicate failed test if necessary
			if ( ( $test->max_lines != 0 &&
				$test->line_count >= $test->max_lines) )
			{
				$self->Verbose('Check: fail state('.$state.') TEST dump ',2,$test );
				$because .= "Seen too many lines. Saw (".$test->line_count.") max(".
					$test->max_lines.") passed(".$test->match_count.") \n".
					"Last line: ".$input;
				last LINE;
			}
		}
		# if it passed, we took out the line, so don't increment.
		$line_index++ unless($ok);
	}

#	$self->Verbose('Check: post loop state('.$state.') test dump ',2,$test );
#	$self->Verbose('Check: post loop $ok('.$ok.') matchline',2,$matchline);

	if ( ($test->match_times != 0) && ($test->match_count == $test->match_times) )
	{
		$kernel->call($self->name => 'Complete' => $state => 'ok' );
		$test->complete(1);
	}
	# check clock and fail test if necessary
	elsif ( ( $test->ttl != 0 ) && ( $time > $test->ttl ) )
	{
		$because .= "Timer expired. Time(".$time.")  TTL(".$test->ttl.
			") Diff(".($test->ttl - $time).")";
	}

	if ( ($test->match_times != 0) && $because && not $test->success )
	{
		$self->Verbose("Check: failing ok($ok) because'$because'");

		$kernel->call($self->name => 'Complete' =>  $state => 'not ok' => $because );
		$test->complete(1);
	}

	# if we're done, clean up
	if ( $test->complete )
	{
		# remove the test from active list
		delete($self->active->{$test->num});

		# remove the session state
		$self->Verbose('Complete: removing: state('.$test->num.')',1);
		$kernel->state( $state );
	}
}

=item Complete

This POE event handler handles the response when a test/watch
is complete.

=cut

sub Complete {
    my ($kernel,   $self, $session, $state, $result, $because ) =
      @_[KERNEL,  OBJECT,  SESSION,   ARG0,	   ARG1,     ARG2 ];
	$self->Verbose("Complete: state(".$state.") result(".$result.
		") ");

	my $test = $self->test_queue->[$state -1];
	$self->Verbose('Check: state('.$state.') test dump ',4,$test );
	my $request = $test->request;

	my ($txt, $code);
	if ( $result eq 'ok' )
	{
		$test->success(1);
		$txt = 'ok  '.$test->name;
		$code = 200;
	}
	elsif ( $result eq 'not ok')
	{
		# TODO. Need a better way of returning the because for diagnostics?