WebSVN – DevTools – Diff – /core_devl/trunk/TOOLS/jats_utf_ant.pl

 use warnings;
 use Pod::Usage;
 use Getopt::Long;
 use Time::HiRes;
+use File::Find;
 use File::Spec;
 use XML::Simple;
 use Cwd;
 use JatsError;
 #               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'.
+#               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
 #   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_outFolder, $opt_target);
+return doMain($opt_verbose, $opt_outFolder, $opt_target);
 #   End of broken indentation convention
+}
 #------------------------------------------------------------------------------
+#
 # Returns     : 0 - some tests failed
 #               1 - all tests passed
+#
 sub doMain {
-    my ($outFolder, $target) = @_;
+    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($target);
+    my ($passed, @instance) = createBuildInstance($verbose, $target);
-    outputJatsXmlFile($outFolder, $target, @instance);
+    outputJatsXmlFile($verbose, $outfile, @instance);
     return $passed;
+}
 #------------------------------------------------------------------------------
 # Function    : outputJatsXmlFile
 # Output      : The result XML file.
+#
 # Returns     : The filename of the output file.
+#
 sub outputJatsXmlFile {
-    my ($output_folder, $target, @instance) = @_;
+    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');
-    #   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 = "$output_folder/$target-$time.xml";
-    Error("$filename already exists: $!\n") if -e $filename;
     #   Write the data to the XML file.
     open ( my $outFile, ">", $filename)
-        || Error("Cannot open $filename for writing: $!\n");
+        || Error(" Cannot open results file:$filename for writing: $!\n");
     print $outFile $xmlData;
     return $filename;
+}
 #------------------------------------------------------------------------------
 #                   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 ($target) = @_;
+    my ($verbose, $target) = @_;
     Error("Must provide a target") unless defined($target);
-    my $filename = findAntResultsFile();
+    my $filename = findAntResultsFile($verbose);
-    my ($passed, @test_results) = parseTestRun($filename, $target);
+    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.
+#
 # Output      : none
+#
 # Returns     : The complete path and filename of the first matching file.
+#
 sub findAntResultsFile {
+    my ($verbose) = @_;
     my $testResultsFile;
-    use File::Find;
     find(sub {
-            if (/^Test-.*\.xml/) {
+            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
 #               $passed - 1 if all tests passed
 #                         0 if some tests failed
 #               @test_results - A list of TestResult's (see above)
+#
 sub parseTestRun {
-    my ($filename, $target) = @_;
+    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", $! );
         #   Extract one test case
+        #
         #   This may progress the file pointer if <testcase>...</testcase>
         #   is multiline
-        my @test_case = getTestCase($_, $infile) if /\<testcase/;
+        my @test_case = getTestCase($verbose, $_, $infile) if /\<testcase/;
         #   Parse the test case creating a hash
-        my %test_run = parseTestCase($target, @test_case) if (@test_case);
+        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
+    }
     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>' tag is read.
+#               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.
+#
+#
 # Returns     : A string array of all lines read, including the start and end
 #               'testcase' tag.
+#
 sub getTestCase {
-    my ($line, $file) = @_;
+    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 ($line =~/\<\/testcase\>/);
+    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;
+}
 #               $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> tag is on the same line).
+#                          closing '</testcase>' or '/>' tag is on the same
+#                          line).
 #                          Otherwise, if we don't know it, return undef.
+#
 sub getDetails {
-    my ($line) = shift;
+    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 $line =~ /\<\/testcase\>/;
+        $outcome = 'PASS' if containsClosingTag($verbose, $line);
+    }
     return ($name, $duration, $outcome);
+}
 #------------------------------------------------------------------------------
 # Function    : parseMessage
+#
-# Description :
+# 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 ...>
 # Output      : none
+#
 # Returns     : The value of the matched element.
+#
 sub parseMessage {
-    my ($pattern, $line, @lines) = @_;
+    my ($verbose, $pattern, $line, @lines) = @_;
     my ($message);
     if ($line =~ /\<${pattern} /) {
         my $temp_message = $line;
 #                 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($line);
+        ($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 $line =~ /\<\/testcase\>/;
+        last if containsClosingTag($verbose, $line);
-        ($message) = parseMessage(qr/error/  , $line, @_);
+        ($message) = parseMessage($verbose, qr/error/  , $line, @_);
         if (defined($message)) {
             $testRun{OUTCOME} = 'ERROR';
             $testRun{MESSAGE} = $message;
             next;
+        }
-        ($message) = parseMessage(qr/failure/, $line, @_);
+        ($message) = parseMessage($verbose, qr/failure/, $line, @_);
         if (defined($message)) {
             $testRun{OUTCOME} = 'FAILURE';
             $testRun{MESSAGE} = $message;
             next;
+        }

Subversion Repositories DevTools

(root)/core_devl/trunk/TOOLS/jats_utf_ant.pl @ 4781 – Rev 4762 → 4768