Make BC testing more robust. Now requires PDT_HOME env var to be set rather than fail silently. Plus Logs zip tidy up.
# Copyright (c) 2009 Symbian Foundation Ltd
# This component and the accompanying materials are made available
# under the terms of the License "Eclipse Public License v1.0"
# which accompanies this distribution, and is available
# at the URL "http://www.eclipse.org/legal/epl-v10.html".
#
# Initial Contributors:
# Symbian Foundation Ltd - initial contribution.
#
# Contributors:
#
# Description:
# Raptor parser module.
# Extract releaseable (whatlog) information
package RaptorReleaseable;
use strict;
use RaptorCommon;
our $reset_status = {};
my $buildlog_status = {};
my $whatlog_status = {};
my $bitmap_status = {};
my $resource_status = {};
my $build_status = {};
my $export_status = {};
my $stringtable_status = {};
my $archive_status = {};
my $archive_member_status = {};
my $whatlog_default_status = {};
$reset_status->{name} = 'reset_status';
$reset_status->{next_status} = {buildlog=>$buildlog_status};
$buildlog_status->{name} = 'buildlog_status';
$buildlog_status->{next_status} = {whatlog=>$whatlog_status};
$whatlog_status->{name} = 'whatlog_status';
$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};
$whatlog_status->{on_start} = 'RaptorReleaseable::on_start_whatlog';
$whatlog_status->{on_end} = 'RaptorReleaseable::on_end_whatlog';
$bitmap_status->{name} = 'bitmap_status';
$bitmap_status->{next_status} = {};
$bitmap_status->{on_start} = 'RaptorReleaseable::on_start_bitmap';
$bitmap_status->{on_end} = 'RaptorReleaseable::on_end_whatlog_subtag';
$bitmap_status->{on_chars} = 'RaptorReleaseable::on_chars_whatlog_subtag';
$resource_status->{name} = 'resource_status';
$resource_status->{next_status} = {};
$resource_status->{on_start} = 'RaptorReleaseable::on_start_resource';
$resource_status->{on_end} = 'RaptorReleaseable::on_end_whatlog_subtag';
$resource_status->{on_chars} = 'RaptorReleaseable::on_chars_whatlog_subtag';
$build_status->{name} = 'build_status';
$build_status->{next_status} = {};
$build_status->{on_start} = 'RaptorReleaseable::on_start_build';
$build_status->{on_end} = 'RaptorReleaseable::on_end_whatlog_subtag';
$build_status->{on_chars} = 'RaptorReleaseable::on_chars_whatlog_subtag';
$stringtable_status->{name} = 'stringtable_status';
$stringtable_status->{next_status} = {};
$stringtable_status->{on_start} = 'RaptorReleaseable::on_start_stringtable';
$stringtable_status->{on_end} = 'RaptorReleaseable::on_end_whatlog_subtag';
$stringtable_status->{on_chars} = 'RaptorReleaseable::on_chars_whatlog_subtag';
$archive_status->{name} = 'archive_status';
$archive_status->{next_status} = {member=>$archive_member_status};
$archive_member_status->{name} = 'archive_member_status';
$archive_member_status->{next_status} = {};
$archive_member_status->{on_start} = 'RaptorReleaseable::on_start_archive_member';
$archive_member_status->{on_end} = 'RaptorReleaseable::on_end_whatlog_subtag';
$archive_member_status->{on_chars} = 'RaptorReleaseable::on_chars_whatlog_subtag';
$export_status->{name} = 'export_status';
$export_status->{next_status} = {};
$export_status->{on_start} = 'RaptorReleaseable::on_start_export';
$whatlog_default_status->{name} = 'whatlog_default_status';
$whatlog_default_status->{next_status} = {};
$whatlog_default_status->{on_start} = 'RaptorReleaseable::on_start_whatlog_default';
my $whatlog_info = {};
my $curbldinf = 'unknown';
my $curconfig = 'unknown';
my $curfiletype = 'unknown';
my $characters = '';
sub on_start_whatlog
{
my ($el) = @_;
$whatlog_info = {};
my $bldinf = '';
my $config = '';
my $attributes = $el->{Attributes};
for (keys %{$attributes})
{
#print "reading attribute $_\n";
if ($attributes->{$_}->{'LocalName'} eq 'bldinf')
{
$bldinf = $attributes->{$_}->{'Value'};
#print "bldinf=$bldinf\n";
}
elsif ($attributes->{$_}->{'LocalName'} eq 'config')
{
$config = $attributes->{$_}->{'Value'};
$config =~ s,\.whatlog$,,;
}
}
if ($bldinf eq '')
{
print "WARNING: whatlog tag with no bldinf attribute. Skipping\n";
return;
}
$curbldinf = $bldinf;
$curconfig = $config;
$whatlog_info->{$curbldinf} = {} if (!defined $whatlog_info->{$curbldinf});
$whatlog_info->{$curbldinf}->{$curconfig} = {} if (!defined $whatlog_info->{$curbldinf}->{$curconfig});
}
sub on_start_whatlog_subtag
{
my ($ft) = @_;
$curfiletype = $ft;
$characters = '';
$whatlog_info->{$curbldinf}->{$curconfig}->{$curfiletype} = [] if (! defined $whatlog_info->{$curbldinf}->{$curconfig}->{$curfiletype});
}
sub on_chars_whatlog_subtag
{
my ($ch) = @_;
$characters .= $ch->{Data};
#print "characters is now -->$characters<--\n";
}
sub on_end_whatlog_subtag
{
$characters = normalize_filepath($characters);
push(@{$whatlog_info->{$curbldinf}->{$curconfig}->{$curfiletype}}, $characters);
$curfiletype = 'unknown';
$characters = '';
}
sub on_start_bitmap
{
on_start_whatlog_subtag('bitmap');
}
sub on_start_resource
{
on_start_whatlog_subtag('resource');
}
sub on_start_build
{
on_start_whatlog_subtag('build');
}
sub on_start_stringtable
{
on_start_whatlog_subtag('stringtable');
}
sub on_start_archive_member
{
on_start_whatlog_subtag('export');
}
sub on_start_export
{
my ($el) = @_;
$whatlog_info->{$curbldinf}->{$curconfig}->{export} = [] if (! defined $whatlog_info->{$curbldinf}->{$curconfig}->{export});
my $destination = '';
my $attributes = $el->{Attributes};
for (keys %{$attributes})
{
#print "reading attribute $_\n";
if ($attributes->{$_}->{'LocalName'} eq 'destination')
{
$destination = $attributes->{$_}->{'Value'};
#print "destination=$destination\n";
last;
}
}
if ($destination eq '')
{
print "WARNING: export tag with no destination attribute. Skipping\n";
return;
}
$destination = normalize_filepath($destination);
push(@{$whatlog_info->{$curbldinf}->{$curconfig}->{export}}, $destination);
}
sub on_end_whatlog
{
my $unknown_counter = 0;
for my $bldinf (keys %{$whatlog_info})
{
for my $config (keys %{$whatlog_info->{$bldinf}})
{
my $normalized = lc($bldinf);
$normalized =~ s,^[A-Za-z]:,,;
$normalized =~ s,[\\],/,g;
$normalized =~ m,^/sf/([^/]+)/([^/]+)/,;
my $layer = $1;
my $package = $2;
mkdir("$::basedir/releaseables");
mkdir("$::basedir/releaseables/$layer");
mkdir("$::basedir/releaseables/$layer/$package");
my $filename = "$::basedir/releaseables/$layer/$package/info.tsv";
print "Writing info file $filename\n" if (!-f$filename);
open(FILE, ">>$filename");
for my $filetype (keys %{$whatlog_info->{$bldinf}->{$config}})
{
for (sort(@{$whatlog_info->{$bldinf}->{$config}->{$filetype}}))
{
print FILE "$_\t$filetype\t$config\n";
}
}
close(FILE);
}
}
}
sub normalize_filepath
{
my ($filepath) = @_;
if ($filepath =~ m,[^\s^\r^\n]+(.*)[\r\n]+(.*)[^\s^\r^\n]+,)
{
print "WARNING: file path string extends over multiple line: $filepath. Removing all NL's and CR's\n";
}
# strip all CR's and NL's
$filepath =~ s,[\r\n],,g;
# strip all whitespaces at string start/end
$filepath =~ s,^\s+,,g;
$filepath =~ s,\s+$,,g;
# remove drive letter and colon from the beginning of the string
$filepath =~ s,^[A-Za-z]:,,;
# normalize slashes
$filepath =~ s,\\,/,g;
$filepath =~ s,//,/,g;
if ($filepath !~ m,^/epoc32/,i)
{
print "WARNING: file '$filepath' doesn't seem valid. Writing to info file anyway\n";
}
return $filepath;
}
sub on_start_whatlog_default
{
my ($el) = @_;
my $tagname = $el->{LocalName};
print "WARNING: unsupported tag '$tagname' in <whatlog> context\n";
}
1;