common/tools/brag/logToBRAG.pl
author Simon Howkins <simonh@symbian.org>
Thu, 10 Dec 2009 12:01:59 +0000
changeset 825 1de547e13d13
parent 753 5069de517698
permissions -rw-r--r--
Updates to make the build environment check more reasonable: Mercurial v1.3 permitted The Java compiler is not a showstopping issue 7-zip can be installed in any location Update to Helium 5 Helium can be installed in PDT 1.*, not necessarily 1.0 Raptor installation path not significant Update to Raptor 2.9.* The Raptor patch to update the bundled version of python is no longer relevant BRAG calculations updated to ignore items not being in the system path, as this just doesn't matter. Overall effect is that the build environment check should pass on a machine that is able to do a build!

#!perl -w
#
# Copyright (c) 2009 Symbian Foundation Ltd
# This component and the accompanying materials are made available
# under the terms of the License "Eclipse Public License v1.0"
# which accompanies this distribution, and is available
# at the URL "http://www.eclipse.org/legal/epl-v10.html".
#
# Initial Contributors:
# Symbian Foundation Ltd - initial contribution.
#
# Contributors:
#
# Description:
# Identifies failures in a log file (as determined by a set of rules) and produces a BRAG XML summary

use strict;

use Getopt::Long;

my $phaseName;
my $stepName;
my $rulesFile;
my $help = 0;
GetOptions((
	'phase=s' => \$phaseName,
	'step=s' => \$stepName,
	'rules=s' => \$rulesFile,
	'help!' => \$help,
));

my $wrongArgs = 0;
unless ($help)
{
	$wrongArgs += warn "No phase specified to indicate the phase that the failures fall under\n" unless defined $phaseName;
	$wrongArgs += warn "No step specified to indicate the step that the failures fall under\n" unless defined $stepName;
	$wrongArgs += warn "No file of rules specified to interpret the log file\n" unless defined $rulesFile;
	$wrongArgs += warn "No log files to process\n" unless @ARGV;
}
if ($help || $wrongArgs)
{
	print <<"EOT";

logToBRAG.pl --phase=prebuild --step=syncsource --rules=syncsourceRules.tsv presync.log [doSync.log ...] > output.xml
EOT
	exit(0 + !$help);
}

# Do the wild-carding thing
@ARGV = map { glob $_ } @ARGV;

# Start to build structure to be output as XML (same format as XML::Parser would create for us)
my $xmlNewline = bless { Text => "\n" }, "Characters";
my $step = bless {
	name => $stepName,
	Kids => [ $xmlNewline ]
}, "step";
my $phase = bless {
	name => $phaseName,
	Kids => [ $xmlNewline, $step, $xmlNewline ]
}, "phase";
my $buildStatus = [ bless {
	Kids =>
	[
		$xmlNewline,
		$phase,
		$xmlNewline,
	]
}, "buildStatus"];

# Also create empty <failures> tags with severities in a sensible order
# And shortcuts to those items
my $severityShortcut = {};
foreach my $severity (qw{critical major minor})
{
	my $failureSet = bless { level => $severity, Kids => [ $xmlNewline ] }, "failures";
	push @{$step->{Kids}}, $failureSet, $xmlNewline;
	$severityShortcut->{$severity} = $failureSet;
}

# Read rules file
my @rules;
open(TSV, $rulesFile) or die "Unable to open rules file '$rulesFile'\n";
while (my $line = <TSV>)
{
	chomp $line;
	next unless $line;
	my @terms = split m{\t+}, $line;
	die "Rules file not formatted as expected at line $.\n" unless scalar @terms == 2;
	push @rules, { regexp => qr{$terms[0]}, severity => $terms[1] };
}	

# Iterate through all the lines of all the files in @ARGV
while (my $line = <>)
{
	chomp $line;
	foreach my $rule (@rules)
	{
		if ($line =~ m[$rule->{regexp}])
		{
			last if $rule->{severity} eq "ignore";
			# We found a match
			my $failure = bless{ Kids => [ bless { Kids => [ bless { Text => $line }, "Characters" ]}, "effect"] }, "failure";
			# Ensure we have a <failures> tag for this severity
			if (!exists $severityShortcut->{$rule->{severity}})
			{
				# Create the failure set and add it to the shortcut list too
				my $failureSet = bless { level => $rule->{severity}, Kids => [ $xmlNewline ] }, "failures";
				push @{$step->{Kids}}, $failureSet, $xmlNewline;
				$severityShortcut->{$rule->{severity}} = $failureSet;
			}
			push @{$severityShortcut->{$rule->{severity}}->{Kids}}, $failure, $xmlNewline;
			# Do not consider any more rules
			last;
		}
	}
}

# Print XML
print "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
print "<?xml-stylesheet type='text/xsl' href='brag.xsl'?>\n";
printTree($buildStatus->[0]);
print "\n";

exit(0);

sub printTree
{
	my $tree = shift or die;
	die unless ref $tree;

	my $tagName = ref $tree;
	$tagName =~ s{^main::}{};
	if ($tagName eq "Characters")
	{
		print escapeForXML($tree->{Text});
		return;
	}
	
	print "<$tagName";

	foreach my $attr (
		sort {
			my $order = "name level start stop href";
			my $ixA = index $order, $a;
			my $ixB = index $order, $b;
			die "$a $b" if $ixA + $ixB == -2;
			$ixA - $ixB;
		}
		grep {
			! ref $tree->{$_}
		}
		keys %$tree)
	{
		print " $attr=\"$tree->{$attr}\"";
	}

	my $children = $tree->{Kids} || [];
	if (scalar @$children)
	{
		print ">";
		foreach my $child (@$children)
		{
			printTree($child);
		}
		print "</$tagName";
	}
	else
	{
		print "/"
	}

	print ">";
}

sub escapeForXML
{
	$_ = shift;
	s{&}{&amp;}g;
	s{<}{&lt;}g;
	s{>}{&gt;}g;
	return $_;
}