File Coverage

blib/lib/TAP/Formatter/TeamCity.pm

Criterion	Covered	Total	%
statement	15	42	35.7
branch	0	16	0.0
condition	0	2	0.0
subroutine	5	8	62.5
pod	1	1	100.0
total	21	69	30.4

#############################################################################
#      $URL: http://perlcritic.tigris.org/svn/perlcritic/tags/TAP-Formatter-TeamCity-0.04/lib/TAP/Formatter/TeamCity.pm $
#     $Date: 2009-09-09 13:03:47 -0700 (Wed, 09 Sep 2009) $
#   $Author: thaljef $
# $Revision: 3641 $
#############################################################################

package TAP::Formatter::TeamCity;

use strict;
use warnings;

use TeamCity::BuildMessages qw(:all);
use TAP::Formatter::Session::TeamCity;

#-----------------------------------------------------------------------------

use base qw(TAP::Formatter::Base);

#-----------------------------------------------------------------------------

our $VERSION = '0.04';

#-----------------------------------------------------------------------------

my $last_test_name;

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

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


    teamcity_emit_build_message('testSuiteStarted', name => $test);

    while ( defined( my $result = $parser->next() ) ) {
        print $result->comment(), ' ' if $result->is_comment();
        $self->_emit_teamcity_messages($result) if $result->is_test();
        $session->result($result);
    }

    teamcity_emit_build_message('testFinished', name => $last_test_name) if $last_test_name;
    teamcity_emit_build_message('testSuiteFinished', name => $test);

    return $session;
}

#-----------------------------------------------------------------------------

sub _emit_teamcity_messages {
    my ($self, $result) = @_;

    # First, close out the last test, if there was one...
    teamcity_emit_build_message('testFinished', name => $last_test_name) if $last_test_name;
    my $test_name = $result->description() || 'No test name given';
    $test_name =~ s{\A \s* - \s+}{}mx;

    # Now start this test and evaluate the results...
    teamcity_emit_build_message('testStarted', captureStandardOutput => 'true', name => $test_name);
    $self->_emit_teamcity_test_results($test_name, $result);

    $last_test_name = $test_name;

    return;
}

#-----------------------------------------------------------------------------

sub _emit_teamcity_test_results {
    my ($self, $test_name, $test) = @_;

    my $expl = $test->explanation();
    my %message = $expl ? (message => $expl) : ();
    my %args = (name => $test_name, %message);

    if ( $test->has_todo() ) {
        teamcity_emit_build_message('testIgnored', %args);
    }
    elsif ( $test->has_skip() ) {
        teamcity_emit_build_message('testIgnored', %args);
    }
    elsif ( not $test->is_ok() ) {
        teamcity_emit_build_message('testFailed', %args);
    }

    return;
}

#-----------------------------------------------------------------------------
1;

=pod

=head1 NAME

TAP::Formatter::TeamCity - Emit test results as TeamCity service messages

=head1 SYNOPSIS

   # When using prove(1):
   prove -formatter TAP::Formatter::TeamCity my_test.t

   # From within a Module::Build subclass:
   sub tap_harness_args { return {formatter_class => 'TAP::Formatter::TeamCity'} }

=head1 DESCRIPTION

L is a plugin for L that emits TeamCity
service messages to the console, rather than the usual output.  The TeamCity build
server is able to process these messages in the build log and present your test
results in its web interface (along with some nice statistics and graphs).

This is very much alpha code, and is subject to change.

=head1 SEE IT IN ACTION

If you're not familiar with continuous integration systems (in general) or
TeamCity (in particular), you're welcome to explore the TeamCity build server
we use for the L project.  Just go to
L and click on the "Login as a Guest" link.  From
there, you can browse the build history, review test results, and examine the
artifacts (such as test coverage reports and performance profiles).  All the
information you see there was generated from TAP-based tests using this module
to communicate the results to the TeamCity server.

=head1 SUGGESTED USAGE

The TeamCity service messages are generally not human-readable, so you
probably only want to use this Formatter when the tests are being run by a
TeamCity build agent and the L module is available.
I suggest using an environment variable to activate the Formatter.  If you're
using a recent version of L you might do something like this in
your F file:

  # Regular build configuration here:
  my $builder = Module::Build->new( ... )

  # Specify this Formatter, if the environment variable is set:
  $builder->tap_harness_args( {formatter_class => 'TAP::Formatter::TeamCity'} )
    if $ENV{RUNNING_UNDER_TEAMCITY} && eval {require TAP::Formatter::TeamCity};

  # Generate build script as ususal:
  $builder->create_build_script();

And then set the C environment variable to a true value
in your TeamCity build configuration.

TODO: Figure out if/how to do this with L.

=head1 LIMITATIONS

TeamCity comes from a jUnit culture, so it doesn't understand SKIP and TODO
tests in the same way that Perl testing harnesses do.  Therefore, this formatter
simply instructs TeamCity to ignore tests that are marked SKIP or TODO.

Also, I haven't yet figured out how to transmit test diagnostic messages, so
those probably won't appear in the TeamCity web interface.  But I'm working
on it :)

=head1 SOME EXTRA CANDY

TeamCity, CruiseControl, and some other continuous integration systems are
oriented towards Java code.  As such, they don't have native support for
Perl's customary build tools like L.  But they do have nice
support for running Ant.  This distribution contains an Ant build script at
F which wraps L actions in Ant targets.  This makes
it easier to configure TeamCity and CruiseControl to build your Perl code.  If
you're using the EPIC plug-in with Eclipse, you can also use this Ant script
to build your code from within the IDE.  Feel free to copy the F
into your own projects.

=head1 SEE ALSO

L

=head1 AUTHOR

Jeffrey Ryan Thalhammer

=head1 COPYRIGHT

Copyright (c) 2009 Imaginative Software Systems.  All rights reserved.

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.  The full text of this license
can be found in the LICENSE file included with this module.

=cut


##############################################################################
# Local Variables:
#   mode: cperl
#   cperl-indent-level: 4
#   fill-column: 78
#   indent-tabs-mode: nil
#   c-indentation-style: bsd
# End:
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :