File Coverage

blib/lib/Test/TAP/HTMLMatrix.pm

Criterion	Covered	Total	%
statement	94	107	87.8
branch	16	28	57.1
condition	0	4	0.0
subroutine	32	34	94.1
pod	19	20	95.0
total	161	193	83.4

#!/usr/bin/perl

package Test::TAP::HTMLMatrix;

use strict;
use warnings;

use Test::TAP::Model::Visual;
use Test::TAP::Model::Consolidated;
use Petal;
use Petal::Utils qw/:logic/;
use Carp qw/croak/;
use File::Spec;
use File::Path;
use URI::file;

use overload '""' => "html";

our $VERSION = "0.09";

sub new {
	my ( $pkg, @models ) = @_;

	my $ext = pop @models unless eval { $models[-1]->isa("Test::TAP::Model") };

	@models || croak "must supply a model to graph";

	my $self = bless {}, $pkg;

	$self->model(@models);
	$self->extra($ext);

	$self;
}

sub title { "TAP Matrix - " . gmtime() . " GMT" }

sub tests {
	my $self = shift;
	[ sort { $a->name cmp $b->name } $self->model->test_files ];
}

sub model {
	my $self = shift;
	if (@_) {
		$self->{model} = $_[0]->isa("Test::TAP::Model::Consolidated")
			? shift
			: Test::TAP::Model::Consolidated->new(@_);
	}

	$self->{model};
}

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

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

	Petal->new(
		file => File::Spec->abs2rel($file), # damn petal requires rel path
		input => "XHTML",
		output => "XHTML",

		encode_charset => "utf8",
		decode_charset => "utf8",
	);
}

sub html {
	my $self = shift;
	$self->detail_html;
}

sub detail_html {
	my $self = shift;
	$self->template_to_html($self->detail_template);
}

sub summary_html {
	my $self = shift;
	$self->template_to_html($self->summary_template);
}

sub output_dir {
	my $self = shift;
	my $dir  = shift || die "You need to specify a directory";

	mkpath $dir or die "can't create directory '$dir': $!" unless -e $dir;

	local $self->{_css_uri} = "htmlmatrix.css";

	my %outputs = (
		"summary.html" => $self->summary_html,
		"detail.html" => $self->detail_html,
		( $self->has_inline_css ? () : "htmlmatrix.css" => $self->_slurp_css ),
	);

	foreach my $file ( keys %outputs ) {
		open my $fh, ">", File::Spec->catfile( $dir, $file ) or die "can't open '$file' for writing: $!";
		print $fh $outputs{$file};
		close $fh or die "can't close '$file'";
	}
}

sub template_to_html {
	my $self = shift;
	my $path = shift;
	$self->process_petal($self->petal($path));
}

sub process_petal {
	my $self = shift;
	my $petal = shift;
	$petal->process(page => $self);
}

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

	foreach my $str (grep { not ref } @INC){
		my $target = File::Spec->catfile($str, $file);
		return $target if -e $target;
	}

	die "couldn't find $file in \@INC";
}

sub _find_in_my_INC {
	my $self = shift;
	$self->_find_in_INC(File::Spec->catfile(split("::", __PACKAGE__), shift));
}

sub detail_template {
	my $self = shift;
	$self->_find_in_my_INC("detailed_view.html");
}

sub summary_template {
	my $self = shift;
	$self->_find_in_my_INC("summary_view.html");
}

sub css_file {
	my $self = shift;
	$self->_find_in_my_INC("htmlmatrix.css");
}

sub css_uri {
	my $self = shift;
	$self->{_css_uri} || URI::file->new($self->css_file);
}

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

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

sub has_javascript {
	my $self = shift;
	!$self->no_javascript;
}

sub _slurp_css {
	my $self = shift;
	local $/;
	open my $fh, $self->css_file or die "open: " . $self->css_file. ": $!";
	<$fh>;
}

sub inline_css {
	my $self = shift;
	"\n/\n";
}

__PACKAGE__

__END__