uh_parser/releaseables.pm
changeset 177 6d3c3db11e72
child 215 a403724f631c
equal deleted inserted replaced
176:266a7e9b9237 177:6d3c3db11e72
       
     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 # Raptor parser module.
       
    14 # Extract releaseable (whatlog) information
       
    15 
       
    16 package releaseables;
       
    17 
       
    18 use strict;
       
    19 
       
    20 our $reset_status = {};
       
    21 my $buildlog_status = {};
       
    22 my $whatlog_status = {};
       
    23 my $bitmap_status = {};
       
    24 my $resource_status = {};
       
    25 my $build_status = {};
       
    26 my $export_status = {};
       
    27 my $stringtable_status = {};
       
    28 my $archive_status = {};
       
    29 my $archive_member_status = {};
       
    30 my $whatlog_default_status = {};
       
    31 
       
    32 $reset_status->{name} = 'reset_status';
       
    33 $reset_status->{next_status} = {buildlog=>$buildlog_status};
       
    34 
       
    35 $buildlog_status->{name} = 'buildlog_status';
       
    36 $buildlog_status->{next_status} = {whatlog=>$whatlog_status};
       
    37 $buildlog_status->{on_start} = 'releaseables::on_start_buildlog';
       
    38 
       
    39 $whatlog_status->{name} = 'whatlog_status';
       
    40 $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};
       
    41 $whatlog_status->{on_start} = 'releaseables::on_start_whatlog';
       
    42 $whatlog_status->{on_end} = 'releaseables::on_end_whatlog';
       
    43 
       
    44 $bitmap_status->{name} = 'bitmap_status';
       
    45 $bitmap_status->{next_status} = {};
       
    46 $bitmap_status->{on_start} = 'releaseables::on_start_bitmap';
       
    47 $bitmap_status->{on_end} = 'releaseables::on_end_whatlog_subtag';
       
    48 $bitmap_status->{on_chars} = 'releaseables::on_chars_whatlog_subtag';
       
    49 
       
    50 $resource_status->{name} = 'resource_status';
       
    51 $resource_status->{next_status} = {};
       
    52 $resource_status->{on_start} = 'releaseables::on_start_resource';
       
    53 $resource_status->{on_end} = 'releaseables::on_end_whatlog_subtag';
       
    54 $resource_status->{on_chars} = 'releaseables::on_chars_whatlog_subtag';
       
    55 
       
    56 $build_status->{name} = 'build_status';
       
    57 $build_status->{next_status} = {};
       
    58 $build_status->{on_start} = 'releaseables::on_start_build';
       
    59 $build_status->{on_end} = 'releaseables::on_end_whatlog_subtag';
       
    60 $build_status->{on_chars} = 'releaseables::on_chars_whatlog_subtag';
       
    61 
       
    62 $stringtable_status->{name} = 'stringtable_status';
       
    63 $stringtable_status->{next_status} = {};
       
    64 $stringtable_status->{on_start} = 'releaseables::on_start_stringtable';
       
    65 $stringtable_status->{on_end} = 'releaseables::on_end_whatlog_subtag';
       
    66 $stringtable_status->{on_chars} = 'releaseables::on_chars_whatlog_subtag';
       
    67 
       
    68 $archive_status->{name} = 'archive_status';
       
    69 $archive_status->{next_status} = {member=>$archive_member_status};
       
    70 
       
    71 $archive_member_status->{name} = 'archive_member_status';
       
    72 $archive_member_status->{next_status} = {};
       
    73 $archive_member_status->{on_start} = 'releaseables::on_start_archive_member';
       
    74 $archive_member_status->{on_end} = 'releaseables::on_end_whatlog_subtag';
       
    75 $archive_member_status->{on_chars} = 'releaseables::on_chars_whatlog_subtag';
       
    76 
       
    77 $export_status->{name} = 'export_status';
       
    78 $export_status->{next_status} = {};
       
    79 $export_status->{on_start} = 'releaseables::on_start_export';
       
    80 
       
    81 $whatlog_default_status->{name} = 'whatlog_default_status';
       
    82 $whatlog_default_status->{next_status} = {};
       
    83 $whatlog_default_status->{on_start} = 'releaseables::on_start_whatlog_default';
       
    84 
       
    85 my $whatlog_info = {};
       
    86 my $curbldinf = 'unknown';
       
    87 my $curconfig = 'unknown';
       
    88 my $curfiletype = 'unknown';
       
    89 my $characters = '';
       
    90 
       
    91 sub on_start_buildlog
       
    92 {
       
    93 	
       
    94 }
       
    95 
       
    96 sub on_start_whatlog
       
    97 {
       
    98 	my ($el) = @_;
       
    99 	
       
   100 	$whatlog_info = {};
       
   101 	
       
   102 	my $bldinf = '';
       
   103 	my $config = '';
       
   104 	my $attributes = $el->{Attributes};
       
   105 	for (keys %{$attributes})
       
   106 	{
       
   107 		#print "reading attribute $_\n";
       
   108 		if ($attributes->{$_}->{'LocalName'} eq 'bldinf')
       
   109 		{
       
   110 			$bldinf = $attributes->{$_}->{'Value'};
       
   111 			#print "bldinf=$bldinf\n";
       
   112 		}
       
   113 		elsif ($attributes->{$_}->{'LocalName'} eq 'config')
       
   114 		{
       
   115 			$config = $attributes->{$_}->{'Value'};
       
   116 			$config =~ s,\.whatlog$,,;
       
   117 		}
       
   118 	}
       
   119 	
       
   120 	if ($bldinf eq '')
       
   121 	{
       
   122 		print "WARNING: whatlog tag with no bldinf attribute. Skipping\n";
       
   123 		return;
       
   124 	}
       
   125 	
       
   126 	$curbldinf = $bldinf;
       
   127 	$curconfig = $config;
       
   128 	$whatlog_info->{$curbldinf} = {} if (!defined $whatlog_info->{$curbldinf});
       
   129 	$whatlog_info->{$curbldinf}->{$curconfig} = {} if (!defined $whatlog_info->{$curbldinf}->{$curconfig});
       
   130 }
       
   131 
       
   132 sub on_start_whatlog_subtag
       
   133 {
       
   134 	my ($ft) = @_;
       
   135 	
       
   136 	$curfiletype = $ft;
       
   137 	$characters = '';
       
   138 	$whatlog_info->{$curbldinf}->{$curconfig}->{$curfiletype} = [] if (! defined $whatlog_info->{$curbldinf}->{$curconfig}->{$curfiletype});
       
   139 }
       
   140 
       
   141 sub on_chars_whatlog_subtag
       
   142 {
       
   143 	my ($ch) = @_;
       
   144 	
       
   145 	$characters .= $ch->{Data};
       
   146 	
       
   147 	#print "characters is now -->$characters<--\n";
       
   148 }
       
   149 
       
   150 sub on_end_whatlog_subtag
       
   151 {
       
   152 	$characters = normalize_filepath($characters);
       
   153 	
       
   154 	push(@{$whatlog_info->{$curbldinf}->{$curconfig}->{$curfiletype}}, $characters);
       
   155 	
       
   156 	$curfiletype = 'unknown';
       
   157 	$characters = '';
       
   158 }
       
   159 
       
   160 sub on_start_bitmap
       
   161 {
       
   162 	on_start_whatlog_subtag('bitmap');
       
   163 }
       
   164 
       
   165 sub on_start_resource
       
   166 {
       
   167 	on_start_whatlog_subtag('resource');
       
   168 }
       
   169 
       
   170 sub on_start_build
       
   171 {
       
   172 	on_start_whatlog_subtag('build');
       
   173 }
       
   174 
       
   175 sub on_start_stringtable
       
   176 {
       
   177 	on_start_whatlog_subtag('stringtable');
       
   178 }
       
   179 
       
   180 sub on_start_archive_member
       
   181 {
       
   182 	on_start_whatlog_subtag('export');
       
   183 }
       
   184 
       
   185 sub on_start_export
       
   186 {
       
   187 	my ($el) = @_;
       
   188 	
       
   189 	$whatlog_info->{$curbldinf}->{$curconfig}->{export} = [] if (! defined $whatlog_info->{$curbldinf}->{$curconfig}->{export});
       
   190 	
       
   191 	my $destination = '';
       
   192 	my $attributes = $el->{Attributes};
       
   193 	for (keys %{$attributes})
       
   194 	{
       
   195 		#print "reading attribute $_\n";
       
   196 		if ($attributes->{$_}->{'LocalName'} eq 'destination')
       
   197 		{
       
   198 			$destination = $attributes->{$_}->{'Value'};
       
   199 			#print "destination=$destination\n";
       
   200 			last;
       
   201 		}
       
   202 	}
       
   203 	
       
   204 	if ($destination eq '')
       
   205 	{
       
   206 		print "WARNING: export tag with no destination attribute. Skipping\n";
       
   207 		return;
       
   208 	}
       
   209 	
       
   210 	$destination = normalize_filepath($destination);
       
   211 	
       
   212 	push(@{$whatlog_info->{$curbldinf}->{$curconfig}->{export}}, $destination);
       
   213 }
       
   214 
       
   215 sub on_end_whatlog
       
   216 {
       
   217 	my $unknown_counter = 0;
       
   218 	
       
   219 	for my $bldinf (keys %{$whatlog_info})
       
   220 	{
       
   221 		for my $config (keys %{$whatlog_info->{$bldinf}})
       
   222 		{
       
   223 			my $normalized = lc($bldinf);
       
   224 			$normalized =~ s,^[A-Za-z]:,,;
       
   225 			$normalized =~ s,[\\],/,g;
       
   226 			
       
   227 			$normalized =~ m,^/sf/([^/]+)/([^/]+)/,;
       
   228 			my $layer = $1;
       
   229 			my $package = $2;
       
   230 			
       
   231 			mkdir("$::basedir/releaseables/$layer");
       
   232 			mkdir("$::basedir/releaseables/$layer/$package");
       
   233 			
       
   234 			my $filename = "$::basedir/releaseables/$layer/$package/info.tsv";
       
   235 			
       
   236 			print "Writing info file $filename\n" if (!-f$filename);
       
   237 			open(FILE, ">>$filename");
       
   238 			
       
   239 			for my $filetype (keys %{$whatlog_info->{$bldinf}->{$config}})
       
   240 			{
       
   241 				for (sort(@{$whatlog_info->{$bldinf}->{$config}->{$filetype}}))
       
   242 				{
       
   243 					print FILE "$_\t$filetype\t$config\n";
       
   244 				}
       
   245 			}
       
   246 			
       
   247 			close(FILE);
       
   248 		}
       
   249 	}
       
   250 }
       
   251 
       
   252 sub normalize_filepath
       
   253 {
       
   254 	my ($filepath) = @_;
       
   255 	
       
   256 	if ($filepath =~ m,[^\s^\r^\n]+(.*)[\r\n]+(.*)[^\s^\r^\n]+,)
       
   257 	{
       
   258 		print "WARNING: file path string extends over multiple line: $filepath. Removing all NL's and CR's\n";
       
   259 	}
       
   260 	
       
   261 	# strip all CR's and NL's
       
   262 	$filepath =~ s,[\r\n],,g;
       
   263 	
       
   264 	# strip all whitespaces at string start/end
       
   265 	$filepath =~ s,^\s+,,g;
       
   266 	$filepath =~ s,\s+$,,g;
       
   267 	
       
   268 	# remove drive letter and colon from the beginning of the string
       
   269 	$filepath =~ s,^[A-Za-z]:,,;
       
   270 	
       
   271 	# normalize slashes
       
   272 	$filepath =~ s,\\,/,g;
       
   273 	$filepath =~ s,//,/,g;
       
   274 	
       
   275 	if ($filepath !~ m,^/epoc32/,i)
       
   276 	{
       
   277 		print "WARNING: file '$filepath' doesn't seem valid. Writing to info file anyway\n";
       
   278 	}
       
   279 	
       
   280 	return $filepath;
       
   281 }
       
   282 
       
   283 sub on_start_whatlog_default
       
   284 {
       
   285 	my ($el) = @_;
       
   286 	
       
   287 	my $tagname = $el->{LocalName};
       
   288 	
       
   289 	print "WARNING: unsupported tag '$tagname' in <whatlog> context\n";
       
   290 }
       
   291 
       
   292 1;