1 #!perl -w

     2 #

     3 # Copyright (c) 2009 Symbian Foundation Ltd

     4 # This component and the accompanying materials are made available

     5 # under the terms of the License "Eclipse Public License v1.0"

     6 # which accompanies this distribution, and is available

     7 # at the URL "http://www.eclipse.org/legal/epl-v10.html".

     8 #

     9 # Initial Contributors:

    10 # Symbian Foundation Ltd - initial contribution.

    11 #

    12 # Contributors:

    13 #

    14 # Description:

    15 # Generate the BRAG-compatible XML summary of the Raptor log from the CSV output of the raptor parser

    16 

    17 use strict;

    18 

    19 use Getopt::Long;

    20 use Text::CSV;

    21 

    22 

    23 my $raptorSummary;

    24 my $help = 0;

    25 GetOptions((

    26 	'raptorsummary=s' => \$raptorSummary,

    27 	'help!' => \$help

    28 ));

    29 

    30 $help = 1 if (!$raptorSummary);

    31 if ($help)

    32 {

    33 	print "Generate an XML summary of the Raptor build from a summary.csv file\n";

    34 	print "Usage: perl summarize.pl --raptorsummary=CSV\n";

    35 	exit(0);

    36 }

    37 

    38 # Start to build structure to be output as XML (same format as XML::Parser would create for us)

    39 my $xmlNewline = bless { Text => "\n" }, "Characters";

    40 my $data = [bless {name => "build", Kids => [ $xmlNewline ] }, "stage"];

    41 # Get a shortcut reference to the bit we will use a lot

    42 my $buildStage = $data->[0];

    43 

    44 # READ SUMMARY.CSV FILE

    45 open(CSV, $raptorSummary);

    46 my $csv = Text::CSV->new();

    47 while (my $line = <CSV>)

    48 {

    49 	chomp $line;

    50 	

    51 	unless ($csv->parse($line))

    52 	{

    53 		my $err = $csv->error_input();

    54 		warn "Failed to parse $raptorSummary line line $. as CSV '$line': $err  Skipping\n";

    55 		next;

    56 	}

    57 	

    58 	my @keys = qw{category subcategory severity config component phase recipe file linenum};

    59 	my @values = $csv->fields();

    60 	unless (scalar @keys == scalar @keys)

    61 	{

    62 		warn "WARNING: line does not match expected format at $raptorSummary line $.. Skipping\n";

    63 		next;

    64 	}

    65 	

    66 	my $failure = {};

    67 	@{$failure}{@keys} = @values;

    68 	

    69 	if (!$failure->{category})

    70 	{

    71 		warn "WARNING: summary line without a category at $raptorSummary line $.. Skipping\n";

    72 		next;

    73 	}

    74 	

    75 	if ($failure->{category} =~ m{^recipe_failure$}i and !$failure->{component})

    76 	{

    77 		warn "WARNING: recipe_failure with component field empty at $raptorSummary line $.. Skipping\n";

    78 		next;

    79 	}

    80 	$failure->{subcategory} ||= 'uncategorized';

    81 	$failure->{severity} ||= 'unknown';

    82 	

    83 	# Look through the steps to see if we already have one to match this config

    84 	my $step;

    85 	foreach (@{$buildStage->{Kids}})

    86 	{

    87 		next unless ref $_ eq "step";

    88 		if ($_->{name} eq $failure->{config})

    89 		{

    90 			$step = $_;

    91 			last;

    92 		}

    93 	}

    94 	unless ($step)

    95 	{

    96 		# First item found in this step - create step entry

    97 		$step = bless { name => $failure->{config}, Kids => [ $xmlNewline ] }, "step";

    98 		push @{$buildStage->{Kids}}, $step, $xmlNewline;

    99 	}

   100 	

   101 	# Look through the sets of failures in this step to see if we hve one which matches this severity

   102 	my $failureSet;

   103 	foreach (@{$step->{Kids}})

   104 	{

   105 		next unless ref $_ eq "failures";

   106 		if ($_->{level} eq $failure->{severity})

   107 		{

   108 			$failureSet = $_;

   109 			last;

   110 		}

   111 	}

   112 	unless ($failureSet)

   113 	{

   114 		# First item found at this severity - create failures entry

   115 		$failureSet = bless { level => $failure->{severity}, Kids => [ $xmlNewline ] }, "failures";

   116 		push @{$step->{Kids}}, $failureSet, $xmlNewline;

   117 	}

   118 

   119 	# Now create the failure itself, and add it to this failure set

   120 	my $failureItem = bless { href => "", Kids => [ bless { Text => $failure->{subcategory} }, "Characters" ] }, "failure";

   121 	push @{$failureSet->{Kids}}, $failureItem, $xmlNewline;

   122 }

   123 close(CSV);

   124 

   125 # Print XML

   126 print "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";

   127 print "<?xml-stylesheet type='text/xsl' href='brag.xsl'?>\n";

   128 printTree($data->[0]);

   129 print "\n";

   130 

   131 exit(0);

   132 

   133 sub printTree

   134 {

   135 	my $tree = shift or die;

   136 	die unless ref $tree;

   137 

   138 	my $tagName = ref $tree;

   139 	$tagName =~ s{^main::}{};

   140 	if ($tagName eq "Characters")

   141 	{

   142 		print $tree->{Text};

   143 		return;

   144 	}

   145 	

   146 	print "<$tagName";

   147 

   148 	foreach my $attr (

   149 		sort {

   150 			my $order = "name level start stop href";

   151 			my $ixA = index $order, $a;

   152 			my $ixB = index $order, $b;

   153 			die "$a $b" if $ixA + $ixB == -2;

   154 			$ixA - $ixB;

   155 		}

   156 		grep {

   157 			! ref $tree->{$_}

   158 		}

   159 		keys %$tree)

   160 	{

   161 		print " $attr=\"$tree->{$attr}\"";

   162 	}

   163 

   164 	my $children = $tree->{Kids} || [];

   165 	if (scalar @$children)

   166 	{

   167 		print ">";

   168 		foreach my $child (@$children)

   169 		{

   170 			printTree($child);

   171 		}

   172 		print "</$tagName";

   173 	}

   174 	else

   175 	{

   176 		print "/"

   177 	}

   178 

   179 	print ">";

   180 }

   181