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 createBuildStatus

    25 {

    26 	return [

    27 		bless

    28 		{

    29 			Kids =>

    30 			[ $ToBrag::xmlNewline ]

    31 		}, "buildStatus"

    32 	];

    33 }

    34 

    35 sub ensurePhase

    36 {

    37 	my $buildStatus = shift;

    38 	my $phaseName = shift;

    39 

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

    41 	unless ($phase)

    42 	{

    43 		$phase = bless

    44 		{

    45 			name => $phaseName,

    46 			Kids => [ $ToBrag::xmlNewline ]

    47 		}, "phase";

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

    49 	}

    50 	return $phase;

    51 }

    52 

    53 sub ensureStep

    54 {

    55 	my $phase = shift;

    56 	my $stepName = shift;

    57 

    58 	my ($step) = grep { ref $_ eq "step" && $_->{name} eq $stepName } @{$phase->{Kids}};

    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 }

    70 

    71 sub ensureFailureSet

    72 {

    73 	my $step = shift;

    74 	my $level = shift;

    75 

    76 	my ($failureSet) = grep { ref $_ eq "failures" && $_->{level} eq $level } @{$step->{Kids}};

    77 	unless ($failureSet)

    78 	{

    79 		$failureSet = bless

    80 		{

    81 			level => $level,

    82 			Kids => [ $ToBrag::xmlNewline ]

    83 		}, "failures";

    84 		push @{$step->{Kids}}, $failureSet, $ToBrag::xmlNewline;

    85 	}

    86 	return $failureSet;

    87 }

    88 

    89 # Prints out the XML tree to STDOUT

    90 sub printTree

    91 {

    92 	my $tree = shift or die;

    93 	die unless ref $tree;

    94 

    95 	my $tagName = ref $tree;

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

    97 	if ($tagName eq "Characters")

    98 	{

    99 		print $tree->{Text};

   100 		return;

   101 	}

   102 	

   103 	print "<$tagName";

   104 

   105 	foreach my $attr (

   106 		sort {

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

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

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

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

   111 			$ixA - $ixB;

   112 		}

   113 		grep {

   114 			! ref $tree->{$_}

   115 		}

   116 		keys %$tree)

   117 	{

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

   119 	}

   120 

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

   122 	if (scalar @$children)

   123 	{

   124 		print ">";

   125 		foreach my $child (@$children)

   126 		{

   127 			printTree($child);

   128 		}

   129 		print "</$tagName";

   130 	}

   131 	else

   132 	{

   133 		print "/"

   134 	}

   135 

   136 	print ">";

   137 }

   138 

   139 1;

   140