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; |
|
25 |
|
26 use ToBrag; |
24 |
27 |
25 if (!@ARGV) |
28 if (!@ARGV) |
26 { |
29 { |
27 warn "Generate an XML summary of the Raptor build from a Yarp CSV file\n"; |
30 warn "Generate an XML summary of the Raptor build from a Yarp CSV file\n"; |
28 warn "Eg: yarpToBRAG.pl aYarpFile.csv [*_yarp.csv ...]\n"; |
31 warn "Eg: yarpToBRAG.pl aYarpFile.csv [*_yarp.csv ...]\n"; |
29 exit(1); |
32 exit(1); |
30 } |
33 } |
31 |
34 |
32 # Start to build structure to be output as XML (same format as XML::Parser would create for us) |
35 # Start to build structure to be output as XML (same format as XML::Parser would create for us) |
33 my $xmlNewline = bless { Text => "\n" }, "Characters"; |
36 my $buildStatus = ToBrag::createBuildStatus(); |
34 my $buildPhase = bless { name => "Build", Kids => [ $xmlNewline ] }, "phase"; |
37 # Obtain a phase object |
35 my $buildStatus = |
38 my $buildPhase = ToBrag::ensurePhase($buildStatus, "Build"); |
36 [ |
|
37 bless |
|
38 { |
|
39 Kids => |
|
40 [ |
|
41 $xmlNewline, |
|
42 $buildPhase, |
|
43 $xmlNewline, |
|
44 ] |
|
45 }, "buildStatus" |
|
46 ]; |
|
47 |
39 |
48 @ARGV = map { glob $_ } @ARGV; |
40 @ARGV = map { glob $_ } @ARGV; |
49 |
41 |
50 foreach my $yarpCSV (@ARGV) |
42 foreach my $yarpCSV (@ARGV) |
51 { |
43 { |
112 extension_makefile => {message => "Failed to process an extension makefile connected to $failure->{bldinf}", severity => "major"}, |
104 extension_makefile => {message => "Failed to process an extension makefile connected to $failure->{bldinf}", severity => "major"}, |
113 ); |
105 ); |
114 # die $failure->{name} unless exists $errorIdToDetail{$failure->{name}}; |
106 # die $failure->{name} unless exists $errorIdToDetail{$failure->{name}}; |
115 my $message = $errorIdToDetail{$failure->{name}}->{message} || "Unknown failure tag '$failure->{name}' ($failure->{source} -> $failure->{target})"; |
107 my $message = $errorIdToDetail{$failure->{name}}->{message} || "Unknown failure tag '$failure->{name}' ($failure->{source} -> $failure->{target})"; |
116 $failure->{severity} = $errorIdToDetail{$failure->{name}}->{severity} || "unknown"; |
108 $failure->{severity} = $errorIdToDetail{$failure->{name}}->{severity} || "unknown"; |
117 |
|
118 # Look through the steps to see if we already have one to match this platform |
|
119 my $step; |
|
120 foreach (@{$buildPhase->{Kids}}) |
|
121 { |
|
122 next unless ref $_ eq "step"; |
|
123 if ($_->{name} eq $failure->{platform}) |
|
124 { |
|
125 $step = $_; |
|
126 last; |
|
127 } |
|
128 } |
|
129 unless ($step) |
|
130 { |
|
131 # First item found for this platform - create step entry |
|
132 $step = bless { name => $failure->{platform}, Kids => [ $xmlNewline ] }, "step"; |
|
133 push @{$buildPhase->{Kids}}, $step, $xmlNewline; |
|
134 # Also create empty <failures> tags with severities in a sensible order |
|
135 foreach my $severity (qw{critical major minor}) |
|
136 { |
|
137 my $failureSet = bless { level => $severity, Kids => [ $xmlNewline ] }, "failures"; |
|
138 push @{$step->{Kids}}, $failureSet, $xmlNewline; |
|
139 } |
|
140 } |
|
141 |
109 |
142 # Look through the sets of failures in this step to see if we hve one which matches this severity |
110 # Obtain a matching step |
143 my $failureSet; |
111 my $step = ToBrag::ensureStep($buildPhase, $failure->{platform}); |
144 foreach (@{$step->{Kids}}) |
112 # Also create empty <failures> tags with severities in a sensible order |
145 { |
113 ToBrag::ensureFailureSet($step, "critical"); |
146 next unless ref $_ eq "failures"; |
114 ToBrag::ensureFailureSet($step, "major"); |
147 if ($_->{level} eq $failure->{severity}) |
115 ToBrag::ensureFailureSet($step, "minor"); |
148 { |
116 |
149 $failureSet = $_; |
117 # Obtain a set of failures which matches this severity |
150 last; |
118 my $failureSet = ToBrag::ensureFailureSet($step, $failure->{severity}); |
151 } |
|
152 } |
|
153 unless ($failureSet) |
|
154 { |
|
155 # First item found at this severity - create failures entry |
|
156 $failureSet = bless { level => $failure->{severity}, Kids => [ $xmlNewline ] }, "failures"; |
|
157 push @{$step->{Kids}}, $failureSet, $xmlNewline; |
|
158 } |
|
159 |
119 |
160 # Now create the failure itself, and add it to this failure set |
120 # Now create the failure itself, and add it to this failure set |
161 my $failureItem = bless { |
121 my $failureItem = bless { |
162 # href => "", |
122 # href => "", |
163 "package" => $failure->{package}, |
123 "package" => $failure->{package}, |
164 Kids => [ bless { Text => $message }, "Characters" ], |
124 Kids => [ bless { Kids => [ bless { Text => $message }, "Characters" ]}, "effect"], |
165 }, "failure"; |
125 }, "failure"; |
166 push @{$failureSet->{Kids}}, $failureItem, $xmlNewline; |
126 push @{$failureSet->{Kids}}, $failureItem, $ToBrag::xmlNewline; |
167 } |
127 } |
168 close(CSV); |
128 close(CSV); |
169 } |
129 } |
170 # Print XML |
130 # Print XML |
171 print "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"; |
131 print "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"; |
172 print "<?xml-stylesheet type='text/xsl' href='brag.xsl'?>\n"; |
132 print "<?xml-stylesheet type='text/xsl' href='brag.xsl'?>\n"; |
173 printTree($buildStatus->[0]); |
133 ToBrag::printTree($buildStatus->[0]); |
174 print "\n"; |
134 print "\n"; |
175 |
135 |
176 exit(0); |
136 exit(0); |
177 |
137 |
178 sub printTree |
|
179 { |
|
180 my $tree = shift or die; |
|
181 die unless ref $tree; |
|
182 |
|
183 my $tagName = ref $tree; |
|
184 $tagName =~ s{^main::}{}; |
|
185 if ($tagName eq "Characters") |
|
186 { |
|
187 print $tree->{Text}; |
|
188 return; |
|
189 } |
|
190 |
|
191 print "<$tagName"; |
|
192 |
|
193 foreach my $attr ( |
|
194 sort { |
|
195 my $order = "name level start stop href"; |
|
196 my $ixA = index $order, $a; |
|
197 my $ixB = index $order, $b; |
|
198 die "$a $b" if $ixA + $ixB == -2; |
|
199 $ixA - $ixB; |
|
200 } |
|
201 grep { |
|
202 ! ref $tree->{$_} |
|
203 } |
|
204 keys %$tree) |
|
205 { |
|
206 print " $attr=\"$tree->{$attr}\""; |
|
207 } |
|
208 |
|
209 my $children = $tree->{Kids} || []; |
|
210 if (scalar @$children) |
|
211 { |
|
212 print ">"; |
|
213 foreach my $child (@$children) |
|
214 { |
|
215 printTree($child); |
|
216 } |
|
217 print "</$tagName"; |
|
218 } |
|
219 else |
|
220 { |
|
221 print "/" |
|
222 } |
|
223 |
|
224 print ">"; |
|
225 } |
|
226 |
|