# HG changeset patch
# User MattD <mattd@symbian.org>
# Date 1248953367 -3600
# Node ID 58affcc6c40e8ca17ecf412f8fba815adf10f2d3
# Parent  b2c612c53eebc9578ea9ed6db22dea9a2b2812ca
Yarp.pl - Added manual XML parsing. Memory leaks using XML::Simple cause perl to run out of memory when parsing a large raptor log.

diff -r b2c612c53eeb -r 58affcc6c40e common/tools/analysis/yarp.pl
--- a/common/tools/analysis/yarp.pl	Wed Jul 29 15:41:14 2009 +0100
+++ b/common/tools/analysis/yarp.pl	Thu Jul 30 12:29:27 2009 +0100
@@ -20,7 +20,7 @@
 #
 # Notes:
 # Currently it won't tell you any info about why it fails, with the exception of arm licence issues.
-# It also uses a lot of memory, so while there is a subroutine for doing multiple files, it's not used, and is out of date.
+# XML::Simple leaks memory, so there is now a manual parsing mode which is enabled by the '$manualparsing' global variable.
 # Writing output to a file is hacked in, so it's not too pretty.
 
 use strict;
@@ -28,6 +28,7 @@
 use Data::Dumper;
 
 my @header = qw(line layer component name armlicence platform phase code bldinf mmp target source);
+my $manualparsing = 1; #XML::Simple leaks memory. Manual parsing doesn't, but may not be as robust if Raptor changes it's output...
 
 main();
 
@@ -63,12 +64,13 @@
     my $filename = shift;
 #    print "Scanning $filename\n";
     open(FILE,"<$filename") or die "Couldn't open filename\n";
-    my $recipe;
+    my $recipe = undef;
     my %attempts;
     my %licenceattempts;
     my $counter = 0;
     my $licence = 0;
     my $failures = 0;
+
     while( my $line = <FILE>)
     {
       if(defined $recipe)
@@ -82,7 +84,7 @@
       ++$counter;
       if($line =~ m/^<recipe\s+(\S.+)>/)
       {
-        $recipe = XMLin($line."</recipe>");
+        $recipe = parseline($line."</recipe>");
         $recipe->{'line'} = $counter;
         my @content;
         push(@content, $line);
@@ -118,7 +120,7 @@
       }
       elsif($line =~ m/(<status\s.+\/>)/)
       {
-        my $status = XMLin($1);
+        my $status = parseline($1);
         if(defined $recipe)
         {
           $recipe->{'exit'} = $status->{'exit'};
@@ -181,3 +183,39 @@
   #print Dumper($recipe);
 
 }
+
+sub parseline($line)
+{
+  my $line = shift;
+#  print "\t$line\n";
+  my $val;
+  if($manualparsing)
+  {
+    my $strippedline;    
+    if($line =~ m/<\S+(.+)\/>/)
+    {
+      $strippedline = $1;
+    }
+    elsif($line =~ m/<\S+(.+)>\s*<\/\S+>/)
+    {
+      $strippedline = $1;
+    }
+#    print $strippedline."\n";
+    my @stuff = split('\s+', $strippedline);
+    my %results;
+    foreach my $pair (@stuff)
+    {
+#      print $pair."\n";
+      if($pair =~ m/^(\S+)=\'(\S+)\'$/)
+      {
+        $results{$1}=$2;
+      }
+    }
+    $val = \%results;
+  }  
+  else
+  {
+    $val = XMLin($line);
+  }   
+  return $val; 
+}
\ No newline at end of file