File Coverage

blib/lib/TAP/Formatter/TextMate.pm

Criterion	Covered	Total	%
statement	51	58	87.9
branch	11	14	78.5
condition	4	6	66.6
subroutine	12	14	85.7
pod	3	3	100.0
total	81	95	85.2

package TAP::Formatter::TextMate;

use warnings;
use strict;
use Carp;
use TAP::Formatter::TextMate::Session;

our $VERSION = '0.1';
use base 'TAP::Formatter::Console';

=head1 NAME

TAP::Formatter::TextMate - Generate TextMate compatible test output

=head1 VERSION

This document describes TAP::Formatter::TextMate version 0.1

=head1 SYNOPSIS

Create a TextMate command that looks something like this:

    test=''
    opts='-rb'
    if [ ${TM_FILEPATH:(-2)} == '.t' ] ; then
        test=`echo $TM_FILEPATH | perl -pe "s{^$TM_PROJECT_DIRECTORY/+}{}"`
        opts='-b'
    fi
    cd $TM_PROJECT_DIRECTORY && prove --merge --formatter TAP::Formatter::TextMate $opts $test

=head1 DESCRIPTION

Generates TextMate compatible HTML test output.

=head1 INTERFACE

=head2 C

Called by Test::Harness before any test output is generated.

=cut

sub prepare {
    my ( $self, @tests ) = @_;

    my $html = $self->_html;

    $self->_raw_output(
        $html->open( 'html' ),
        $html->head( [ \'style', $self->_stylesheet ] ),
        $html->open( 'body' ), "\n"
    );

    $self->SUPER::prepare( @tests );
}

=head3 C

Called to create a new test session.

=cut

sub open_test {
    my ( $self, $test, $parser ) = @_;

    my $session = TAP::Formatter::TextMate::Session->new(
        {
            name      => $test,
            formatter => $self,
            parser    => $parser
        }
    );

    $session->header;

    return $session;
}

=head3 C

  $harness->summary( $aggregate );

C prints the summary report after all tests are run.  The argument is
an aggregate.

=cut

sub summary {
    my ( $self, $aggregate ) = @_;
    my $html = $self->_html;
    $self->SUPER::summary( $aggregate );
    $self->_raw_output( $html->close( 'body' ), $html->close( 'html' ), "\n" );
}

sub _html {
    my $self = shift;
    return $self->{_html} ||= HTML::Tiny->new;
}

sub _set_colors {
    my $self = shift;
    # red white on_blue reset
    for my $col ( @_ ) {
        if ( $col =~ /on_(\w+)/ ) {
            $self->{_bg} = $1;
        }
        elsif ( $col eq 'reset' ) {
            $self->{_fg} = $self->{_bg} = undef;
        }
        else {
            $self->{_fg} = $col;
        }
    }
}

sub _newline {
    my $self = shift;
    $self->_output( "\n" ) if $self->{_nl};
}

sub _output {
    my $self = shift;
    my $out  = join( '', @_ );
    my $html = $self->_html;
    my $br   = $html->br;
    my $hr   = $html->hr;
    $self->{_nl} = substr( $out, -1 ) ne "\n";
    $out =~ s/\r//g;
    if ( $out =~ /^[\s-]+$/ ) {
        $out =~ s/-{5,}\s*/$hr/g;
    }
    else {
        $out = $html->entity_encode( $out );
    }
    $out =~ s/\n/$br\n/g;
    my ( $bg, $fg ) = ( $self->{_bg}, $self->{_fg} );

    if ( $bg || $fg ) {
        my @style = ();
        push @style, 'color: ' . $fg            if $fg;
        push @style, 'background-color: ' . $bg if $bg;
        $out = $html->span( { style => join( ';', @style ) }, $out );
    }
    $self->_raw_output( $out );
}

sub _raw_output {
    my $self = shift;
    print join '', @_;
}

sub _stylesheet {
    return <

body, html {
    color: green;
    background-color: black;
    font-family: monospace;
}

.fail {
    color: red;
    background: #222;
}

CSS
}

1;
__END__