common/tools/brag/raptorToBRAG.pl
changeset 761 3901909be1ab
parent 753 5069de517698
child 807 194ddb729c09
equal deleted inserted replaced
760:dca795714caa 761:3901909be1ab
    16 
    16 
    17 use strict;
    17 use strict;
    18 
    18 
    19 use FindBin;
    19 use FindBin;
    20 use lib "$FindBin::Bin/../lib";
    20 use lib "$FindBin::Bin/../lib";
       
    21 use lib "$FindBin::Bin";
    21 
    22 
    22 use Getopt::Long;
    23 use Getopt::Long;
    23 use Text::CSV;
    24 use Text::CSV;
    24 
    25 
       
    26 use ToBrag;
    25 
    27 
    26 my $raptorSummary;
    28 my $raptorSummary;
    27 my $help = 0;
    29 my $help = 0;
    28 GetOptions((
    30 GetOptions((
    29 	'raptorsummary=s' => \$raptorSummary,
    31 	'raptorsummary=s' => \$raptorSummary,
    37 	print "Usage: perl summarize.pl --raptorsummary=CSV\n";
    39 	print "Usage: perl summarize.pl --raptorsummary=CSV\n";
    38 	exit(0);
    40 	exit(0);
    39 }
    41 }
    40 
    42 
    41 # Start to build structure to be output as XML (same format as XML::Parser would create for us)
    43 # Start to build structure to be output as XML (same format as XML::Parser would create for us)
    42 my $xmlNewline = bless { Text => "\n" }, "Characters";
    44 my $buildStatus = ToBrag::createBuildStatus();
    43 my $buildStatus =
    45 # Obtain a phase object
    44 [
    46 my $buildPhase = ToBrag::ensurePhase($buildStatus, "Build");
    45 	bless
       
    46 	{
       
    47 		Kids =>
       
    48 		[
       
    49 			$xmlNewline,
       
    50 			bless
       
    51 			{
       
    52 				name => "Build",
       
    53 				Kids => [ $xmlNewline ]
       
    54 			}, "phase",
       
    55 		]
       
    56 	}, "buildStatus"
       
    57 ];
       
    58 # Get a shortcut reference to the bit we will use a lot
       
    59 my $buildPhase = $buildStatus->[0]->{Kids}->[-1];
       
    60 
    47 
    61 # READ SUMMARY.CSV FILE
    48 # READ SUMMARY.CSV FILE
    62 open(CSV, $raptorSummary);
    49 open(CSV, $raptorSummary);
    63 my $csv = Text::CSV->new();
    50 my $csv = Text::CSV->new();
    64 while (my $line = <CSV>)
    51 while (my $line = <CSV>)
    96 		next;
    83 		next;
    97 	}
    84 	}
    98 	$failure->{subcategory} ||= 'uncategorized';
    85 	$failure->{subcategory} ||= 'uncategorized';
    99 	$failure->{severity} ||= 'unknown';
    86 	$failure->{severity} ||= 'unknown';
   100 	
    87 	
   101 	# Look through the steps to see if we already have one to match this config
    88 	# Obtain a matching step
   102 	my $step;
    89 	my $step = ToBrag::ensureStep($buildPhase, $failure->{config});
   103 	foreach (@{$buildPhase->{Kids}})
    90 	# Also create empty <failures> tags with severities in a sensible order
   104 	{
    91 	ToBrag::ensureFailureSet($step, "critical");
   105 		next unless ref $_ eq "step";
    92 	ToBrag::ensureFailureSet($step, "major");
   106 		if ($_->{name} eq $failure->{config})
    93 	ToBrag::ensureFailureSet($step, "minor");
   107 		{
       
   108 			$step = $_;
       
   109 			last;
       
   110 		}
       
   111 	}
       
   112 	unless ($step)
       
   113 	{
       
   114 		# First item found in this step - create step entry
       
   115 		$step = bless { name => $failure->{config}, Kids => [ $xmlNewline ] }, "step";
       
   116 		push @{$buildPhase->{Kids}}, $step, $xmlNewline;
       
   117 		# Also create empty <failures> tags with severities in a sensible order
       
   118 		foreach my $severity (qw{critical major minor})
       
   119 		{
       
   120 			my $failureSet = bless { level => $severity, Kids => [ $xmlNewline ] }, "failures";
       
   121 			push @{$step->{Kids}}, $failureSet, $xmlNewline;
       
   122 		}
       
   123 	}
       
   124 	
    94 	
   125 	# Look through the sets of failures in this step to see if we hve one which matches this severity
    95 	# Obtain a set of failures which matches this severity
   126 	my $failureSet;
    96 	my $failureSet = ToBrag::ensureFailureSet($step, $failure->{severity});
   127 	foreach (@{$step->{Kids}})
       
   128 	{
       
   129 		next unless ref $_ eq "failures";
       
   130 		if ($_->{level} eq $failure->{severity})
       
   131 		{
       
   132 			$failureSet = $_;
       
   133 			last;
       
   134 		}
       
   135 	}
       
   136 	unless ($failureSet)
       
   137 	{
       
   138 		# First item found at this severity - create failures entry
       
   139 		$failureSet = bless { level => $failure->{severity}, Kids => [ $xmlNewline ] }, "failures";
       
   140 		push @{$step->{Kids}}, $failureSet, $xmlNewline;
       
   141 	}
       
   142 
    97 
   143 	# Now create the failure itself, and add it to this failure set
    98 	# Now create the failure itself, and add it to this failure set
   144 	my $failureItem = bless {
    99 	my $failureItem = bless {
   145 #		href => "",
   100 		Kids => [ bless { Kids => [ bless { Text => $failure->{subcategory} }, "Characters" ]}, "effect" ],
   146 		Kids => [ bless { Text => $failure->{subcategory} }, "Characters" ]
       
   147 	}, "failure";
   101 	}, "failure";
   148 	if ($failure->{component})
   102 	if ($failure->{component})
   149 	{
   103 	{
   150 		$failure->{component} =~ s{^(/sf/.*?/.*?)/.*$}{$1};
   104 		$failure->{component} =~ s{^(/sf/.*?/.*?)/.*$}{$1};
   151 		$failureItem->{package} = $failure->{component};
   105 		$failureItem->{package} = $failure->{component};
   152 	}
   106 	}
   153 	push @{$failureSet->{Kids}}, $failureItem, $xmlNewline;
   107 	push @{$failureSet->{Kids}}, $failureItem, $ToBrag::xmlNewline;
   154 }
   108 }
   155 close(CSV);
   109 close(CSV);
   156 
   110 
   157 # Print XML
   111 # Print XML
   158 print "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
   112 print "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
   159 print "<?xml-stylesheet type='text/xsl' href='brag.xsl'?>\n";
   113 print "<?xml-stylesheet type='text/xsl' href='brag.xsl'?>\n";
   160 printTree($buildStatus->[0]);
   114 ToBrag::printTree($buildStatus->[0]);
   161 print "\n";
   115 print "\n";
   162 
   116 
   163 exit(0);
   117 exit(0);
   164 
   118 
   165 sub printTree
       
   166 {
       
   167 	my $tree = shift or die;
       
   168 	die unless ref $tree;
       
   169 
       
   170 	my $tagName = ref $tree;
       
   171 	$tagName =~ s{^main::}{};
       
   172 	if ($tagName eq "Characters")
       
   173 	{
       
   174 		print $tree->{Text};
       
   175 		return;
       
   176 	}
       
   177 	
       
   178 	print "<$tagName";
       
   179 
       
   180 	foreach my $attr (
       
   181 		sort {
       
   182 			my $order = "name level start stop href";
       
   183 			my $ixA = index $order, $a;
       
   184 			my $ixB = index $order, $b;
       
   185 			die "$a $b" if $ixA + $ixB == -2;
       
   186 			$ixA - $ixB;
       
   187 		}
       
   188 		grep {
       
   189 			! ref $tree->{$_}
       
   190 		}
       
   191 		keys %$tree)
       
   192 	{
       
   193 		print " $attr=\"$tree->{$attr}\"";
       
   194 	}
       
   195 
       
   196 	my $children = $tree->{Kids} || [];
       
   197 	if (scalar @$children)
       
   198 	{
       
   199 		print ">";
       
   200 		foreach my $child (@$children)
       
   201 		{
       
   202 			printTree($child);
       
   203 		}
       
   204 		print "</$tagName";
       
   205 	}
       
   206 	else
       
   207 	{
       
   208 		print "/"
       
   209 	}
       
   210 
       
   211 	print ">";
       
   212 }
       
   213