File Coverage

blib/lib/Test/TAP/Model.pm

Criterion	Covered	Total	%
statement	110	116	94.8
branch	19	24	79.1
condition	11	20	55.0
subroutine	34	35	97.1
pod	23	25	92.0
total	197	220	89.5

#!/usr/bin/perl

package Test::TAP::Model;
use base qw/Test::Harness::Straps/;

use strict;
use warnings;

use Test::TAP::Model::File;

use List::Util qw/sum/;

our $VERSION = "0.10";

# callback handlers
sub _handle_bailout {
	my($self, $line, $type, $totals) = @_;

	$self->log_event(
		type => 'bailout',
		($self->{bailout_reason}
			? (reason => $self->{bailout_reason})
			: ()
		),
	);

	$self->{meat}{test_files}[-1]{results} = $totals;

	die "Bailed out"; # catch with an eval { }
}

sub _handle_test {
	my($self, $line, $type, $totals) = @_;
	my $curr = $totals->seen || 0;

	# this is used by pugs' Test.pm, it's rather useful
	my $pos;
	if ($line =~ /^(.*?) (\r?$|\s*#.*\r?$)/){
		$line = $1 . $3;
		$pos = $2;
	}

	my %details = %{ $totals->details->[-1] };

	$self->log_event(
		type      => 'test',
		num       => $curr,
		ok        => $details{ok},
		actual_ok => $details{actual_ok},
		str       => $details{ok} # string for people
		             	? "ok $curr/" . $totals->max
		             	: "NOK $curr",
		todo      => ($details{type} eq 'todo'),
		skip      => ($details{type} eq 'skip'),

		reason    => $details{reason}, # if at all

		# pugs aux stuff
		line      => $line,
		pos       => $pos,
	);

	if( $curr > $self->{'next'} ) {
		$self->latest_event->{note} =
			"Test output counter mismatch [test $curr]\n";
	}
	elsif( $curr < $self->{'next'} ) {
		$self->latest_event->{note} = join("",
			"Confused test output: test $curr answered after ",
					  "test ", ($self->{'next'}||0) - 1, "\n");
	}
}

sub _handle_other {
	my($self, $line, $type, $totals) = @_;

	my $last_test = $self->{meat}{test_files}[-1];
	if (@{ $last_test->{events} ||= [] } > 0) {
		($self->latest_event->{diag} ||= "") .= "$line\n";
	} else {
		($last_test->{pre_diag} ||= "") .= "$line\n";
	}
}

sub new_with_tests {
	my $pkg = shift;
	my @tests = @_;

	my $self = $pkg->new;
	$self->run_tests(@tests);

	$self;
}

sub new_with_struct {
	my $pkg = shift;
	my $meat = shift;

	my $self = $pkg->new(@_);
	$self->{meat} = $meat; # FIXME - the whole Test::Harness::Straps model can be figured out from this

	$self;
}

sub structure {
	my $self = shift;
	$self->{meat};
}

# just a dispatcher for the above event handlers
sub _init {
	my $s = shift;

	$s->{callback} = sub {
		my($self, $line, $type, $totals) = @_;

		my $meth = "_handle_$type";
		$self->$meth($line, $type, $totals) if $self->can($meth);
	};

	$s->SUPER::_init( @_ );
}

sub log_time {
	my $self = shift;
	$self->{log_time} = shift if @_;
	$self->{log_time};
}

sub log_event {
	my $self = shift;
	my %event = (($self->log_time ? (time => time) : ()), @_);

	push @{ $self->{events} }, \%event;

	\%event;
}

sub latest_event {
	my($self) = shift;
        my %event = @_;
        $self->{events}[-1] || $self->log_event(%event);
}

sub run {
	my $self = shift;
	$self->run_tests($self->get_tests);
}

sub get_tests {
	die 'the method get_tests is a stub. You must implement it yourself if you want $self->run to work.';
}

sub run_tests {
	my $self = shift;

	$self->_init;

	$self->{meat}{start_time} = time;

	foreach my $file (@_) {
		$self->run_test($file);
	}

	$self->{meat}{end_time} = time;
}

sub run_test {
	my $self = shift;
	my $file = shift;

	my $test_file = $self->start_file($file);

	my $results = eval { $self->analyze_file($file) } || Test::Harness::Results->new;
	$test_file->{results} = $results;
	$test_file->{results}->details(undef); # we don't need that

	$test_file;
}

sub start_file {
	my $self = shift;
	my $file = shift;

	push @{ $self->{meat}{test_files} }, my $test_file = {
		file => $file,
		events => ($self->{events} = []),
	};

	$test_file;
}

sub file_class { "Test::TAP::Model::File" }

sub test_files {
	my $self = shift;
	@{$self->{_test_files_cache} ||= [ $self->get_test_files ]};
}

sub get_test_files {
	my $self = shift;
	map { $self->file_class->new($_) } @{ $self->{meat}{test_files} };
}

sub ok { $_->ok or return for $_[0]->test_files; 1 }; *passed = \&ok; *passing = \&ok;
sub nok { !$_[0]->ok }; *failing = \&nok; *failed = \&nok;
sub total_ratio { return $_ ? $_[0]->total_passed / $_ : ($_[0]->ok ? 1 : 0) for $_[0]->total_seen }; *ratio = \&total_ratio;
sub total_percentage { sprintf("%.2f%%", 100 * $_[0]->total_ratio) }
sub total_seen { sum map { scalar $_->seen } $_[0]->test_files }
sub total_todo { sum map { scalar $_->todo_tests } $_[0]->test_files }
sub total_skipped { sum map { scalar $_->skipped_tests } $_[0]->test_files }
sub total_passed { sum map { scalar $_->ok_tests } $_[0]->test_files }; *total_ok = \&total_passed;
sub total_failed { sum map { scalar $_->nok_tests } $_[0]->test_files }; *total_nok = \&total_failed;
sub total_unexpectedly_succeeded { sum map { scalar $_->unexpectedly_succeeded_tests } $_[0]->test_files }

sub summary {
	my $self = shift;
	$self->{_summary} ||=
	sprintf "%d test cases: %d ok, %d failed, %d todo, "
			."%d skipped and %d unexpectedly succeeded",
			map { my $m = "total_$_"; $self->$m }
			qw/seen passed failed todo skipped unexpectedly_succeeded/;
}

__PACKAGE__

__END__