build/jenkins/tap-to-junit-xml - spamassassin - Git at Google

 #!/usr/bin/perl
 =head1 NAME

 tap-to-junit-xml - convert perl-style TAP test output to JUnit-style XML

 =head1 SYNOPSIS

 tap-to-junit-xml "test suite name" [ outputprefix ] < tap_output.log

 =head1 DESCRIPTION

 Parse test suite output in TAP (Test Anything Protocol,
 C<http://testanything.org/>) format, and produce XML output in a similar format
 to that produced by the <junit> ant task.  This is useful for consumption by
 continuous-integration systems like Hudson (C<https://hudson.dev.java.net/>).

 C<"test suite name"> is a descriptive string used as the B<name> attribute on the
 top-level <testsuites> node of the output XML.

 If C<outputprefix> is specified, multi-file output will be generated, with
 multiple XML files created using C<outputprefix> as their start of their
 filenames. This prefix may contain slashes, in which case the files will be
 placed into a directory hierarchy accordingly (although care should be taken to
 ensure these directories exist in advance).

 If C<outputprefix> is not specified, a single XML file will be generated on
 STDOUT.

 =head1 DEPENDENCIES

  TAP::Parser
  Time::HiRes
  XML::Generator

 =head1 BUGS

   - Output is optimized for Hudson, and may not look quite as good in other UIs.
   - Doesn't do anything with the STDERR from tests.
   - Doesn't fill in the 'errors' attribute in the  <testsuite> element.
   - Doesn't handle "todo" or "skip"
   - Doesn't get the elapsed time for each 'test' (i.e. assertion.)

 =head1 AUTHOR

 original, junit_xml.pl, by Matisse Enzer <matisse at matisse.net>; see
 C<http://twoalpha.blogspot.com/2007/01/junit-style-xml-from-perl-test-files.html>.

 pretty much entirely rewritten by Justin Mason <junit at jmason.org>, Feb 2008.

 =head1 VERSION

 Mar 27 2008 jm

 =head1 COPYRIGHT & LICENSE

 Copyright (c) 2007 Matisse Enzer. All Rights Reserved.

 This program is free software; you can redistribute it and/or modify it
 under the same terms as Perl itself.
 =cut

 use strict;
 use warnings;

 my $opt_suitename = shift @ARGV;
 my $opt_multifile = 0;
 my $opt_mfprefix;

 if (defined $ARGV[0]) {
   $opt_multifile = 1;
   $opt_mfprefix = $ARGV[0];
 }

 use TAP::Parser;
 use Time::HiRes qw(gettimeofday tv_interval);
 use XML::Generator qw(:noimport);

 # should the 'Test Summary Report' at the end of a test suite be displayed
 # as if it was a testcase?  in my opinion, no
 my $HIDE_TEST_SUMMARY_REPORT = 1;

 my $suite_name = $opt_suitename || 'make test';
 my $safe_suite_name = $suite_name; $safe_suite_name =~ s/[^-:_A-Za-z0-9]+/_/gs;

 # TODO: it'd be nice to respect 'Universal desirable behavior #1' from
 # http://testanything.org/wiki/index.php/TAP_Consumers -- 'Should work on the
 # TAP as a stream (ie. as each line is received) rather than wait until all the
 # TAP is received'.   But it seems TAP::Parser itself doesn't support it!
 # maybe when TAP::Parser does that, we'll do it too.
 my $tout = join("", <STDIN>);

 my $tap     = TAP::Parser->new( { tap => $tout } );
 my $xmlgen = XML::Generator->new( ':pretty', ':std');
 my $xmlgenunescaped = XML::Generator->new( ':pretty', ':std', 'escape' => 'unescaped');
 my @properties = _get_properties($xmlgen);
 my $test_results = _parse_tests( $tap, $xmlgen );

 if ($opt_multifile) {
   _gen_junit_multifile_xml( $xmlgen, \@properties, $test_results );
 } else {
   print STDOUT _get_junit_xml( $xmlgen, \@properties, $test_results );
 }
 exit;

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

 sub _get_junit_xml {
   my ( $xmlgen, $properties, $test_results ) = @_;
   my $xml = "<?xml version='1.0' encoding='UTF-8' ?>\n" .
           $xmlgen->testsuites({
               name => $suite_name,
             }, @$test_results);
   return $xml;
 }

 sub _gen_junit_multifile_xml {
   my ( $xmlgen, $properties, $test_results ) = @_;
   my $count = 1;
   foreach my $testsuite (@$test_results) {
     open OUT, ">${opt_mfprefix}.${count}.xml"
           or die "cannot write ${opt_mfprefix}-${count}.xml";
     print OUT "<?xml version='1.0' encoding='UTF-8' ?>\n";
     print OUT $testsuite;
     close OUT;
     $count++;
   }
 }

 sub _parse_tests {
   my ( $parser, $xmlgen ) = @_;

   my $ctx = {
     testsuites => [ ],
     test_name => 'notest',
     plan_ntests => 0,
     case_id => 0,
   };

   _new_ctx($ctx);

   my $lastunk = '';

   # unknown t/basic_lint.........
   # plan 1..1
   # comment # Running under perl version 5.008008 for linux
   # comment # Current time local: Thu Jan 24 17:44:30 2008
   # comment # Current time GMT:   Thu Jan 24 17:44:30 2008
   # comment # Using Test.pm version 1.25
   # unknown     /usr/bin/perl -T -w ../spamassassin.raw -C log/test_rules_copy  --siteconfigpath log/localrules.tmp -p log/test_default.cf  -L --lint
   # unknown     Checking anything
   # test ok 1
   # test ok 2
   # unknown t/basic_meta.........
   # plan 1..2
   # comment # Running under perl version 5.008008 for linux
   # comment # Current time local: Thu Jan 24 17:44:31 2008
   # comment # Current time GMT:   Thu Jan 24 17:44:31 2008
   # comment # Using Test.pm version 1.25
   # test not ok 1
   # comment # Failed test 1 in t/basic_meta.t at line 91
   # test ok 2
   # unknown  Failed 1/2 subtests
   # unknown t/basic_obj_api......
   # plan 1..4
   # comment # Running under perl version 5.008008 for linux
   # comment # Current time local: Thu Jan 24 17:44:33 2008
   # comment # Current time GMT:   Thu Jan 24 17:44:33 2008
   # comment # Using Test.pm version 1.25
   # test ok 1
   # test ok 2
   # test ok 3
   # test ok 4
   # test ok 9
   # unknown
   # unknown Test Summary Report
   # unknown -------------------
   # unknown t/basic_meta.t   (Wstat: 0 Tests: 2 Failed: 1)
   # unknown   Failed test:  1
   # unknown Files=3, Tests=7,  6 wallclock secs ( 0.01 usr  0.00 sys +  4.39 cusr  0.23 csys =  4.63 CPU)
   # unknown Result: FAIL
   # unknown Failed 1/3 test programs. 1/7 subtests failed.
   # unknown make: *** [test_dynamic] Error 255

   while ( my $r = $parser->next ) {
     my $t = $r->type;
     my $s = $r->as_string; $s =~ s/\s+$//;

     # warn "JMD $t $s";

     if ($t eq 'unknown') {
       $lastunk = $s;

       # PERL_DL_NONLAZY=1 /usr/bin/perl "-MExtUtils::Command::MM" "-e" "test_harness(1, 'blib/lib', 'blib/arch')" t/basic_*
       # if ($s =~ /test_harness\(.*?\)" (.+)$/) {
       # $suite_name = $1;
       # }
       if ($s =~ /^Test Summary Report$/) {
         # create a <testsuite> block for the summary
         $ctx->{plan_ntests} = 0;
         $ctx->{test_name} = "Test Summary Report";
         $ctx->{case_tests} = 1;
         _finish_test_block($ctx);
       }
       elsif ($s =~ /^Result: FAIL$/) {
         $ctx->{case_tests}++;
         $ctx->{case_failures}++;
         my $test_case = {
             classname => test_name_to_classname($ctx->{test_name}),
             name      => 'result',
             'time'    => 0,
         };
         my $failure = $xmlgen->failure({
           type => "OverallTestsFailed",
           message => $s
         }, "__FAILUREMESSAGETODO__");

         if (!$HIDE_TEST_SUMMARY_REPORT) {
           push @{$ctx->{test_cases}}, $xmlgen->testcase($test_case, $failure);
         }
       }
       elsif ($s =~ /^(\S+?)\.\.\.+1\.\.(\d+?)\s*$/) {
         # perl 5.6.x "Test" format plan line
         # unknown t/basic_lint....................1..1

         my ($name, $nt) = ($1,$2);
         if ($ctx->{plan_ntests}) {       # only if there have been tests planned
           _finish_test_block($ctx);
         }

         $ctx->{plan_ntests} = $nt+0;
         $ctx->{test_name} = "$name.t";
       }
     }
     elsif ($t eq 'plan') {
       if ($ctx->{plan_ntests}) {       # only if there have been tests planned
         _finish_test_block($ctx);
       }

       $ctx->{plan_ntests} = 0;
       $s =~ /(\d+)$/ and $ctx->{plan_ntests} = $1+0;

       $ctx->{test_name} = $lastunk;
       $ctx->{test_name} =~ s/\.*\s*$//gs;
       $ctx->{test_name} .= ".t";
     }
     elsif ($t eq 'test') {
       my $ntest = 0;
       if ($s =~ /(?:not |)\S+ (\d+)/) { $ntest = $1+0; }

       if ($ntest > $ctx->{plan_ntests}) {
         # jump in test numbers, more than planned; this is probably TAP::Parser's wierdness.
         # (when it sees the "ok" line at the end of a test case with no number,
         # it outputs the current total number of tests so far.)
         next;
       }

       # clean this up in a Hudson-compatible way; ":" and "/" are out, "." also causes
       # trouble by creating an extra "directory" in the results

       my $test_case = {
           classname => test_name_to_classname($ctx->{test_name}),
           name      => sprintf("test %6d", $ntest), # space-padding ensures ordering
           'time'    => 0,
       };

       $ctx->{case_tests}++;
       my $failure = undef;
       if ($s =~ /^not /i) {
         $ctx->{case_failures}++;
         $failure = $xmlgen->failure({
           type => "TAPTestFailed",
           message => $s
         }, "__FAILUREMESSAGETODO__");
         push @{$ctx->{test_cases}}, $xmlgen->testcase($test_case, $failure);
       }
       else {
         push @{$ctx->{test_cases}}, $xmlgen->testcase($test_case);
       }
     }

     $ctx->{sysout} .= $s."\n";
   }

   if (scalar(@{$ctx->{test_cases}}) == 0 &&
       scalar(@{$ctx->{testsuites}}) == 0)
   {
     # no tests found! create a <testsuite> block containing *something* at least
     $ctx->{case_tests}++;
     my $test_case = {
         classname => test_name_to_classname($ctx->{test_name}),
         name      => 'result',
         'time'    => 0,
     };
     push @{$ctx->{test_cases}}, $xmlgen->testcase($test_case);
   }

   _finish_test_block($ctx);
   return $ctx->{testsuites};
 }

 sub _new_ctx {
   my $ctx = shift;
   $ctx->{start_time} = [gettimeofday];
   $ctx->{test_cases} = [];
   $ctx->{case_tests} = 0;
   $ctx->{case_failures} = 0;
   $ctx->{case_time} = 0;
   $ctx->{case_id}++;
   $ctx->{sysout} = '';
   return $ctx;
 }

 sub _finish_test_block {
   my $ctx = shift;
   $ctx->{sysout} =~ s/\n\S+\.*\s*\n$/\n/s;       # remove next test's "t/foo....." line

   my $elapsed_time = 0;     # TODO
   #my $elapsed_time = tv_interval( $ctx->{start_time}, [gettimeofday] );

   # clean it up to valid Java packagename format (or at least something Hudson will
   # consume)
   my $name = $ctx->{test_name};
   $name =~ s/[^-:_A-Za-z0-9]+/_/gs;
   $name = "$safe_suite_name.$name";      # a "directory" for the suite name

   my $testsuite = {
       'time'         => $elapsed_time,
       'name'         => $name,
       tests          => $ctx->{case_tests},
       failures       => $ctx->{case_failures},
       'id'           => $ctx->{case_id},
       errors         => 0,
   };

   my @fixedcases = ();
   foreach my $tc (@{$ctx->{test_cases}}) {
     if ($tc =~ s/__FAILUREMESSAGETODO__/ cdata($ctx->{sysout}) /ges) {
       push @fixedcases, \$tc;       # inhibits escaping!
     } else {
       push @fixedcases, $tc;
     }
   }

   # use "unescaped"; we have already fixed escaping on these strings.
   # note that a reference means 'this is unescaped', bizarrely.
   push @{$ctx->{testsuites}}, $xmlgenunescaped->testsuite($testsuite,
           @fixedcases,
           \("<system-out>\n".cdata($ctx->{sysout})."\n</system-out>"),
           \("<system-err />"));

   _new_ctx($ctx);
 };

 sub cdata {
   my $s = shift;
   $s =~ s/\]\]>/\](warning: defanged by tap-to-junit-xml)\]>/gs;
   return '<![CDATA['.$s.']]>';
 }

 sub _get_properties {
     my $xmlgen = shift;
     my @props;
     foreach my $key ( sort keys %ENV ) {
         push @props, $xmlgen->property( { name => "$key", value => $ENV{$key} } );
     }
     return @props;
 }

 sub test_name_to_classname {
   my $safe = shift;
   $safe =~ s/[^-:_A-Za-z0-9]+/_/gs;
   $safe = "$safe_suite_name.$safe";      # a "directory" for the suite name
   $safe;
 }

 __END__

 # JUnit references:
 # http://www.nabble.com/JUnit-4-XML-schematized--td13946472.html
 # http://jra1mw.cvs.cern.ch:8180/cgi-bin/jra1mw.cgi/org.glite.testing.unit/config/JUnitXSchema.xsd?view=markup
 # skipped tests:
 # https://hudson.dev.java.net/issues/show_bug.cgi?id=1251
 # Hudson source:
 # http://fisheye5.cenqua.com/browse/hudson/hudson/main/core/src/main/java/hudson/tasks/junit/CaseResult.java
	#!/usr/bin/perl
	=head1 NAME

	tap-to-junit-xml - convert perl-style TAP test output to JUnit-style XML

	=head1 SYNOPSIS

	tap-to-junit-xml "test suite name" [ outputprefix ] < tap_output.log

	=head1 DESCRIPTION

	Parse test suite output in TAP (Test Anything Protocol,
	C<http://testanything.org/>) format, and produce XML output in a similar format
	to that produced by the <junit> ant task. This is useful for consumption by
	continuous-integration systems like Hudson (C<https://hudson.dev.java.net/>).

	C<"test suite name"> is a descriptive string used as the B<name> attribute on the
	top-level <testsuites> node of the output XML.

	If C<outputprefix> is specified, multi-file output will be generated, with
	multiple XML files created using C<outputprefix> as their start of their
	filenames. This prefix may contain slashes, in which case the files will be
	placed into a directory hierarchy accordingly (although care should be taken to
	ensure these directories exist in advance).

	If C<outputprefix> is not specified, a single XML file will be generated on
	STDOUT.

	=head1 DEPENDENCIES

	TAP::Parser
	Time::HiRes
	XML::Generator

	=head1 BUGS

	- Output is optimized for Hudson, and may not look quite as good in other UIs.
	- Doesn't do anything with the STDERR from tests.
	- Doesn't fill in the 'errors' attribute in the <testsuite> element.
	- Doesn't handle "todo" or "skip"
	- Doesn't get the elapsed time for each 'test' (i.e. assertion.)

	=head1 AUTHOR

	original, junit_xml.pl, by Matisse Enzer <matisse at matisse.net>; see
	C<http://twoalpha.blogspot.com/2007/01/junit-style-xml-from-perl-test-files.html>.

	pretty much entirely rewritten by Justin Mason <junit at jmason.org>, Feb 2008.

	=head1 VERSION

	Mar 27 2008 jm

	=head1 COPYRIGHT & LICENSE

	Copyright (c) 2007 Matisse Enzer. All Rights Reserved.

	This program is free software; you can redistribute it and/or modify it
	under the same terms as Perl itself.
	=cut

	use strict;
	use warnings;

	my $opt_suitename = shift @ARGV;
	my $opt_multifile = 0;
	my $opt_mfprefix;

	if (defined $ARGV[0]) {
	$opt_multifile = 1;
	$opt_mfprefix = $ARGV[0];
	}

	use TAP::Parser;
	use Time::HiRes qw(gettimeofday tv_interval);
	use XML::Generator qw(:noimport);

	# should the 'Test Summary Report' at the end of a test suite be displayed
	# as if it was a testcase? in my opinion, no
	my $HIDE_TEST_SUMMARY_REPORT = 1;

	my $suite_name = $opt_suitename \|\| 'make test';
	my $safe_suite_name = $suite_name; $safe_suite_name =~ s/[^-:_A-Za-z0-9]+/_/gs;

	# TODO: it'd be nice to respect 'Universal desirable behavior #1' from
	# http://testanything.org/wiki/index.php/TAP_Consumers -- 'Should work on the
	# TAP as a stream (ie. as each line is received) rather than wait until all the
	# TAP is received'. But it seems TAP::Parser itself doesn't support it!
	# maybe when TAP::Parser does that, we'll do it too.
	my $tout = join("", <STDIN>);

	my $tap = TAP::Parser->new( { tap => $tout } );
	my $xmlgen = XML::Generator->new( ':pretty', ':std');
	my $xmlgenunescaped = XML::Generator->new( ':pretty', ':std', 'escape' => 'unescaped');
	my @properties = _get_properties($xmlgen);
	my $test_results = _parse_tests( $tap, $xmlgen );

	if ($opt_multifile) {
	_gen_junit_multifile_xml( $xmlgen, \@properties, $test_results );
	} else {
	print STDOUT _get_junit_xml( $xmlgen, \@properties, $test_results );
	}
	exit;

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

	sub _get_junit_xml {
	my ( $xmlgen, $properties, $test_results ) = @_;
	my $xml = "<?xml version='1.0' encoding='UTF-8' ?>\n" .
	$xmlgen->testsuites({
	name => $suite_name,
	}, @$test_results);
	return $xml;
	}

	sub _gen_junit_multifile_xml {
	my ( $xmlgen, $properties, $test_results ) = @_;
	my $count = 1;
	foreach my $testsuite (@$test_results) {
	open OUT, ">${opt_mfprefix}.${count}.xml"
	or die "cannot write ${opt_mfprefix}-${count}.xml";
	print OUT "<?xml version='1.0' encoding='UTF-8' ?>\n";
	print OUT $testsuite;
	close OUT;
	$count++;
	}
	}

	sub _parse_tests {
	my ( $parser, $xmlgen ) = @_;

	my $ctx = {
	testsuites => [ ],
	test_name => 'notest',
	plan_ntests => 0,
	case_id => 0,
	};

	_new_ctx($ctx);

	my $lastunk = '';

	# unknown t/basic_lint.........
	# plan 1..1
	# comment # Running under perl version 5.008008 for linux
	# comment # Current time local: Thu Jan 24 17:44:30 2008
	# comment # Current time GMT: Thu Jan 24 17:44:30 2008
	# comment # Using Test.pm version 1.25
	# unknown /usr/bin/perl -T -w ../spamassassin.raw -C log/test_rules_copy --siteconfigpath log/localrules.tmp -p log/test_default.cf -L --lint
	# unknown Checking anything
	# test ok 1
	# test ok 2
	# unknown t/basic_meta.........
	# plan 1..2
	# comment # Running under perl version 5.008008 for linux
	# comment # Current time local: Thu Jan 24 17:44:31 2008
	# comment # Current time GMT: Thu Jan 24 17:44:31 2008
	# comment # Using Test.pm version 1.25
	# test not ok 1
	# comment # Failed test 1 in t/basic_meta.t at line 91
	# test ok 2
	# unknown Failed 1/2 subtests
	# unknown t/basic_obj_api......
	# plan 1..4
	# comment # Running under perl version 5.008008 for linux
	# comment # Current time local: Thu Jan 24 17:44:33 2008
	# comment # Current time GMT: Thu Jan 24 17:44:33 2008
	# comment # Using Test.pm version 1.25
	# test ok 1
	# test ok 2
	# test ok 3
	# test ok 4
	# test ok 9
	# unknown
	# unknown Test Summary Report
	# unknown -------------------
	# unknown t/basic_meta.t (Wstat: 0 Tests: 2 Failed: 1)
	# unknown Failed test: 1
	# unknown Files=3, Tests=7, 6 wallclock secs ( 0.01 usr 0.00 sys + 4.39 cusr 0.23 csys = 4.63 CPU)
	# unknown Result: FAIL
	# unknown Failed 1/3 test programs. 1/7 subtests failed.
	# unknown make: *** [test_dynamic] Error 255

	while ( my $r = $parser->next ) {
	my $t = $r->type;
	my $s = $r->as_string; $s =~ s/\s+$//;

	# warn "JMD $t $s";

	if ($t eq 'unknown') {
	$lastunk = $s;

	# PERL_DL_NONLAZY=1 /usr/bin/perl "-MExtUtils::Command::MM" "-e" "test_harness(1, 'blib/lib', 'blib/arch')" t/basic_*
	# if ($s =~ /test_harness\(.*?\)" (.+)$/) {
	# $suite_name = $1;
	# }
	if ($s =~ /^Test Summary Report$/) {
	# create a <testsuite> block for the summary
	$ctx->{plan_ntests} = 0;
	$ctx->{test_name} = "Test Summary Report";
	$ctx->{case_tests} = 1;
	_finish_test_block($ctx);
	}
	elsif ($s =~ /^Result: FAIL$/) {
	$ctx->{case_tests}++;
	$ctx->{case_failures}++;
	my $test_case = {
	classname => test_name_to_classname($ctx->{test_name}),
	name => 'result',
	'time' => 0,
	};
	my $failure = $xmlgen->failure({
	type => "OverallTestsFailed",
	message => $s
	}, "__FAILUREMESSAGETODO__");

	if (!$HIDE_TEST_SUMMARY_REPORT) {
	push @{$ctx->{test_cases}}, $xmlgen->testcase($test_case, $failure);
	}
	}
	elsif ($s =~ /^(\S+?)\.\.\.+1\.\.(\d+?)\s*$/) {
	# perl 5.6.x "Test" format plan line
	# unknown t/basic_lint....................1..1

	my ($name, $nt) = ($1,$2);
	if ($ctx->{plan_ntests}) { # only if there have been tests planned
	_finish_test_block($ctx);
	}

	$ctx->{plan_ntests} = $nt+0;
	$ctx->{test_name} = "$name.t";
	}
	}
	elsif ($t eq 'plan') {
	if ($ctx->{plan_ntests}) { # only if there have been tests planned
	_finish_test_block($ctx);
	}

	$ctx->{plan_ntests} = 0;
	$s =~ /(\d+)$/ and $ctx->{plan_ntests} = $1+0;

	$ctx->{test_name} = $lastunk;
	$ctx->{test_name} =~ s/\.\s$//gs;
	$ctx->{test_name} .= ".t";
	}
	elsif ($t eq 'test') {
	my $ntest = 0;
	if ($s =~ /(?:not \|)\S+ (\d+)/) { $ntest = $1+0; }

	if ($ntest > $ctx->{plan_ntests}) {
	# jump in test numbers, more than planned; this is probably TAP::Parser's wierdness.
	# (when it sees the "ok" line at the end of a test case with no number,
	# it outputs the current total number of tests so far.)
	next;
	}

	# clean this up in a Hudson-compatible way; ":" and "/" are out, "." also causes
	# trouble by creating an extra "directory" in the results

	my $test_case = {
	classname => test_name_to_classname($ctx->{test_name}),
	name => sprintf("test %6d", $ntest), # space-padding ensures ordering
	'time' => 0,
	};

	$ctx->{case_tests}++;
	my $failure = undef;
	if ($s =~ /^not /i) {
	$ctx->{case_failures}++;
	$failure = $xmlgen->failure({
	type => "TAPTestFailed",
	message => $s
	}, "__FAILUREMESSAGETODO__");
	push @{$ctx->{test_cases}}, $xmlgen->testcase($test_case, $failure);
	}
	else {
	push @{$ctx->{test_cases}}, $xmlgen->testcase($test_case);
	}
	}

	$ctx->{sysout} .= $s."\n";
	}

	if (scalar(@{$ctx->{test_cases}}) == 0 &&
	scalar(@{$ctx->{testsuites}}) == 0)
	{
	# no tests found! create a <testsuite> block containing something at least
	$ctx->{case_tests}++;
	my $test_case = {
	classname => test_name_to_classname($ctx->{test_name}),
	name => 'result',
	'time' => 0,
	};
	push @{$ctx->{test_cases}}, $xmlgen->testcase($test_case);
	}

	_finish_test_block($ctx);
	return $ctx->{testsuites};
	}

	sub _new_ctx {
	my $ctx = shift;
	$ctx->{start_time} = [gettimeofday];
	$ctx->{test_cases} = [];
	$ctx->{case_tests} = 0;
	$ctx->{case_failures} = 0;
	$ctx->{case_time} = 0;
	$ctx->{case_id}++;
	$ctx->{sysout} = '';
	return $ctx;
	}

	sub _finish_test_block {
	my $ctx = shift;
	$ctx->{sysout} =~ s/\n\S+\.\s\n$/\n/s; # remove next test's "t/foo....." line

	my $elapsed_time = 0; # TODO
	#my $elapsed_time = tv_interval( $ctx->{start_time}, [gettimeofday] );

	# clean it up to valid Java packagename format (or at least something Hudson will
	# consume)
	my $name = $ctx->{test_name};
	$name =~ s/[^-:_A-Za-z0-9]+/_/gs;
	$name = "$safe_suite_name.$name"; # a "directory" for the suite name

	my $testsuite = {
	'time' => $elapsed_time,
	'name' => $name,
	tests => $ctx->{case_tests},
	failures => $ctx->{case_failures},
	'id' => $ctx->{case_id},
	errors => 0,
	};

	my @fixedcases = ();
	foreach my $tc (@{$ctx->{test_cases}}) {
	if ($tc =~ s/__FAILUREMESSAGETODO__/ cdata($ctx->{sysout}) /ges) {
	push @fixedcases, \$tc; # inhibits escaping!
	} else {
	push @fixedcases, $tc;
	}
	}

	# use "unescaped"; we have already fixed escaping on these strings.
	# note that a reference means 'this is unescaped', bizarrely.
	push @{$ctx->{testsuites}}, $xmlgenunescaped->testsuite($testsuite,
	@fixedcases,
	\("<system-out>\n".cdata($ctx->{sysout})."\n</system-out>"),
	\("<system-err />"));

	_new_ctx($ctx);
	};

	sub cdata {
	my $s = shift;
	$s =~ s/\]\]>/\](warning: defanged by tap-to-junit-xml)\]>/gs;
	return '<![CDATA['.$s.']]>';
	}

	sub _get_properties {
	my $xmlgen = shift;
	my @props;
	foreach my $key ( sort keys %ENV ) {
	push @props, $xmlgen->property( { name => "$key", value => $ENV{$key} } );
	}
	return @props;
	}

	sub test_name_to_classname {
	my $safe = shift;
	$safe =~ s/[^-:_A-Za-z0-9]+/_/gs;
	$safe = "$safe_suite_name.$safe"; # a "directory" for the suite name
	$safe;
	}

	__END__

	# JUnit references:
	# http://www.nabble.com/JUnit-4-XML-schematized--td13946472.html
	# http://jra1mw.cvs.cern.ch:8180/cgi-bin/jra1mw.cgi/org.glite.testing.unit/config/JUnitXSchema.xsd?view=markup
	# skipped tests:
	# https://hudson.dev.java.net/issues/show_bug.cgi?id=1251
	# Hudson source:
	# http://fisheye5.cenqua.com/browse/hudson/hudson/main/core/src/main/java/hudson/tasks/junit/CaseResult.java