Support for 'make junitfiles' target.

The Perl XML::Generator module must be installed to use this.

configure/CONFIG_BASE

@@ -66,6 +66,7 @@ DBTOMENUH                  = $(call PATH_FILTER, $(TOOLS)/dbToMenuH$(HOSTEXE))
 REGISTERRECORDDEVICEDRIVER = $(PERL) $(TOOLS)/registerRecordDeviceDriver.pl
 CONVERTRELEASE             = $(PERL) $(call FIND_TOOL,convertRelease.pl)
 FULLPATHNAME               = $(PERL) $(TOOLS)/fullPathName.pl
+TAPTOJUNIT                 = $(PERL) $(TOOLS)/tap-to-junit-xml.pl
 
 #-------------------------------------------------------
 # tools for installing libraries and products

configure/CONFIG_SITE

@@ -121,11 +121,10 @@ CROSS_COMPILER_TARGET_ARCHS=
 #
 CROSS_COMPILER_HOST_ARCHS=
 
-#  The 'make runtests' and 'make tapfiles' build targets normally only run
+#  The 'runtests', 'tapfiles' and 'junitfiles' make targets normally only run
 #  self-tests for the EPICS_HOST_ARCH architecture. If the host can execute
 #  the self-test programs for any other cross-built architectures such as
-#  a -debug architecture, those architectures can be named here.
+#  a -debug architecture, those architectures must be named in this variable:
-#
 CROSS_COMPILER_RUNTEST_ARCHS=
 
 #  Build shared libraries?

configure/RULES.Db

@@ -134,7 +134,7 @@ ACTIONS += build
 ACTIONS += install
 ACTIONS += buildInstall
 ACTIONS += browse
-ACTIONS += runtests tapfiles
+ACTIONS += runtests tapfiles junitfiles
 
 actionArchTargets = $(foreach x, $(ACTIONS),\ $(foreach arch,$(BUILD_ARCHS), $(x)$(DIVIDER)$(arch)))
 

configure/RULES_ARCHS

@@ -14,7 +14,7 @@ ACTIONS += build
 ACTIONS += install
 ACTIONS += buildInstall
 ACTIONS += browse
-ACTIONS += runtests tapfiles
+ACTIONS += runtests tapfiles junitfiles
 #ACTIONS += rebuild
 
 actionArchTargets = $(foreach action, $(ACTIONS), \

configure/RULES_BUILD

@@ -101,6 +101,7 @@ endif
 ifneq (,$(findstring $(T_A),$(EPICS_HOST_ARCH) $(CROSS_COMPILER_RUNTEST_ARCHS)))
 RUNTESTS_ENABLED = YES
 TAPFILES += $(TESTSCRIPTS:.t=.tap)
+JUNITFILES += $(TAPFILES:.tap=.xml)
 endif
 
 #---------------------------------------------------------------
@@ -148,7 +149,7 @@ clean::
 	$(INC) $(TARGETS) $(DLL_LINK_LIBNAME) $(TDS) \
 	*.out MakefileInclude  $(LOADABLE_SHRLIBNAME) *.manifest *.exp \
 	$(COMMON_INC) $(HDEPENDS_FILES) $(PRODTARGETS) \
-	$(TESTSCRIPTS) $(TAPFILES)
+	$(TESTSCRIPTS) $(TAPFILES) $(JUNITFILES)
 ifdef RES
 	@$(RM) *$(RES)
 endif
@@ -354,6 +355,7 @@ testspec: $(TESTSCRIPTS)
 	$(if $(TESTSPEC_$(OS_CLASS)), @echo "Harness: $(TESTSPEC_$(OS_CLASS))" >> $@)
 
 tapfiles: $(TESTSCRIPTS) $(TAPFILES)
+junitfiles: $(JUNITFILES)
 
 # A .tap file is the output from running the associated test script
 %.tap: %.t
@@ -361,6 +363,9 @@ ifdef RUNTESTS_ENABLED
 	-$(PERL) $< -tap > $@
 endif
 
+%.xml: %.tap
+	$(TAPTOJUNIT) --puretap --output $@ --input $< $*
+
 # If there's a perl test script (.plt) available, use it
 %.t: ../%.plt
 	@$(RM) $@
@@ -494,7 +499,8 @@ $(INSTALL_TEMPLATES_SUBDIR)/%: %
 .PRECIOUS: $(COMMON_INC)
 
 .PHONY: all inc build install clean rebuild buildInstall
-.PHONY: runtests checkRelease warnRelease noCheckRelease
+.PHONY: runtests tapfiles junitfiles
+.PHONY: checkRelease warnRelease noCheckRelease
 
 endif # BASE_RULES_BUILD
 #	EOF RULES_BUILD

configure/RULES_DIRS

@@ -9,7 +9,7 @@
 
 ARCHS += $(BUILD_ARCHS)
 ACTIONS += inc build install buildInstall clean realclean archclean
-ACTIONS += runtests tapfiles
+ACTIONS += runtests tapfiles junitfiles
 
 dirActionArchTargets = $(foreach dir, $(DIRS), \
     $(foreach action, $(ACTIONS), \

configure/RULES_TOP

@@ -58,6 +58,7 @@ help:
 	@echo "                      Cannot be used within an O.<arch> dir"
 	@echo "     rebuild        - Same as clean install"
 	@echo "     archclean      - Removes O.<arch> dirs but not O.Common dir"
+	@echo "     runtests       - Run self-tests, summarize results"
 	@echo "\"Partial\" build targets supported by Makefiles:"
 	@echo "     inc$(DIVIDER)<arch>     - Installs <arch> only header files."
 	@echo "     build$(DIVIDER)<arch>   - Builds and installs <arch> only."

documentation/RELEASE_NOTES.html

@@ -13,6 +13,15 @@
 
 <!-- Insert new items immediately below here ... -->
 
+
+<h3>Self-test JUnit XML Output</h3>
+
+<p>This release adds a new make target <tt>junitfiles</tt> which if necessary
+runs the self-tests and then converts the TAP (Perl Test-Anything-Protocol)
+output files (as generated by the <tt>tapfiles</tt> target) into the more
+commonly-recognized JUnit XML format. The program that performs this conversion
+needs the Perl module <q><tt>XML::Generator</tt></q> to have been installed.</p>
+
 <h3>Fix DNS related crash on exit</h3>
 
 <p>The attempt to fix DNS related delays for short lived CLI programs (eg. caget)

src/tools/Makefile

@@ -29,6 +29,7 @@ PERL_SCRIPTS += makeTestfile.pl
 PERL_SCRIPTS += mkmf.pl
 PERL_SCRIPTS += munch.pl
 PERL_SCRIPTS += replaceVAR.pl
+PERL_SCRIPTS += tap-to-junit-xml.pl
 PERL_SCRIPTS += useManifestTool.pl
 
 include $(TOP)/configure/RULES

src/tools/tap-to-junit-xml.pl

@@ -0,0 +1,546 @@
+#!/usr/local/bin/perl
+=head1 NAME
+
+tap-to-junit-xml - convert perl-style TAP test output to JUnit-style XML
+
+=head1 SYNOPSIS
+
+tap-to-junit-xml [--help|--man]
+                [--[no]hidesummary]
+                [--input <tap input file>]
+                [--output <junit output file>]
+                [--puretap]
+                [<test suite name>] [outputprefix]
+
+=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. Defaults to "make test".
+
+If C<outputprefix> is specified, multi-file output will be generated, with
+multiple XML files created using C<outputprefix> as the start of their
+filenames. The files are separated by testplan.  This option is ignored
+if --puretap is specified (TAP only allows one testplan per input file).
+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 --input I<file name> is not specified, STDIN will be read.
+If C<outputprefix> or --output is not specified, a single XML file will be
+generated on STDOUT.
+
+--output I<file name> is used to write a single XML file to I<file name>.
+
+--puretap parses a single TAP source and handles parse errors and directives
+(todo, skip, bailout).  --puretap ignores unknown (non-TAP) input. Without
+--puretap, the script will parse some additional non-TAP test input, such as
+Perl tests that can include a "Test Summary Report", but it won't generate
+correct XML unless the TAP testplan comes before the test cases.
+--hidesummary report (the default) will hide the summary report, --no-hidesummary
+will display it (neither has an effect when --puretap is specified).
+
+=head1 EXAMPLE
+
+    prove -v 2>&1 | tee tests.log
+    tap-to-junit-xml "make test" testxml/tests < tests.log
+
+(JUnit-formatted XML is now in "testxml/tests*.xml".)
+
+=head1 DEPENDENCIES
+
+ Getopt::Long
+ Pod::Usage
+ 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.
+   (--puretap handles parse errors)
+ - Doesn't handle "todo" or "skip" (--puretap does)
+  - Doesn't get the elapsed time for each 'test' (i.e. assertion.)
+   (TAP output has no elapsed time convention).
+
+=head1 SOURCE
+
+http://github.com/jmason/tap-to-junit-xml/tree/master
+
+=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.
+
+Miscellaneous fixes and mods (--puretap) by Jascha Lee <jascha at yahoo-inc.com>, Mar 2009.
+
+=head1 VERSION
+
+ Mar 27 2008 jm
+ Mar 17 2009 jl
+
+=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;
+
+use Getopt::Long qw(:config no_ignore_case);
+use Pod::Usage;
+use TAP::Parser;
+use Time::HiRes qw(gettimeofday tv_interval);
+use XML::Generator qw(:noimport);
+
+my %opts;
+pod2usage() unless GetOptions( \%opts, 'help|h',
+                                      'hidesummary!',
+                                      'input=s',
+                                      'man',
+                                      'output=s',
+                                      'puretap'
+                            );
+
+pod2usage(-verbose => 1) if defined $opts{'help'};
+pod2usage(-verbose => 2) if defined $opts{'man'};
+
+my $opt_suitename = shift @ARGV;
+my $opt_multifile = 0;
+my $opt_mfprefix;
+
+if (defined $ARGV[0]) {
+  $opt_multifile = 1;
+  $opt_mfprefix = $ARGV[0];
+}
+
+# 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 = defined $opts{'hidesummary'} ? $opts{'hidesummary'} : 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 $tapfh;
+if ( defined $opts{'input'} ) {
+   open $tapfh, '<', $opts{'input'} or die "Can't open TAP file '$opts{'input'}': $!\n";
+}
+else {
+   $tapfh = \*STDIN;
+}
+
+my $outfh;
+if ( defined $opts{'output'} ) {
+   open $outfh, '>', $opts{'output'} or die "Can't open output file '$opts{'output'}' for writing: $!\n";
+}
+else {
+   $outfh = \*STDOUT;
+}
+
+my $tap             = TAP::Parser->new( { source => $tapfh } );
+my $xmlgen          = XML::Generator->new( ':pretty');
+my $xmlgenunescaped = XML::Generator->new( escape      => 'unescaped',
+                                          conformance => 'strict',
+                                          pretty      => 2
+                                        );
+my @properties = _get_properties($xmlgen);
+if ( defined $opts{'puretap'} ) {
+   #
+   # Instead of trying to parse everything in one pass, which fails if the
+   # testplan is last, parse through the results for the test cases and
+   # then construct the <testsuite> information from the TAP and wrap it
+   # around the test cases. Ignore 'unknown' information.  [JL]
+   #
+   my @testcases = _parse_testcases( $tap, $xmlgen );
+   errorOut( $tap, $xmlgen ) if $tap->parse_errors;
+   print $outfh $xmlgen->testsuites(
+                   $xmlgen->testsuite( { name     => $safe_suite_name,
+                                         tests    => $tap->tests_planned,
+                                         failures => scalar $tap->failed,
+                                         errors   => 0,
+                                         time     => 0,
+                                         id       => 1 },
+                                         @testcases ));
+
+}
+else {
+   my $test_results    = _parse_tests( $tap, $xmlgen );
+   if ($opt_multifile) {
+  _gen_junit_multifile_xml( $xmlgen, \@properties, $test_results );
+   } else {
+       print $outfh _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++;
+  }
+}
+
+#
+# Wrap up parse errors and output them as test cases.
+#
+sub errorOut {
+   my $parser = shift;
+   my $xmlgen = shift;
+   die "errorOut() needs some args"  unless $parser and $xmlgen;
+   my ($xml, @errors, $name);
+   my $count = 1;
+   foreach my $error ( $parser->parse_errors ) {
+       $name = sprintf "%s%02d", 'Error_', $count++;
+       $xml  = $xmlgen->testcase( { name      => $name,
+                                    classname => 'TestsNotRun.ParseError',
+                                    time      => 0 },
+
+                   $xmlgen->error( { type    => 'TAPParseError',
+                                     message => $error } ));
+       push @errors, $xml;
+   }
+   print $outfh $xmlgen->testsuites(
+                   $xmlgen->testsuite( { name     => 'TestsNotRun.ParseError',
+                                         tests    => $tap->tests_planned,
+                                         failures => 0,
+                                         errors   => scalar $tap->parse_errors,
+                                         time     => 0,
+                                         id       => 1 },
+                                         @errors ));
+   exit 86;
+}
+
+#
+# Construct an array of XML'd test cases
+#
+sub _parse_testcases {
+   my $parser = shift;
+   my $xmlgen = shift;
+   return () unless $parser and $xmlgen;
+   my ($name, $directive, $xml, @testcases);
+
+   while ( my $result = $parser->next ) {
+       if ( $result->is_bailout ) {
+           $xml  = $xmlgen->testcase( { name      => 'BailOut',
+                                        classname => "$safe_suite_name.Tests",
+                                        time      => 0 },
+
+                       $xmlgen->error( { type    => 'BailOut',
+                                         message => $result->explanation } ));
+
+           push @testcases, $xml;
+           last;
+       }
+       next unless $result->is_test;
+       $directive = $result->directive;
+       $name = sprintf "%s%02d", 'Test_', $result->number;
+       $name .= "_$directive" if $directive;
+       if ( $result->is_ok ) {
+           $xml = $xmlgen->testcase( { name      => $name,
+                                       classname => "$safe_suite_name.Tests",
+                                       time      => 0 } );
+           push @testcases, $xml;
+       }
+       else {
+           $xml = $xmlgen->testcase( { name      => $name,
+                                       classname => "$safe_suite_name.Tests",
+                                       time      => 0 },
+                      $xmlgen->failure( { type    => 'TAPTestFailed',
+                                          message => $result->as_string } ));
+           push @testcases, $xml;
+       }
+   }
+
+   return @testcases;
+}
+
+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