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 # Functionality common to BRAG file generation

    16 

    17 use strict;

    18 

    19 package ToBrag;

    20 

    21 # A useful constant

    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 }

    36 

    37 sub createBuildStatus

    38 {

    39 	return [

    40 		bless

    41 		{

    42 			Kids =>

    43 			[ $ToBrag::xmlNewline ]

    44 		}, "buildStatus"

    45 	];

    46 }

    47 

    48 sub ensurePhase

    49 {

    50 	my $buildStatus = shift;

    51 	my $phaseName = shift;

    52 

    53 	my ($phase) = grep { ref $_ eq "phase" && $_->{name} eq $phaseName } @{$buildStatus->[-1]->{Kids}};

    54 	unless ($phase)

    55 	{

    56 		$phase = bless

    57 		{

    58 			name => $phaseName,

    59 			Kids => [ $ToBrag::xmlNewline ]

    60 		}, "phase";

    61 		push @{$buildStatus->[-1]->{Kids}}, $phase, $ToBrag::xmlNewline;

    62 	}

    63 	return $phase;

    64 }

    65 

    66 sub ensureStep

    67 {

    68 	my $phase = shift;

    69 	my $stepName = shift;

    70 

    71 	return ensureChild($phase, "step", "name", $stepName);

    72 }

    73 

    74 sub ensureFailureSet

    75 {

    76 	my $step = shift;

    77 	my $level = shift;

    78 

    79 	return ensureChild($step, "failures", "level", $level);

    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)

    91 	{

    92 		$child = bless

    93 		{

    94 			$childAttr => $childAttrValue,

    95 			Kids => [ $ToBrag::xmlNewline ]

    96 		}, $childName;

    97 		push @{$parent->{Kids}}, $child, $ToBrag::xmlNewline;

    98 	}

    99 	return $child;

   100 }

   101 

   102 # Prints out the XML tree to STDOUT

   103 sub printTree

   104 {

   105 	my $tree = shift or die;

   106 	die unless ref $tree;

   107 

   108 	my $tagName = ref $tree;

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

   110 	if ($tagName eq "Characters")

   111 	{

   112 		if ($tree->{Text} =~ m{[<>&]})

   113 		{

   114 			print "<![CDATA[$tree->{Text}]]>";

   115 		}

   116 		else

   117 		{

   118 			print $tree->{Text};

   119 		}

   120 		return;

   121 	}

   122 	

   123 	print "<$tagName";

   124 

   125 	foreach my $attr (

   126 		sort {

   127 			my $order = "name level start stop href package effect";

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

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

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

   131 			$ixA - $ixB;

   132 		}

   133 		grep {

   134 			! ref $tree->{$_}

   135 		}

   136 		keys %$tree)

   137 	{

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

   139 	}

   140 

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

   142 	if (scalar @$children)

   143 	{

   144 		print ">";

   145 		foreach my $child (@$children)

   146 		{

   147 			printTree($child);

   148 		}

   149 		print "</$tagName";

   150 	}

   151 	else

   152 	{

   153 		print "/"

   154 	}

   155 

   156 	print ">";

   157 }

   158 

   159 1;

   160