common/tools/raptor/package_what.pl
changeset 297 48a6e55f691b
parent 296 cdf0b7c501d2
parent 294 cf05cf95f5d3
child 298 d62ab7f8c779
equal deleted inserted replaced
296:cdf0b7c501d2 297:48a6e55f691b
     1 # Copyright (c) 2009 Symbian Foundation Ltd
       
     2 # This component and the accompanying materials are made available
       
     3 # under the terms of the License "Eclipse Public License v1.0"
       
     4 # which accompanies this distribution, and is available
       
     5 # at the URL "http://www.eclipse.org/legal/epl-v10.html".
       
     6 #
       
     7 # Initial Contributors:
       
     8 # Symbian Foundation Ltd - initial contribution.
       
     9 #
       
    10 # Contributors:
       
    11 #
       
    12 # Description:
       
    13 # Extracts whatlog information from a raptor log file
       
    14 
       
    15 use strict;
       
    16 
       
    17 use XML::SAX;
       
    18 use RaptorSAXHandler;
       
    19 use Getopt::Long;
       
    20 
       
    21 my @logfiles;
       
    22 my $basedir = '';
       
    23 my $append = 0;
       
    24 my $help = 0;
       
    25 GetOptions((
       
    26 	'log:s' => \@logfiles,
       
    27 	'basedir:s' => \$basedir,
       
    28 	'append!' => \$append,
       
    29 	'help!' => \$help
       
    30 ));
       
    31 
       
    32 $help = 1 if (!@logfiles);
       
    33 
       
    34 if ($help)
       
    35 {
       
    36 	print "Extracts whatlog information from a raptor log file\n";
       
    37 	print "Usage: perl package_what.pl --log=FILE1 --log=FILE2 [OPTIONS]\n";
       
    38 	print "where OPTIONS are:\n";
       
    39 	print "\t--basedir=DIR Generate info files under DIR\n";
       
    40 	print "\t--append Do not stop if basedir exists but append newly extracted info to already existing.\n";
       
    41 	exit(0);
       
    42 }
       
    43 
       
    44 my $reset_status = {};
       
    45 my $buildlog_status = {};
       
    46 my $whatlog_status = {};
       
    47 my $bitmap_status = {};
       
    48 my $resource_status = {};
       
    49 my $build_status = {};
       
    50 my $export_status = {};
       
    51 my $stringtable_status = {};
       
    52 my $archive_status = {};
       
    53 my $archive_member_status = {};
       
    54 my $whatlog_default_status = {};
       
    55 
       
    56 $reset_status->{name} = 'reset_status';
       
    57 $reset_status->{next_status} = {buildlog=>$buildlog_status};
       
    58 
       
    59 $buildlog_status->{name} = 'buildlog_status';
       
    60 $buildlog_status->{next_status} = {whatlog=>$whatlog_status};
       
    61 
       
    62 $whatlog_status->{name} = 'whatlog_status';
       
    63 $whatlog_status->{next_status} = {bitmap=>$bitmap_status, resource=>$resource_status, build=>$build_status, export=>$export_status, stringtable=>$stringtable_status, archive=>$archive_status, '?default?'=>$whatlog_default_status};
       
    64 $whatlog_status->{on_start} = 'main::on_start_whatlog';
       
    65 $whatlog_status->{on_end} = 'main::on_end_whatlog';
       
    66 
       
    67 $bitmap_status->{name} = 'bitmap_status';
       
    68 $bitmap_status->{next_status} = {};
       
    69 $bitmap_status->{on_start} = 'main::on_start_bitmap';
       
    70 $bitmap_status->{on_end} = 'main::on_end_whatlog_subtag';
       
    71 $bitmap_status->{on_chars} = 'main::on_chars_whatlog_subtag';
       
    72 
       
    73 $resource_status->{name} = 'resource_status';
       
    74 $resource_status->{next_status} = {};
       
    75 $resource_status->{on_start} = 'main::on_start_resource';
       
    76 $resource_status->{on_end} = 'main::on_end_whatlog_subtag';
       
    77 $resource_status->{on_chars} = 'main::on_chars_whatlog_subtag';
       
    78 
       
    79 $build_status->{name} = 'build_status';
       
    80 $build_status->{next_status} = {};
       
    81 $build_status->{on_start} = 'main::on_start_build';
       
    82 $build_status->{on_end} = 'main::on_end_whatlog_subtag';
       
    83 $build_status->{on_chars} = 'main::on_chars_whatlog_subtag';
       
    84 
       
    85 $stringtable_status->{name} = 'stringtable_status';
       
    86 $stringtable_status->{next_status} = {};
       
    87 $stringtable_status->{on_start} = 'main::on_start_stringtable';
       
    88 $stringtable_status->{on_end} = 'main::on_end_whatlog_subtag';
       
    89 $stringtable_status->{on_chars} = 'main::on_chars_whatlog_subtag';
       
    90 
       
    91 $archive_status->{name} = 'archive_status';
       
    92 $archive_status->{next_status} = {member=>$archive_member_status};
       
    93 
       
    94 $archive_member_status->{name} = 'archive_member_status';
       
    95 $archive_member_status->{next_status} = {};
       
    96 $archive_member_status->{on_start} = 'main::on_start_archive_member';
       
    97 $archive_member_status->{on_end} = 'main::on_end_whatlog_subtag';
       
    98 $archive_member_status->{on_chars} = 'main::on_chars_whatlog_subtag';
       
    99 
       
   100 $export_status->{name} = 'export_status';
       
   101 $export_status->{next_status} = {};
       
   102 $export_status->{on_start} = 'main::on_start_export';
       
   103 
       
   104 $whatlog_default_status->{name} = 'whatlog_default_status';
       
   105 $whatlog_default_status->{next_status} = {};
       
   106 $whatlog_default_status->{on_start} = 'main::on_start_whatlog_default';
       
   107 
       
   108 my $whatlog_info = {};
       
   109 my $curbldinf = 'unknown';
       
   110 my $curconfig = 'unknown';
       
   111 my $curfiletype = 'unknown';
       
   112 my $characters = '';
       
   113 
       
   114 if (!$basedir)
       
   115 {
       
   116 	$basedir = time;
       
   117 	
       
   118 	print "Using $basedir as basedir.\n";
       
   119 }
       
   120 if (-d $basedir)
       
   121 {
       
   122 	if ($append)
       
   123 	{
       
   124 		print "Directory $basedir exists. Appending new info to it.\n";
       
   125 	}
       
   126 	else
       
   127 	{
       
   128 		print "Directory $basedir exists. Quitting.\n";
       
   129 		exit(1);
       
   130 	}
       
   131 }
       
   132 mkdir($basedir);
       
   133 #print "Created dir $basedir.\n";
       
   134 
       
   135 my $saxhandler = RaptorSAXHandler->new();
       
   136 $saxhandler->set_init_status($reset_status);
       
   137 my $parser = XML::SAX::ParserFactory->parser(Handler=>$saxhandler);
       
   138 for (@logfiles)
       
   139 {
       
   140 	$parser->parse_uri($_);
       
   141 }
       
   142 
       
   143 
       
   144 sub on_start_whatlog
       
   145 {
       
   146 	my ($el) = @_;
       
   147 	
       
   148 	#print "on_start_whatlog\n";
       
   149 	
       
   150 	$whatlog_info = {};
       
   151 	
       
   152 	my $bldinf = '';
       
   153 	my $config = '';
       
   154 	my $attributes = $el->{Attributes};
       
   155 	for (keys %{$attributes})
       
   156 	{
       
   157 		#print "reading attribute $_\n";
       
   158 		if ($attributes->{$_}->{'LocalName'} eq 'bldinf')
       
   159 		{
       
   160 			$bldinf = $attributes->{$_}->{'Value'};
       
   161 			#print "bldinf=$bldinf\n";
       
   162 		}
       
   163 		elsif ($attributes->{$_}->{'LocalName'} eq 'config')
       
   164 		{
       
   165 			$config = $attributes->{$_}->{'Value'};
       
   166 			$config =~ s,\.whatlog$,,;
       
   167 		}
       
   168 	}
       
   169 	
       
   170 	if ($bldinf eq '')
       
   171 	{
       
   172 		print "WARNING: whatlog tag with no bldinf attribute. Skipping\n";
       
   173 		return;
       
   174 	}
       
   175 	
       
   176 	$curbldinf = $bldinf;
       
   177 	$curconfig = $config;
       
   178 	$whatlog_info->{$curbldinf} = {} if (!defined $whatlog_info->{$curbldinf});
       
   179 	$whatlog_info->{$curbldinf}->{$curconfig} = {} if (!defined $whatlog_info->{$curbldinf}->{$curconfig});
       
   180 }
       
   181 
       
   182 sub on_start_whatlog_subtag
       
   183 {
       
   184 	my ($ft) = @_;
       
   185 	
       
   186 	$curfiletype = $ft;
       
   187 	$characters = '';
       
   188 	$whatlog_info->{$curbldinf}->{$curconfig}->{$curfiletype} = [] if (! defined $whatlog_info->{$curbldinf}->{$curconfig}->{$curfiletype});
       
   189 }
       
   190 
       
   191 sub on_chars_whatlog_subtag
       
   192 {
       
   193 	my ($ch) = @_;
       
   194 	
       
   195 	$characters .= $ch->{Data};
       
   196 	
       
   197 	#print "characters is now -->$characters<--\n";
       
   198 }
       
   199 
       
   200 sub on_end_whatlog_subtag
       
   201 {
       
   202 	$characters = normalize_filepath($characters);
       
   203 	
       
   204 	push(@{$whatlog_info->{$curbldinf}->{$curconfig}->{$curfiletype}}, $characters);
       
   205 	
       
   206 	$curfiletype = 'unknown';
       
   207 	$characters = '';
       
   208 }
       
   209 
       
   210 sub on_start_bitmap
       
   211 {
       
   212 	on_start_whatlog_subtag('bitmap');
       
   213 }
       
   214 
       
   215 sub on_start_resource
       
   216 {
       
   217 	on_start_whatlog_subtag('resource');
       
   218 }
       
   219 
       
   220 sub on_start_build
       
   221 {
       
   222 	on_start_whatlog_subtag('build');
       
   223 }
       
   224 
       
   225 sub on_start_stringtable
       
   226 {
       
   227 	on_start_whatlog_subtag('stringtable');
       
   228 }
       
   229 
       
   230 sub on_start_archive_member
       
   231 {
       
   232 	on_start_whatlog_subtag('export');
       
   233 }
       
   234 
       
   235 sub on_start_export
       
   236 {
       
   237 	my ($el) = @_;
       
   238 	
       
   239 	$whatlog_info->{$curbldinf}->{$curconfig}->{export} = [] if (! defined $whatlog_info->{$curbldinf}->{$curconfig}->{export});
       
   240 	
       
   241 	my $destination = '';
       
   242 	my $attributes = $el->{Attributes};
       
   243 	for (keys %{$attributes})
       
   244 	{
       
   245 		#print "reading attribute $_\n";
       
   246 		if ($attributes->{$_}->{'LocalName'} eq 'destination')
       
   247 		{
       
   248 			$destination = $attributes->{$_}->{'Value'};
       
   249 			#print "destination=$destination\n";
       
   250 			last;
       
   251 		}
       
   252 	}
       
   253 	
       
   254 	if ($destination eq '')
       
   255 	{
       
   256 		print "WARNING: export tag with no destination attribute. Skipping\n";
       
   257 		return;
       
   258 	}
       
   259 	
       
   260 	$destination = normalize_filepath($destination);
       
   261 	
       
   262 	push(@{$whatlog_info->{$curbldinf}->{$curconfig}->{export}}, $destination);
       
   263 }
       
   264 
       
   265 sub on_end_whatlog
       
   266 {
       
   267 	my $unknown_counter = 0;
       
   268 	
       
   269 	for my $bldinf (keys %{$whatlog_info})
       
   270 	{
       
   271 		for my $config (keys %{$whatlog_info->{$bldinf}})
       
   272 		{
       
   273 			my $normalized = lc($bldinf);
       
   274 			$normalized =~ s,^[A-Za-z]:,,;
       
   275 			$normalized =~ s,[\\],/,g;
       
   276 			
       
   277 			$normalized =~ m,^/sf/([^/]+)/([^/]+)/,;
       
   278 			my $layer = $1;
       
   279 			my $package = $2;
       
   280 			
       
   281 			mkdir("$basedir/$layer");
       
   282 			mkdir("$basedir/$layer/$package");
       
   283 			
       
   284 			my $filename = "$basedir/$layer/$package/info.tsv";
       
   285 			
       
   286 			print "Writing info file $filename\n" if (!-f$filename);
       
   287 			open(FILE, ">>$filename");
       
   288 			
       
   289 			for my $filetype (keys %{$whatlog_info->{$bldinf}->{$config}})
       
   290 			{
       
   291 				for (sort(@{$whatlog_info->{$bldinf}->{$config}->{$filetype}}))
       
   292 				{
       
   293 					print FILE "$_\t$filetype\t$config\n";
       
   294 				}
       
   295 			}
       
   296 			
       
   297 			close(FILE);
       
   298 		}
       
   299 	}
       
   300 }
       
   301 
       
   302 sub normalize_filepath
       
   303 {
       
   304 	my ($filepath) = @_;
       
   305 	
       
   306 	if ($filepath =~ m,[^\s^\r^\n]+(.*)[\r\n]+(.*)[^\s^\r^\n]+,)
       
   307 	{
       
   308 		print "WARNING: file path string extends over multiple line: $filepath. Removing all NL's and CR's\n";
       
   309 	}
       
   310 	
       
   311 	# strip all CR's and NL's
       
   312 	$filepath =~ s,[\r\n],,g;
       
   313 	
       
   314 	# strip all whitespaces at string start/end
       
   315 	$filepath =~ s,^\s+,,g;
       
   316 	$filepath =~ s,\s+$,,g;
       
   317 	
       
   318 	# remove drive letter and colon from the beginning of the string
       
   319 	$filepath =~ s,^[A-Za-z]:,,;
       
   320 	
       
   321 	# normalize slashes
       
   322 	$filepath =~ s,\\,/,g;
       
   323 	$filepath =~ s,//,/,g;
       
   324 	
       
   325 	if ($filepath !~ m,^/epoc32/,i)
       
   326 	{
       
   327 		print "WARNING: file '$filepath' doesn't seem valid. Writing to info file anyway\n";
       
   328 	}
       
   329 	
       
   330 	return $filepath;
       
   331 }
       
   332 
       
   333 sub on_start_whatlog_default
       
   334 {
       
   335 	my ($el) = @_;
       
   336 	
       
   337 	my $tagname = $el->{LocalName};
       
   338 	
       
   339 	print "WARNING: unsupported tag '$tagname' in <whatlog> context\n";
       
   340 }