#!perl

# ziplog2pkg.pm

# Copyright (c) 1997-2009 Nokia Corporation and/or its subsidiary(-ies).

# All rights reserved.

# This component and the accompanying materials are made available

# under the terms of "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:

# Nokia Corporation - initial contribution.

#

# Contributors:

#

# Description:

#

use strict;

package ZipLog2Pkg;

use File::Path;

use CProgressLog;

use KitStandardLocations;

my $log;

my %stdVars = ();

# --------------------------------- Start of ZipLog2Pkg() ----------------------------

sub ZipLog2Pkg($$)

{

	my $cmdfile = shift;

	my $parameters = shift;

	my @options = grep(/^-/,$parameters);

	my $verbose = 1;

	foreach my $option (@options)

		{

		if ($option eq "-v")

			{

			$verbose = 2;

			}

		elsif (($option eq "-batch") || ($option eq "-b"))

			{

			$verbose = 0;

			}

		else

			{

			print "WARNING: Option '$option' not understood; ignoring\n";

			}

		}

	# set up hash containing variables defined in KitStandardLocations.pm

	foreach my $var (@KitStandardLocations::EXPORT)

		{

		$var =~ s/\$//;

		eval{

			no strict 'refs';

			$stdVars{"%".$var."%"} = "$$var";

			};

		} 

	my $PlatformProductToolsDir = $FindBin::Bin;

	$PlatformProductToolsDir =~ s/common/$KitStandardLocations::Platform/i;    # change "common" to platform name in path to tools directory

	$stdVars{"%baseline%"} = "$PlatformProductToolsDir\\baseline";

	$log = New CProgressLog($verbose);

	open (CMDFILE, "<$cmdfile") or print "Unable to open $cmdfile - $!\n" ;

	my $packages = {};

	my @files;

	my @usedFiles;

	my $version;

	my @global_map;

	$global_map[0] = "";				# global map from

	$global_map[1] = "[emul]\\";		# global map to

	foreach my $line (<CMDFILE>)

		{

		chomp($line);

		if ($line =~ /^#/)

			{

			print "\n$line\n" # Printable comment

			}

		elsif (($line =~ /^\/\//) || ($line =~ /^\s*$/))

			{

			# Nonprintable comment or blank line

			}

		else

			{

			# replace standard variables in @params

			if ($line =~ /%/)

			{

				$line = replaceStdVars ($line)

			}		

			my @parms = split(" ", $line);

			# Recombine quoted entries

			for (my $index=0; $index < scalar(@parms); $index++)

				{

				if ($parms[$index] =~ /^\"/)

					{

					# If double quoted

					my $entry = $parms[$index];

					while ( ($entry !~ /\"$/) && ( ($index+1) < scalar(@parms) ) )

						{

						# If end quote not found, merge following entry 

						$entry = $entry." ".$parms[$index+1];

						splice @parms, $index+1, 1;

						}

					if ($entry !~ /\"$/)

						{

						if ($entry =~ /^\"[^\"]*$/)

							{

							die "'$line' invalid: Opening quote must have corresponding close quote\n";

							}

						else

							{

							die "'$line' invalid: Close quote must come at end of parameter\n";

							}

						}

					# Store combined quoted entries

					$entry =~ s/^\"//;

					$entry =~ s/\"$//;

					splice @parms, $index, 1, $entry;

					}

				elsif ($parms[$index] =~ /^'/)

					{

					# If single quoted

					my $entry = $parms[$index];

					while ( ($entry !~ /'$/) && ( ($index+1) < scalar(@parms) ) )

						{

						# If end quote not found, merge following entry 

						$entry = $entry." ".$parms[$index+1];

						splice @parms, $index+1, 1;

						}

					if ($entry !~ /'$/)

						{

						if ($entry =~ /^'[^']*$/)

							{

							die "'$line' invalid: Opening quote must have corresponding close quote\n";

							}

						else

							{

							die "'$line' invalid: Close quote must come at end of parameter\n";

							}

						}

					# Store combined quoted entries

					$entry =~ s/^'//;

					$entry =~ s/'$//;

					splice @parms, $index, 1, $entry;

					}

				}

			my $command = shift @parms;

			$command = lc($command);

			if (($command eq "load") or ($command eq "add"))

				{

				if ($command eq "load")

					{

					# Don't append this; clear first

					if (scalar(@files)>0)

						{

						$log->Warn("WARNING: ".scalar(@files)." files discarded.");

						}

					@files = ();

					}

				if (scalar(@parms) != 1)

					{

					die "'$line' invalid:\nExpected only one parameter (ziplog filename)\n";

					}

				my @new;

				if ($parms[0] =~ /^#/)

					{

					my $file = $parms[0];

					$file =~ s/^#//;

					@new = @{readFileList($file)};

					}

				else

					{

					@new = @{readZiplog($parms[0])};

					}

				$log->Progress("");

				my $orig = scalar(@files);

				@files = (@files, @new);

				# Clear any additional duplicated items

				@files = @{removeDuplicates(\@files, 1)};

				# Don't load in any lines that were previously loaded

				# (add in @usedFiles twice, remove all duplicates)

				@files = (@usedFiles, @usedFiles, @files);

				@files = @{removeDuplicates(\@files, 0)}; # Removes all

				        # of the @used files added, plus any of those which

						# matched the original @files too

				$log->Progress("Loaded $parms[0]. ".scalar(@new)." files (".(scalar(@new)+$orig-scalar(@files))." duplicates)");

				}

			elsif ($command eq "patch")

				{

				if (scalar(@parms) != 1)

					{

					die "'$line' invalid:\nExpected only one parameter (file list filename)\n";

					}

				my $file = $parms[0];

				if ($file =~ /^#/)

					{

					$file=~s/^#//;

					}

				else

					{

					$log->Error("ERROR: Patch file should be prefixed with a '#' to specify filelist.\nAttempting default of filelist.");

					}

				# Read file list in

				my @filelist = @{readFileList($file)};

				# Add them back in to files to match

				my $orig = scalar(@files);

				@files = (@files, @filelist);

				@files = @{removeDuplicates(\@files, 1)};

				# Take them out of files already matched

				# (so a load containing one of them won't eliminate it)

				@usedFiles = (@usedFiles, @filelist, @filelist);

				@usedFiles = @{removeDuplicates(\@usedFiles, 0)};

				$log->Progress("Loaded $parms[0]. ".scalar(@filelist)." files (".(scalar(@filelist)+$orig-scalar(@files))." duplicates)");

				}

			elsif ($command eq "create")

				{

				# Create package list

				if (scalar(@parms) < 2)

					{

					die "'$line' invalid:\nExpected at least 2 parameters (package name, device name, [dependencies ...])\n";

					}

				# Parms: packagePath, device, dependencies...

				my $packagePath = shift @parms;

				my $device = shift @parms;

				my $packageName = $packagePath;

				$packageName =~ s/^.*[\/\\]//;

				$packagePath =~ s/[\/\\][^\/\\]+$/\\/ or $packagePath = "";

				if ($packageName eq "null")

					{

					die "'$line' invalid:\nCannot create package named 'null'. This name is reserved for files not to be written\n";

					}

				$packages->{$packageName} = [$packagePath, $device, [], \@parms, [], [], \@global_map, "", "", "", []];

				}

			elsif ($command eq "path")

				{

				# Parms: packageName, path to add

				if (scalar(@parms) != 2)

					{

					die "'$line' invalid:\nExpected 2 parameters (package name, path to add)\n";

					}

				my $packageName = shift @parms;

				my $path = shift @parms;

				my ($packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags) = @{$packages->{$packageName}};

				push @$paths, $path;

				$packages->{$packageName} = [$packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags];

				}

			elsif ($command eq "menu")

				{

				# Parms: package name, menu entry, description, working path, file path [arguments, icon path]

				if (scalar(@parms) < 5)

					{

					die "'$line' invalid:\nExpected at least 5 parameters (package name, menu entry, description, working path, file path, arguments, icon path)\n";

					}

				my ($packageName,$entry,$desc,$path,$file,$args,$icon) = @parms;

				my ($packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags) = @{$packages->{$packageName}};

				push @$menu, [$entry, $desc, $path, $file, $args, $icon];

				$packages->{$packageName} = [$packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags];

				}

			elsif ($command eq "map_global")

				{

				# Parms: global map from, global map to

				if (scalar(@parms) != 2)

					{

					die "'$line' invalid:\nExpected 2 parameters (global map from, global map to)\n";

					}

				@global_map = @parms;

				}

			elsif ($command eq "map")

				{

				# Parms: packageName, map from, map to

				if (scalar(@parms) != 3)

					{

					die "'$line' invalid:\nExpected 3 parameters (package name, map from, map to)\n";

					}

				my ($packageName, $from, $to) = @parms;

				my ($packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags) = @{$packages->{$packageName}};

				$packages->{$packageName} = [$packagePath, $device, $files, $dependencies, $paths, $menu, [$from, $to], $category, $description, $licence, $tags];

				}

			elsif ($command eq "category")

				{	

				# Parms: packageName, category

				if (scalar(@parms) < 2)

					{

					die "'$line' invalid:\nExpected 2 parameters (package name, category)\n";

					}

				my $packageName = shift @parms;

				my ($packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags) = @{$packages->{$packageName}};

				my $category = shift @parms;

				$packages->{$packageName} = [$packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags];

				}

			elsif ($command eq "description")

				{

				# Parms: packageName, description

				if (scalar(@parms) < 2)

					{

					die "'$line' invalid:\nExpected 2 parameters (package name, description)\n";

					}

				my $packageName = shift @parms;

				my ($packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags) = @{$packages->{$packageName}};

				my $description = shift @parms;

				$packages->{$packageName} = [$packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags];

				}

			elsif ($command eq "licence")

				{

				# Parms: packageName, licence file

				if (scalar(@parms) != 2)

					{

					die "'$line' invalid:\nExpected 2 parameters (package name, licence file)\n";

					}

				my $packageName = shift @parms;

				my ($packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags) = @{$packages->{$packageName}};

				my $licence = shift @parms;

				$packages->{$packageName} = [$packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags];

				}

			elsif ($command eq "tag")

				{

				# Parms: packageName, tag name, tag value

				if (scalar(@parms) != 3)

					{

					die "'$line' invalid:\nExpected 3 parameters (package name, tag name, tag value)\n";

					}

				my ($packageName, $tagName, $tagValue) = @parms;

				my ($packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags) = @{$packages->{$packageName}};

				$packages->{$packageName} = [$packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, [$tagName, $tagValue]];

				}

			elsif ($command eq "test")

				{

				# Warn if any files match

				if (scalar(@parms) < 1)

					{

					die "'$line' invalid:\nExpected >1 parameter (expressions to match)\n";

					}

				my @files = @{ match(\@files, \@parms, [0], $cmdfile) };

				foreach my $file (@files)

					{

					$log->Warn("WARNING: '$file' matched tests '".join(", ",@parms)."'");

					}

				}

			elsif ($command eq "write")

				{

				# Write out to a package list

				my @options = grep(/^-/,@parms);

				my @parms = grep(!/^-/,@parms);

				if (scalar(@parms) < 2)

					{

					die "'$line' invalid:\nExpected >2 parameters (expressions..., package name)\n";

					}

				my $warn = 1;

				foreach my $option (@options)

					{

					if ($option eq "-nowarn")

						{

						$warn = 0;

						}

					else

						{

						die "'$line' invalid:\nOption $option not understood\n";

						}

					}

				my $packageName = pop @parms;

				# Perform the matching

				my @package = @{ match(\@files,\@parms, [$warn], $cmdfile) };

				# Get list of the files that are still to be matched

				@files = (@files, @package, @package);

				@files = @{removeDuplicates(\@files,0)};

				# Record the matched files as used

				@usedFiles = (@usedFiles, @package);

				$log->Progress("Matched ".scalar(@package)." files for $packageName");

				if (defined($packages->{$packageName}))

					{	

					my ($packagePath, $device, $merge, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags) = @{$packages->{$packageName}};

					$merge = [@package, @$merge];

					$packages->{$packageName} = [$packagePath, $device, $merge, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags];

					}

				else

					{

					if ($packageName ne "null")

						{

						die "\nIn line '$line':\nAttempt to add to non-existent package '$packageName'.\nUse 'create $packageName [device name]' to create the package definition first\n";

						}

					}

				}

			elsif ($command eq "version")

				{

				if (defined($version))

					{

					die "\nIn line '$line':\nVersion has already been defined. One script can only have one version\n";

					}

				else

					{

					if (scalar(@parms) > 1)

						{

						die "\nIn line '$line':\nExpected only one parameter (spaces must be quoted)\n";

						}

					else

						{

						$version = shift @parms;

						}

					}

				}

			else

				{

				$log->Error("ERROR: Command not understood; ignoring: $line");

				}

			}

		}

	close(CMDFILE);

	# Write out $packages

	my $device;

	my $files;

	my $dependencies;

	my $paths;

	my $menu;

	my $map;

	my $category;

	my $description;

	my $licence;

	my $tags;

	my $packagePath;

	foreach my $pkgName (keys(%$packages))

		{

		($packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags) = @{$packages->{$pkgName}};

		writePkg($packagePath, $pkgName, $files, $device, $dependencies, $paths, $menu, $map, $version, $category, $description, $licence, $tags);

		}

}

sub readZiplog($)

	{

	my ($zipLog)=@_;

	my @package;

	# read in file

	open (FILE, "<$zipLog") or die "Couldn't open file $zipLog";

	# parse for elements we want

	foreach my $line (<FILE>)

		{

		$line =~ s/^\s+// ;

		if ($line =~ m/^adding: (.*)$/ )

			{

			# found line with file on - need to parse

			my $fileline = $1;

			# remove (deflated... or (stored... or ( anything   bit at end

			$fileline=~s/ \(.*\)$//;

			$fileline =~ s/\s+$// ;

			# ignore lines ending in slash - probably a directory

			if ($fileline =~ /\/$/ )

				{

				print "Directory?? - $fileline\n" ;

				}

			else

				{

				$fileline =~ s,/,\\,g;

				$fileline =~ s/^[\/\\]//;

				push (@package, $fileline);

				}

			}

		}

	close(FILE);