Subversion Repositories DevTools

########################################################################
# Copyright (C) 2010 ERG Limited, All rights reserved
#
# Module name   : jats_utf_ant.pl
# Module type   : Makefile system
# Compiler(s)   : Perl
# Environment(s): jats
#
# Description   : Jats utility to read Ant test result output files and
#                 reformats them into standard XML for JATS to import
#                 into the Release Manager database.
#
# Usage         : perl jats_utf_ant.pl [-h] [-v] -o <folder> -t <target>
#
#......................................................................#

require 5.006_001;   # to remain compatible with installed per version
use diagnostics;
use strict;
use warnings;

use Pod::Usage;
use Getopt::Long;
use Time::HiRes;
use File::Find;
use File::Spec;
use XML::Simple;
use Cwd;

use JatsError;
use JatsVersionUtils;
use JatsRmApi;
use JatsSystem;

my $VERSION = "1.0.0"; # Update this every time this file changes

#   Run main() with the command line arguments unless
#   we're being used by a 'require'
main(@ARGV) unless caller;

#------------------------------------------------------------------------------
# Function    : main
#
# Description : The main-line as a function
#               Making main a subroutine allows me to test all
#               the others without running main
#
#               Because this is MAIN the indentation rule is 
#               violated and all lines are unindented by one
#               indentation level
#
#               Processes any result files from Junit as run by ANT.
#
#               These result files are named 'Test-<name>.xml' or 'TEST-<name>.xml.
#
#               Parse these files and extract the pass/fail information as
#               well as details for failed tests. This information is written,
#               as XML, to the output folder specified with the -o switch. The
#               files are named <Target>-<Time>.xml, where <Target> is
#               specified using the -t switch, and <Time> is the current unix
#               time to 5 decimal places with the decimal point removed. e.g.
#               Win32-141860573651218.xml
#
#               The output XML file looks like:
#
# <TestResults>
#   <!-- a passed test is a self closing TestResult -->
#   <TestResult DURATION="0.01" NAME="java.path::method" OUTCOME="PASS" />
#   <!-- a failed test has a closing tag and some content -->
#   <TestResult DURATION="0.01" NAME="java.path::method" OUTCOME="FAILURE">
#     some
#     text
#     denoting
#     a stack dump
#     or other
#     details
#   </TestResult>
#   <!-- an errored test has a closing tag and some content -->
#   <TestResult DURATION="0.01" NAME="java.path::method" OUTCOME="ERROR">
#     some
#     text
#     denoting
#     a stack dump
#     or other
#     details
#   </TestResult>
# </TestResults>
#
# Inputs      : ARGV (see above)
#
# Output      : The standard XML format file for JATS to read
#
# Returns     : 0 - there were some failed tests
#               1 - all tests passed
#
sub main {

#   Start of broken indentation convention

our ($opt_help, $opt_verbose, $opt_outFolder, $opt_target);
$opt_help = 0;
$opt_verbose = 0;

my $result = GetOptions (
    "help|h:+"          => \$opt_help,
    "verbose|v:+"       => \$opt_verbose,
    "out|o=s"           => \$opt_outFolder,
    "target|t=s"        => \$opt_target,
);

#
#   Process help and manual options
#
pod2usage(-verbose => 0, -message => "Version: $VERSION")  if ($opt_help == 1);
pod2usage(-verbose => 1)  if ($opt_help == 2);
pod2usage(-verbose => 2)  if ($opt_help > 2);

#
#   Configure the error reporting process now that we have the user options
#
ErrorConfig( 'name'    =>'UTF_ANT',
             'verbose' => $opt_verbose );

#   Set defaults and error checking
$opt_outFolder = '.' unless ($opt_outFolder);
Error ("Must specify a target platform (e.g. -t 'WIN32')") unless($opt_target);
Error ("Output Folder \'$opt_outFolder\' does not exist") unless (-d $opt_outFolder);

return doMain($opt_verbose, $opt_outFolder, $opt_target);

#   End of broken indentation convention
}

#------------------------------------------------------------------------------
# Function    : doMain
#
# Description : perform the actions required by this module as described above
#
# Inputs      : $outFolder - the folder wehre to place the output XML file.
#               $target - the target platform name.
#                         This is used in generating the output file name as
#                         described above.
#
# Output      : The result XML file.
#
# Returns     : 0 - some tests failed
#               1 - all tests passed
#
sub doMain {
    my ($verbose, $outFolder, $target) = @_;

    # derive filename here to prevent File::Find from messing with it
    my $outfile = outputFilename($verbose, $outFolder, $target);

    my ($passed, @instance) = createBuildInstance($verbose, $target);
    outputJatsXmlFile($verbose, $outfile, @instance);
    return $passed;
}

#------------------------------------------------------------------------------
# Function    : outputJatsXmlFile
#
# Description : Write the result structure to the output XML file.
#
# Inputs      : $output_folder - where to put the output file.
#               $target - the target platforn, used to construct the output
#                         filename.
#               @instance - the results read from the Ant file.
#
# Output      : The result XML file.
#
# Returns     : The filename of the output file.
#
sub outputJatsXmlFile {
    my ($verbose, $filename, @instance) = @_;
    my %xml;

    #   Each element in @instance is put into a <TestResult> XML element
    @{$xml{TestResult}} = @instance;
    #   The 'MESSAGE' key for failed tests forms the content of the
    #   <TestResult> element. Other keys are converted to attributes.
    #   Assign <TestResults> as the root XMl node.
    my $xmlData = XMLout(\%xml, ContentKey => 'MESSAGE', RootName => 'TestResults');

    #   Write the data to the XML file.
    open ( my $outFile, ">", $filename)
        || Error(" Cannot open results file:$filename for writing: $!\n");
    print $outFile $xmlData;
    return $filename;
}

#------------------------------------------------------------------------------
# Function    : createBuildInstance
#
# Description : Reads an Ant test results file and returns an array with an
#               entry per test. Each entry is a Hash as described below.
#
# Inputs      : $target - the build target platform. Cannot be undef
#
# Output      : None
#
# Returns     : A pair of values ($passed, $test_results)
#               $passed - 1 if there were no failed tests
#                         0 if there were failed tests
#               @test_results - A data structure consisting of an array of
#                               hashes
#                               Each entry in the hash holds:
#                   NAME - the class and method name of the test (or as
#                          much information as is necessary to uniquely
#                          identify the test)
#                   OUTCOME - one of 'UNKNOWN', 'PASS', 'FAIL', 'ERROR'.
#                             Being the test result.
#                   DURATION - the time (in seconds) that the test took to run
#                   TARGET_PLATFORM - The platform that was used to run the test
#                   MESSAGE - if the test did not pass, there is more
#                             information here. Most likely a stack dump.
#
sub createBuildInstance {
    my ($verbose, $target) = @_;
    Error("Must provide a target") unless defined($target);

    my $filename = findAntResultsFile($verbose);
    my ($passed, @test_results) = parseTestRun($verbose, $filename, $target);

    return ($passed, @test_results);
}

#------------------------------------------------------------------------------
# Function    : outputFilename
#
# Description : derive the absolute path of the reports file to write
#
# Inputs      : $output_folder - where to put the output file.
#               $target - the target platforn, used to construct the output
#                         filename.
#
# Output      : none
#
# Returns     : The filename of the output file.
#
sub outputFilename {
    my ($verbose, $output_folder, $target) = @_;

    #   Construct the output filename from the microsecond time.
    my $time = Time::HiRes::time;
    $time =~ s/\.//;
    #   Append enough '0' to make 15 chars. This make uniform length numbers
    #   and allows filename sorting.
    $time .= "0"x(15-length($time));
    my $filename = File::Spec->rel2abs("$output_folder/$target-$time.xml");

    Error("Output file:$filename already exists: $!\n") if -e $filename;
    Information("Writing output to $filename\n") if ($verbose gt 0);

    return $filename;
}

#------------------------------------------------------------------------------
# Function    : findAntResultsFile
#
# Description : Find a file matching the pattern '^Test-.*\.xml' below the
#               current folder.
#
# Inputs      : none
#
# Output      : none
#
# Returns     : The complete path and filename of the first matching file.
#
sub findAntResultsFile {
    my ($verbose) = @_;
    my $testResultsFile;

    find(sub {
            if (/^test-.*\.xml/i) {
                #   Get absolute path
                $testResultsFile = File::Spec->rel2abs("$_");
                #   Exit once we've found one file (speed optimisation)
                goto JATS_UTF_ANT_FOUND;
            }
        }, '.');
JATS_UTF_ANT_FOUND:  # goto here from inside Find once the file is found

    Error("Could not find an Ant Results file.\n".
          "Check that is has a filename of 'TEST-*.xml'")
        unless defined($testResultsFile);

    Information("Processing Ant Results file: $testResultsFile\n")
        if ($verbose gt 0);

    return $testResultsFile;
}

#------------------------------------------------------------------------------
# Function    : parseTestRun
#
# Description :
#
# Inputs      : $filename - the junit results.xml file to parse
#               $target - the build target platform to assign to each test
#
# Output      : none
#
# Returns     : a pair of values ($passed, @test_results)
#               $passed - 1 if all tests passed
#                         0 if some tests failed
#               @test_results - A list of TestResult's (see above)
#          
sub parseTestRun {
    my ($verbose, $filename, $target) = @_;
    my ($passed, @test_results);
    my ($project_name, $package_name, $package_version, $timestamp);
    $passed = 1;

    open( my $infile, "<$filename" ) || Error ( "Cannot read from $filename", $! );
    #   Read the file, line by line
    while ( <$infile> ) {

        #   Extract one test case
        #
        #   This may progress the file pointer if <testcase>...</testcase>
        #   is multiline
        my @test_case = getTestCase($verbose, $_, $infile) if /\<testcase/;

        #   Parse the test case creating a hash
        my %test_run = parseTestCase($verbose, $target, @test_case) if (@test_case);

        #   Save the test result in the array
        push(@test_results, {%test_run}) if (%test_run);

        #   Record that there was at least one failed test
        $passed = 0 if (%test_run && ($test_run{OUTCOME} ne 'PASS'));
    }
    return ($passed, @test_results);
}

#------------------------------------------------------------------------------
# Function    : containsClosingTag
#
# Description : Handles the determination of checking for the closing
#               '</testcase>' or '/>' tag.
#
# Inputs      : $line - the current line in the results.xml file.
#
# Output      : none
#
# Returns     : 1 - closing tag found
#               0 - o closing tag found
#
sub containsClosingTag {
    my ($verbose, $line) = @_;

    return 1 if ($line =~ /\<\/testcase\>/);
    return 1 if ($line =~ /\/\>$/);

    return 0;
}

#------------------------------------------------------------------------------
# Function    : getTestCase
#
# Description : Reads from the file, and advances the file pointer, until the
#               closing '</testcase>' or '/>' tag is read.
#
# Inputs      : $line - the current line in the results.xml file. This line
#                       will contain '<testcase'.
#               $file - the file handle of the results.xml file.
#
# Output      : none
#
# Returns     : A string array of all lines read, including the start and end
#               'testcase' tag.
#
sub getTestCase {
    my ($verbose, $line, $file) = @_;
    my (@result);

    #   Save the first line, containing the opening <testcase> tag
    push(@result, $line);
    
    #   No more to do if it's all on one line
    return @result if containsClosingTag($verbose, $line);

    #   Save subsequent lines up to and including the closing </testcase> tag
    while (<$file>)
    {
        push (@result, $_);
        last if /\<\/testcase\>/;
        # don't check for '/>' here as we're multi-line.
    }

    return @result;
}

#------------------------------------------------------------------------------
# Function    : getDetails
#
# Description :
#
# Inputs      : $line - a line of XML containing all the attributes of the
#                       <testcase> tag.
#
# Output      : none
#
# Returns     : A tuple of values ($name, $duration, $outcome)
#               $name - The test name, concatenated from the 'classname' and
#                       'name' attributes.
#               $duration - The test duration, in seconds, from the 'time'
#                           attribute.
#               $outcome - The test outcome (= 'PASS') if we know it (i.e. the
#                          closing '</testcase>' or '/>' tag is on the same
#                          line).
#                          Otherwise, if we don't know it, return undef.
#
sub getDetails {
    my ($verbose, $line) = @_;

    #   Pattern to extract a thing between two quotes (' or ").
    my ($xml_value) = qr/["\']([^"\']*)["\']/;

    my ($name, $duration, $outcome);

    if ($line =~ /\sclassname=${xml_value}\s*name=${xml_value}\s*time=${xml_value}/) {
        $name = $1.'::'.$2;
        $duration = $3;
        $outcome = 'PASS' if containsClosingTag($verbose, $line);
    }

    return ($name, $duration, $outcome);
}

#------------------------------------------------------------------------------
# Function    : parseMessage
#
# Description : parse the given element tag, and return its contents.
#
# Inputs      : $pattern - The XML element name from which to extract the
#                          message.
#               $line - The line with the open tag. E.g.
#                          <error ...>
#               @lines - all lines until, and including, the closing tag. E.g.
#                            ...
#                            ...
#                          </error>
#
# Output      : none
#
# Returns     : The value of the matched element.
#
sub parseMessage {
    my ($verbose, $pattern, $line, @lines) = @_;
    my ($message);

    if ($line =~ /\<${pattern} /) {
        my $temp_message = $line;

        #    consume until </$pattern>
        while ($line = shift @lines) {
            $temp_message .= $line;
            last if $line =~ /\<\/${pattern}\>/;
        }

        #   Extract between '<pattern ...>' and '</pattern>'
        $temp_message =~ m/\<${pattern}[^>]*>([^\<]*)\<\/${pattern}>/;

        $message = $1;
    }
    return ($message);
}

#------------------------------------------------------------------------------
# Function    : parseTestCase
#
# Description : Takes a <testCase> element and parses it into a hash.
#
# Inputs      : A tuple of ($test_target, @lines)
#               $test_target - The target platform, e.g. 'Win32'.
#               @lines - The lines from the file from the opening, to the
#                        closing <testCase> tag (inclusive).
#
# Output      : none
#
# Returns     : A hash with the following keys:
#                 TARGET_PLATFORM - What was passed in as $testTarget.
#                 NAME - the test method name.
#                 DURATION - the test duration, in seconds.
#                 OUTCOME - one of 'PASS', 'FAILED', 'ERROR'
#
sub parseTestCase {
    # using shift, since we're shifting in the while loop later too.
    my $verbose = shift;
    my $testTarget = shift;

    my %testRun;
    $testRun{TARGET_PLATFORM} = $testTarget;
    while (my $line = shift @_) {
        my ($name, $duration, $outcome, $message);
        ($name, $duration, $outcome) = getDetails($verbose, $line);
        if (defined($name) && defined($duration)) {
            $testRun{NAME} = $name;
            $testRun{DURATION} = $duration;
            $testRun{OUTCOME} = $outcome if (defined($outcome));
            next;
        }
        last if containsClosingTag($verbose, $line);
        ($message) = parseMessage($verbose, qr/error/  , $line, @_);
        if (defined($message)) {
            $testRun{OUTCOME} = 'ERROR';
            $testRun{MESSAGE} = $message;
            next;
        }
        ($message) = parseMessage($verbose, qr/failure/, $line, @_);
        if (defined($message)) {
            $testRun{OUTCOME} = 'FAILURE';
            $testRun{MESSAGE} = $message;
            next;
        }
    }
    return %testRun;
}

1;

=pod 1

=head1 NAME

utf_ant - Parse Ant Junit test results for import to Release manager.

=head1 SYNOPSIS

  jats utf_ant [options]

 Options:
    -help        - Help message (may be repeated)
    -verbose     - Level of user messages output during processing.
    -out=path    - The output folder where to generate the XML file.
    -target=name - The target platform for which the tests were run.

=head1 OPTIONS

=over 8

=item B<-help>

Print a help message and exists. This switch may be repeated up to three
times to provide more detailed help.

E.g.
jats utf_ant -help
jats utf_ant -help -help -help

=item B<-verbose>

This option will display progress information as the program executes.

=item B<-out=path>

This is a mandatory option, that tells the program where to put the output
file.

=item B<-target=name>

This is a mandatory option, that tells the program the target platform for
which the tests were run. The output filename has this as its prefix.

=back

=head1 DESCRIPTION

This program is used to allow the Release manager to store test results
obtained from JUnit run by Ant.

It converts ANT JUnit output to a standard XML format for importing in
to the Release Manager database using another program.

The intent is that there is a suite of these converters that all output
the same format XML, that can then be imported to the Release Manager
database.

e.g. mstest_utf - which converts MsTest output to the desired XML format.

The Ant result file is looked for in the current folder and any
sub-folders. The file is identified by a pattern which is:
        'Test-.*\.xml'

The first matching file is used, and no more are processed.

The output is stored in the given output folder, which may be a relative
or absolute path. The output filename is derived from the given target
platform and a high resolution timestamp. E.g.
        './result/Win32-141860573651218.xml'

=head2 Examples

Process the Ant file and place the output in the 'result' folder for the 'Ubunut12' target.

    jats utf_and -out=result -target='Ubuntu12'

This will generate the file:
    ./result/Ubuntu12-<time>.xml

=cut