equal
deleted
inserted
replaced
18 |
18 |
19 package ToBrag; |
19 package ToBrag; |
20 |
20 |
21 # A useful constant |
21 # A useful constant |
22 our $xmlNewline = bless { Text => "\n" }, "Characters"; |
22 our $xmlNewline = bless { Text => "\n" }, "Characters"; |
|
23 |
|
24 sub createDocumentAndRoot |
|
25 { |
|
26 my $rootTag = shift; |
|
27 |
|
28 my $root = bless |
|
29 { |
|
30 Kids => |
|
31 [ $ToBrag::xmlNewline ] |
|
32 }, $rootTag; |
|
33 |
|
34 return [$root], $root; |
|
35 } |
23 |
36 |
24 sub createBuildStatus |
37 sub createBuildStatus |
25 { |
38 { |
26 return [ |
39 return [ |
27 bless |
40 bless |
53 sub ensureStep |
66 sub ensureStep |
54 { |
67 { |
55 my $phase = shift; |
68 my $phase = shift; |
56 my $stepName = shift; |
69 my $stepName = shift; |
57 |
70 |
58 my ($step) = grep { ref $_ eq "step" && $_->{name} eq $stepName } @{$phase->{Kids}}; |
71 return ensureChild($phase, "step", "name", $stepName); |
59 unless ($step) |
|
60 { |
|
61 $step = bless |
|
62 { |
|
63 name => $stepName, |
|
64 Kids => [ $ToBrag::xmlNewline ] |
|
65 }, "step"; |
|
66 push @{$phase->{Kids}}, $step, $ToBrag::xmlNewline; |
|
67 } |
|
68 return $step; |
|
69 } |
72 } |
70 |
73 |
71 sub ensureFailureSet |
74 sub ensureFailureSet |
72 { |
75 { |
73 my $step = shift; |
76 my $step = shift; |
74 my $level = shift; |
77 my $level = shift; |
75 |
78 |
76 my ($failureSet) = grep { ref $_ eq "failures" && $_->{level} eq $level } @{$step->{Kids}}; |
79 return ensureChild($step, "failures", "level", $level); |
77 unless ($failureSet) |
80 } |
|
81 |
|
82 sub ensureChild |
|
83 { |
|
84 my $parent = shift; |
|
85 my $childName = shift; |
|
86 my $childAttr = shift; |
|
87 my $childAttrValue = shift; |
|
88 |
|
89 my ($child) = grep { ref $_ eq $childName && $_->{$childAttr} eq $childAttrValue } @{$parent->{Kids}}; |
|
90 unless ($child) |
78 { |
91 { |
79 $failureSet = bless |
92 $child = bless |
80 { |
93 { |
81 level => $level, |
94 $childAttr => $childAttrValue, |
82 Kids => [ $ToBrag::xmlNewline ] |
95 Kids => [ $ToBrag::xmlNewline ] |
83 }, "failures"; |
96 }, $childName; |
84 push @{$step->{Kids}}, $failureSet, $ToBrag::xmlNewline; |
97 push @{$parent->{Kids}}, $child, $ToBrag::xmlNewline; |
85 } |
98 } |
86 return $failureSet; |
99 return $child; |
87 } |
100 } |
88 |
101 |
89 # Prints out the XML tree to STDOUT |
102 # Prints out the XML tree to STDOUT |
90 sub printTree |
103 sub printTree |
91 { |
104 { |
94 |
107 |
95 my $tagName = ref $tree; |
108 my $tagName = ref $tree; |
96 $tagName =~ s{^main::}{}; |
109 $tagName =~ s{^main::}{}; |
97 if ($tagName eq "Characters") |
110 if ($tagName eq "Characters") |
98 { |
111 { |
99 print $tree->{Text}; |
112 if ($tree->{Text} =~ m{[<>&]}) |
|
113 { |
|
114 print "<![CDATA[$tree->{Text}]]>"; |
|
115 } |
|
116 else |
|
117 { |
|
118 print $tree->{Text}; |
|
119 } |
100 return; |
120 return; |
101 } |
121 } |
102 |
122 |
103 print "<$tagName"; |
123 print "<$tagName"; |
104 |
124 |
105 foreach my $attr ( |
125 foreach my $attr ( |
106 sort { |
126 sort { |
107 my $order = "name level start stop href"; |
127 my $order = "name level start stop href package effect"; |
108 my $ixA = index $order, $a; |
128 my $ixA = index $order, $a; |
109 my $ixB = index $order, $b; |
129 my $ixB = index $order, $b; |
110 die "$a $b" if $ixA + $ixB == -2; |
130 die "$a $b" if $ixA + $ixB == -2; |
111 $ixA - $ixB; |
131 $ixA - $ixB; |
112 } |
132 } |