common/tools/analysis/yarp.pl
changeset 288 58affcc6c40e
parent 284 e5f3b53baae0
equal deleted inserted replaced
286:b2c612c53eeb 288:58affcc6c40e
    18 # Usage:
    18 # Usage:
    19 # perl yarp.pl <logfile> <csvfile>
    19 # perl yarp.pl <logfile> <csvfile>
    20 #
    20 #
    21 # Notes:
    21 # Notes:
    22 # Currently it won't tell you any info about why it fails, with the exception of arm licence issues.
    22 # Currently it won't tell you any info about why it fails, with the exception of arm licence issues.
    23 # 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.
    23 # XML::Simple leaks memory, so there is now a manual parsing mode which is enabled by the '$manualparsing' global variable.
    24 # Writing output to a file is hacked in, so it's not too pretty.
    24 # Writing output to a file is hacked in, so it's not too pretty.
    25 
    25 
    26 use strict;
    26 use strict;
    27 use XML::Simple;
    27 use XML::Simple;
    28 use Data::Dumper;
    28 use Data::Dumper;
    29 
    29 
    30 my @header = qw(line layer component name armlicence platform phase code bldinf mmp target source);
    30 my @header = qw(line layer component name armlicence platform phase code bldinf mmp target source);
       
    31 my $manualparsing = 1; #XML::Simple leaks memory. Manual parsing doesn't, but may not be as robust if Raptor changes it's output...
    31 
    32 
    32 main();
    33 main();
    33 
    34 
    34 
    35 
    35 sub main()
    36 sub main()
    61 sub  parsefile($filename)
    62 sub  parsefile($filename)
    62 {
    63 {
    63     my $filename = shift;
    64     my $filename = shift;
    64 #    print "Scanning $filename\n";
    65 #    print "Scanning $filename\n";
    65     open(FILE,"<$filename") or die "Couldn't open filename\n";
    66     open(FILE,"<$filename") or die "Couldn't open filename\n";
    66     my $recipe;
    67     my $recipe = undef;
    67     my %attempts;
    68     my %attempts;
    68     my %licenceattempts;
    69     my %licenceattempts;
    69     my $counter = 0;
    70     my $counter = 0;
    70     my $licence = 0;
    71     my $licence = 0;
    71     my $failures = 0;
    72     my $failures = 0;
       
    73 
    72     while( my $line = <FILE>)
    74     while( my $line = <FILE>)
    73     {
    75     {
    74       if(defined $recipe)
    76       if(defined $recipe)
    75       {
    77       {
    76         if(defined $recipe->{'content'})
    78         if(defined $recipe->{'content'})
    80         }
    82         }
    81       }
    83       }
    82       ++$counter;
    84       ++$counter;
    83       if($line =~ m/^<recipe\s+(\S.+)>/)
    85       if($line =~ m/^<recipe\s+(\S.+)>/)
    84       {
    86       {
    85         $recipe = XMLin($line."</recipe>");
    87         $recipe = parseline($line."</recipe>");
    86         $recipe->{'line'} = $counter;
    88         $recipe->{'line'} = $counter;
    87         my @content;
    89         my @content;
    88         push(@content, $line);
    90         push(@content, $line);
    89         $recipe->{'content'} = \@content;
    91         $recipe->{'content'} = \@content;
    90         
    92         
   116           $recipe->{'armlicence'} = 1;
   118           $recipe->{'armlicence'} = 1;
   117         }  
   119         }  
   118       }
   120       }
   119       elsif($line =~ m/(<status\s.+\/>)/)
   121       elsif($line =~ m/(<status\s.+\/>)/)
   120       {
   122       {
   121         my $status = XMLin($1);
   123         my $status = parseline($1);
   122         if(defined $recipe)
   124         if(defined $recipe)
   123         {
   125         {
   124           $recipe->{'exit'} = $status->{'exit'};
   126           $recipe->{'exit'} = $status->{'exit'};
   125           $recipe->{'attempt'} = $status->{'attempt'};
   127           $recipe->{'attempt'} = $status->{'attempt'};
   126           if(defined $status->{'code'})
   128           if(defined $status->{'code'})
   179     print $line;
   181     print $line;
   180   }              
   182   }              
   181   #print Dumper($recipe);
   183   #print Dumper($recipe);
   182 
   184 
   183 }
   185 }
       
   186 
       
   187 sub parseline($line)
       
   188 {
       
   189   my $line = shift;
       
   190 #  print "\t$line\n";
       
   191   my $val;
       
   192   if($manualparsing)
       
   193   {
       
   194     my $strippedline;    
       
   195     if($line =~ m/<\S+(.+)\/>/)
       
   196     {
       
   197       $strippedline = $1;
       
   198     }
       
   199     elsif($line =~ m/<\S+(.+)>\s*<\/\S+>/)
       
   200     {
       
   201       $strippedline = $1;
       
   202     }
       
   203 #    print $strippedline."\n";
       
   204     my @stuff = split('\s+', $strippedline);
       
   205     my %results;
       
   206     foreach my $pair (@stuff)
       
   207     {
       
   208 #      print $pair."\n";
       
   209       if($pair =~ m/^(\S+)=\'(\S+)\'$/)
       
   210       {
       
   211         $results{$1}=$2;
       
   212       }
       
   213     }
       
   214     $val = \%results;
       
   215   }  
       
   216   else
       
   217   {
       
   218     $val = XMLin($line);
       
   219   }   
       
   220   return $val; 
       
   221 }