diff -r 22486c9c7b15 -r 378360dbbdba srctools/distillsrc/distillsrc.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/srctools/distillsrc/distillsrc.pm	Wed Jun 30 11:35:58 2010 +0800
@@ -0,0 +1,898 @@
+#!/bin/perl -w
+
+# Copyright (c) 2004-2009 Nokia Corporation and/or its subsidiary(-ies).
+# All rights reserved.
+# 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:
+# Nokia Corporation - initial contribution.
+#
+# Contributors:
+#
+# Description:
+# distillsrc.pm - compiles a list of source used in .mrp files, and deletes
+# any unused source
+# 
+#
+
+package CDistillSrc;
+
+use strict;
+use File::Spec;
+use File::Path;
+use File::Basename;
+use FindBin;
+use lib $FindBin::Bin;
+use ReadMrp;
+
+use lib File::Spec->catdir($FindBin::Bin, '..', 'makecbr');
+use CConfig;
+
+
+
+# Constructor
+#
+# Parameters:
+#
+# $aSrcRoot : The root from which all src statements are based
+# $aSrcPath : The path under aSrcRoot to the source tree to be processed
+# $aSrcPrefix : An optional prefix which can be stripped from all src statements
+# $aPlatform : e.g 'beech' - used to locate the platform specific product directory
+#
+# Returns: The object (or undef if there was a problem)
+#
+sub New($$$$)
+	{
+	my $proto = shift;
+	my ($aSrcRoot, $aSrcPath, $aSrcPrefix, $aPlatform, $aCheckCase) = @_;
+
+	my $class = ref($proto) || $proto;
+
+	my $self = {};
+	bless($self, $class);
+
+	my $error = 0;
+
+	if (!defined($aSrcRoot))
+		{
+		print "ERROR: RealTimeBuild: A srcroot must be given, to specify where all 'source' declarations originate from\n";
+		$error = 1;
+		}
+		
+	if (!defined($aSrcPath))
+		{
+		print "ERROR: RealTimeBuild: A srcpath must be given, to specify which source under the srcroot is to be filtered. Use '\\' to filter the entire srcroot\n";
+		$error = 1;
+		}
+
+	if (!defined($aPlatform))
+		{
+		print "ERROR: RealTimeBuild: A platform must be given, to locate the product directory\n";
+		$error = 1;
+		}
+		
+	if ($error)
+		{
+		print "\n";
+		}
+	else
+		{
+		if ($aSrcPath =~ /\.\./)
+			{
+			print "ERROR: RealTimeBuild: The source path must be relative to the srcroot, and must not contain '..'\n";
+			$error = 1;
+			}
+	
+		$self->iSrcRoot($aSrcRoot);
+		$self->iSrcPath($aSrcPath);
+		$self->iSrcPrefix($aSrcPrefix);
+		$self->iPlatform($aPlatform);
+		$self->iSrcItems({});
+		$self->iCheckCase(!!$aCheckCase);
+
+		$self->AddSrcItem("os/buildtools/toolsandutils/productionbldtools/unref/orphan/cedprd/SuppKit", "non-shipped");
+		$self->AddSrcItem("os/buildtools/toolsandutils/productionbldtools/unref/orphan/cedprd/tools", "non-shipped");
+		$self->AddSrcItem("os/buildtools/toolsandutils/productionbldtools/unref/orphan/cedprd/DevKit", "non-shipped");
+		$self->AddSrcItem("os/buildtools/toolsandutils/productionbldtools", "non-shipped");
+		}
+
+	if ($error)
+		{
+		$self = undef;
+		}
+
+	return $self;
+	}
+
+# Object data
+#
+sub iSrcRoot()
+	{
+	my $self = shift;
+	if (@_) { $self->{iSRCROOT} = shift; }
+	return $self->{iSRCROOT};
+	}
+
+sub iSrcPath()
+	{
+	my $self = shift;
+	if (@_) { $self->{iSRCPATH} = shift; }
+	return $self->{iSRCPATH};
+	}
+
+sub iSrcPrefix()
+	{
+	my $self = shift;
+	if (@_) { $self->{iSRCPREFIX} = shift; }
+	return $self->{iSRCPREFIX};
+	}
+
+sub iPlatform()
+	{
+	my $self = shift;
+	if (@_) { $self->{iPLATFORM} = shift; }
+	return $self->{iPLATFORM};
+	}
+	
+sub iSrcItems()
+	{
+	my $self = shift;
+	if (@_) { $self->{iSRCITEMS} = shift; }
+	return $self->{iSRCITEMS};
+	}
+
+sub iCheckCase()
+	{
+	my $self = shift;
+	if (@_) { $self->{iCHECKCASE} = shift; }
+	return $self->{iCHECKCASE};
+	}
+
+sub iCorrectedCase()
+	{
+	my $self = shift;
+	if (@_) { $self->{iCORRECTEDCASE} = shift; }
+	return $self->{iCORRECTEDCASE};
+	}
+
+# LoadMrps - Records the source lines out of all .mrp files
+#
+# Parameters:
+# $aConfig - optional configuration file, as used by makecbr
+# $aLists - optional component lists, as used by makecbr
+# $aMrps - optional .mrp files
+#
+# Returns: True, if the load was successful. False otherwise
+#
+sub LoadMrps($$$)
+	{
+	my $self = shift;
+	my ($aConfig, $aLists, $aMrps) = @_;
+	# Load in config file
+
+	my @lists = @$aLists;
+	my @mrps;
+	foreach my $mrp (@$aMrps){
+		{
+		push @mrps, [$mrp, ''];
+		}
+	}
+	my @configMrps = ();
+    if (defined($aConfig))
+		{
+		my @configs = $self->_LoadConfig($aConfig);
+
+		# Add mrps and lists (after planting them in srcroot)
+		push @lists, map($self->_PlantFile($_), @{$configs[0]});
+		@configMrps = map($self->_PlantFile($_), @{$configs[1]});
+		foreach my $mrp (@configMrps)
+			{
+			push @mrps, [$mrp, ''];
+			}
+		}
+	
+	# Load in mrp lists
+	foreach my $file (@lists)
+		{
+		if (open (MRPLIST, $file))
+			{
+			foreach my $line (<MRPLIST>)
+				{
+				chomp $line;
+				$line =~ s/#.*$//; # Remove comments
+				$line =~ s/^\s*//; # Remove extraneous spaces
+				$line =~ s/\s*$//;
+	
+				if ($line ne "")
+					{
+					my @parms = split(/\s+/, $line);
+	
+					if (scalar(@parms) != 2)
+						{
+						warn "ERROR: RealTimeBuild: Entries in component list '$file' should be of the form 'name mrp_location'. Problem in line: $line\n";
+						next;
+						}
+					else
+						{
+						# Ignore *nosource* entries
+						next if ($parms[1] eq '*nosource*');
+						
+						push @mrps, [$self->_PlantFile($parms[1]), $parms[0]];
+						}
+					}
+				}
+			close MRPLIST or warn "ERROR: RealTimeBuild: Couldn't close '$file' : $!\n";
+			}
+		else
+			{
+			warn "Couldn't open '$file' : $!\n";	
+			}
+		}
+
+	# Load all .mrp files
+	if (scalar(@mrps) == 0)
+		{
+		die "ERROR: RealTimeBuild: No .mrp files were specified\n";
+		}
+
+	my $loaded = 1;
+	
+	foreach my $mrp (@mrps)
+		{
+		# Get path of mrp file (from here)
+		my ($name, $path) = fileparse($mrp->[0]);
+		# Convert to path from source root
+		if (!($self->_RemoveBaseFromPath($self->iSrcRoot(), \$path)))
+			{
+			warn "ERROR: Mrp file $mrp->[0] isn't under the source root (".$self->iSrcRoot().")\n";
+			next;
+			}
+		
+		my $mrpobj;
+        
+        # To indicate the correct case and where the .mrp file comes from if failed to check letter case
+        if (!($self->_CheckCase($mrp->[0]))) {
+            my $mrp_error_source = "optional component list(by -f) or optional .mrp list(by -m)";
+            foreach my $myName (@configMrps) {
+                if ($myName eq $mrp->[0]) {
+                    $mrp_error_source = "config file '".$aConfig."'";
+                    last;
+                }
+            } 
+            print "WARNING: Case of '".$mrp->[0]."' supplied in ".$mrp_error_source." does not match the file system. Should be ".$self->iCorrectedCase()."\n";
+        }
+        
+		if (!eval { $mrpobj = New ReadMrp($mrp->[0]) })
+			{
+			$loaded = 0;
+			my $message = $@;
+			$message =~ s/^(ERROR:\s*)?/ERROR: RealTimeBuild: /i;
+			print $message;
+			}
+		else
+			{
+			my $selfowned = 0;
+			my $mrpComponentName = $mrpobj->GetComponent();
+			if( ($mrp->[1] ne '') && (lc($mrp->[1]) ne lc($mrpComponentName)))
+				{
+				print "ERROR: RealTimeBuild: Component name \'$mrp->[1]\' does not match \'$mrpComponentName\' in $mrp->[0]\n";
+				}
+			foreach my $srcitem (@{$mrpobj->GetSrcItems()})
+				{
+				if ($srcitem =~ /^[\/\\]/)
+					{
+					# Remove source prefix
+					$srcitem = $self->_StripFile($srcitem);
+					}
+				else
+					{
+					# Relative source item
+					$srcitem = File::Spec->catdir($path, $srcitem);
+					}
+
+				my $rootedmrp = $path.$name;
+				if ($self->_RemoveBaseFromPath($srcitem, \$rootedmrp))
+					{
+					$selfowned = 1;
+					}
+
+				$self->AddSrcItem($srcitem, $mrpComponentName);
+				}
+			if ($self->iCheckCase())
+				{
+				foreach my $binexpitem (@{$mrpobj->GetBinExpItems()})
+					{
+					# Check lower case
+					if ($binexpitem =~ /[A-Z]/)
+						{
+						print "REMARK: [$mrpComponentName] Binary/export file $binexpitem should be lower case\n";
+						}
+					}
+				}
+
+			if (!$selfowned)
+				{
+				print "REMARK: .mrp file '$mrp->[0]' does not include itself as source\n"; 
+				}
+			}
+		}
+	return $loaded;
+	}
+	
+# AddSrcItem - Records a source file, usually taken from an .mrp file
+#
+# Parameters:
+# $aItem - the source file name
+# $aComponent - the name of the component which claimed the file
+#
+# Returns: None
+# Dies: Not normally; only if the source hash data structure gets corrupted
+sub AddSrcItem($$)
+	{
+	my $self = shift;
+	my ($aItem, $aComponent) = @_;
+
+	my $item = $aItem;
+
+	# Worth checking that the file exists
+	my $truePath = File::Spec->catdir($self->iSrcRoot(), $item);
+	if (($item !~ /^\\component_defs/i) && (!-e $truePath))
+		{
+		print "ERROR: RealTimeBuild: '$aComponent' owns $item, but that path doesn't exist\n";
+		$item = ""; # No point adding this path to the tree	
+		}
+	else
+		{
+		# Check case consistency
+		$self->_CheckCase($truePath) or print "WARNING: [$aComponent] Case of '".$truePath."' does not match the file system. Should be ".$self->iCorrectedCase()."\n";
+		}
+	
+	$item =~ s/^[\/\\]*//; # Remove preceding slashes
+
+	my @path = split(/[\/\\]+/,$item);
+
+	my $dir = $self->iSrcItems();
+	while ((scalar @path) > 0)
+		{
+		my $subdir = lc(shift @path);
+	
+		if (scalar(@path) == 0)
+			{
+			# Just enter the final path segment
+			if (exists($dir->{$subdir}))
+				{
+				# Someone already owns at least part of this path
+				if (!ref($dir->{$subdir}))
+					{
+					# Someone owns the whole of this path
+					my $conflict = $dir->{$subdir};
+
+					print "REMARK: $aComponent and $conflict both own $item\n";
+					}
+				else
+					{
+					if (ref($dir->{$subdir}) ne "HASH")
+						{
+						die "ERROR: Source hash is corrupted\n";
+						}
+					else
+						{
+						# Someone owns a child of this path
+						my $childtree = $dir->{$subdir};
+
+						my @conflicts = $self->_GetTreeComps($childtree);
+						print "REMARK: $aComponent owns $item, which is already owned by the following component(s): ".join(", ",@conflicts)."\n";
+						}
+					}
+				}
+			$dir->{$subdir} = $aComponent;
+			}
+		else
+			{
+			# Need to enter another subdirectory
+			
+			if (exists($dir->{$subdir}))
+				{
+				if (ref($dir->{$subdir}))
+					{
+					# Someone already has - just do a quick integrity check
+					
+					if (ref($dir->{$subdir}) ne "HASH")
+						{
+						die "ERROR: Source hash is corrupted\n";
+						}
+					}
+				else
+					{
+					# The path from this point on is already owned by a component
+					my $conflict = $dir->{$subdir};
+					
+					print "REMARK: $aComponent and $conflict both own $item\n";
+					last;
+					}
+				}
+			else
+				{
+				$dir->{$subdir} = {};
+				}
+			}
+
+		$dir = $dir->{$subdir};
+		}
+	}
+
+# DistillSrc - Compare the recorded source lines against the source path. Delete anything which doesn't match.
+#
+# Parameters:
+# $aDummy - A flag - non-zero means don't actually delete
+#
+# Returns: None
+sub DistillSrc($$)
+	{
+	my $self = shift;
+	my ($aDummy) = @_;
+
+	my $tree = $self->iSrcItems();
+	my $path = File::Spec->catdir($self->iSrcRoot(), $self->iSrcPath());
+
+	$path=~s/[\/\\]+/\\/; # Remove multiple slashes
+
+	# Pop the srcpath off the front of the tree
+	my @path = split(/[\/\\]/,$self->iSrcPath());
+
+	foreach my $dir (@path)
+		{
+		if ($dir eq ".")
+			{
+			next;
+			}
+		elsif (exists($tree->{lc($dir)}))
+			{
+			$tree = $tree->{lc($dir)};
+		
+			if (!ref($tree))
+				{
+				# Some component owns all of the srcpath
+				last;
+				}
+			}
+		else
+			{
+			# No mrp files claimed any of the source
+			$tree = undef;
+			last;
+			}
+		}
+
+	# Now recurse into the tree and delete files
+	if (defined($tree))
+		{
+		if (ref($tree))
+			{
+			$self->_DistillTree($tree, $path, $aDummy);
+			}
+		else
+			{
+			print "REMARK: All source owned by component '$tree'; no action\n";
+			}
+		}
+	else
+		{
+		print "WARNING: No .mrp files claim any source; removing $path\n";
+		$self->_DeletePath($path, $aDummy);
+		}
+	}
+
+# Print - Display the source tree
+#
+# Parameters:
+# $aDepth - The number of levels of the tree to show. 0 = all levels
+#
+# Returns: None
+sub Print($$)
+	{
+	my $self = shift;
+
+	my ($aDepth) = @_;
+
+	$self->_PrintTree("", $self->iSrcItems(), $aDepth);
+	}
+	
+# *** Private methods ***
+# *** 
+
+# _LoadConfig - (private) Reads a configuration file, as used by makecbr
+#
+# Parameters:
+# $aConfig - filename of the configuration file
+#
+# Returns:
+# (files, mrps) - where files and mrps are listrefs containing component lists and
+# mrp files respectively
+#
+sub _LoadConfig($)
+	{
+	my $self = shift;
+	my ($aConfig) = @_;
+	
+	my @files = ();
+	my @mrps = ();
+	
+	my $config = New CConfig($aConfig);
+
+	if (!defined $config)
+		{
+		die "Couldn't load config file '$aConfig'\n";
+		}
+		
+	# Extract the interesting items into our lists
+	push @mrps, $config->Get("gt+techview baseline mrp location");
+	push @mrps, $config->Get("gt only baseline mrp location");
+	push @files, $config->Get("techview component list");
+	push @files, $config->Get("gt component list");
+	
+	# Remove any items we couldn't find
+	@mrps = grep(defined($_), @mrps);
+	@files = grep(defined($_), @files);
+	
+	return (\@files, \@mrps);
+	}
+
+# _StripFile - (private) Remover of src prefix. Also maps product directories
+#
+# Parameters:
+# $aFile - Filename to process
+#
+# Returns: The processed filename
+#
+sub _StripFile($)
+	{
+	my $self = shift;
+	my ($aFile) = @_;
+
+	my $file = $aFile;
+
+	# Map the product dirs
+	my $platform = $self->iPlatform();
+	$file =~ s#^[\/\\]?product[\/\\]#/sf/os/unref/orphan/cedprd/#i;
+
+	# Remove the prefix
+	my $prefix = $self->iSrcPrefix();
+	
+	if (defined $prefix)
+		{
+		my $mapped = $file; # Keep a copy in case we can't remove the prefix
+		
+		if (!$self->_RemoveBaseFromPath($prefix, \$file))
+			{
+			$file = $mapped;
+			}
+		}
+	
+	return $file;
+	}
+	
+# _PlantFile - (private) Add src root to file. Also take off src prefix
+#
+# Parameters:
+# $aFile - Filename to process
+#
+# Returns: The processed filename
+#
+sub _PlantFile($)
+	{
+	my $self = shift;
+	my ($aFile) = @_;
+
+	my $file = $aFile;
+
+	# Remove the prefix
+	$file = $self->_StripFile($file);
+
+	# Plant the file in the src root
+	$file = File::Spec->catdir($self->iSrcRoot(), $file);
+	
+	# Ensure all slashes are normalised to a single backslash
+	$file =~ s/[\/\\]+/\\/; 
+	
+	return $file;
+	}
+
+# _RemoveBaseFromPath - (private) Remove a base path from the root of a filename.
+#
+# Parameters:
+# $aBase - The base path to remove
+# $$aFile - Filename to process (scalar reference)
+#
+# Returns: True if the file was under the base path, false otherwise
+#   $$aFile may be corrupted if the return is false
+sub _RemoveBaseFromPath($)
+	{
+	my $self = shift;
+	my ($aBase, $aFile) = @_;
+
+	my $base = $aBase;
+	$base =~ s/^[\/\\]*//; # Remove extra slashes
+	$base =~ s/[\/\\]*$//;
+
+	my @base = split(/[\/\\]+/, $base);
+
+	$$aFile =~ s/^[\/\\]*//; # Remove preceding slashes
+	
+	my $matched = 1;
+	my $filedir;
+	
+	foreach my $dir (@base)
+		{
+		if ($$aFile =~ /[\/\\]/)
+			{
+			# Split off the bottom dir
+			$$aFile =~ /([^\/\\]*)[\/\\]+(.*)$/;
+			($filedir, $$aFile) = ($1, $2, $3);
+			}
+		else
+			{
+			# Special case - no more dirs
+			$filedir = $$aFile;
+			$$aFile = "";
+			}
+		if (lc($filedir) ne lc($dir))
+			{
+			# Base doesn't match
+			$matched = 0;
+			last;
+			}
+		}
+	
+	return $matched;
+	}
+
+# _CheckCase - (private) Given a literal filename, compares the case of the
+#                        file on the filesystem against the filename i.e. it
+#                        can be used to enforce case sensitivity
+#
+# Parameters:
+# $aFilename - The literal filename
+#
+# Returns: True if the file matches the supplied case.
+#          True if the file doesn't exist at all (user is expected to check that separately)
+#          True if case checking has been disabled.
+#          False otherwise (if the file exists but under a differing case).
+#
+# If false, the correctly cased name is present through $self->iCorrectedCase()
+sub _CheckCase($)
+{
+	my $self = shift;
+	my ($aFile) = @_;
+
+	return 1 if !($self->iCheckCase()); # checking disabled
+	return 1 if ($^O !~ /win32/i); # only works on Windows anyway
+	
+	return 1 if (!-e $aFile); # file not found (under case-insensitive checking)
+	
+	$self->iCorrectedCase(Win32::GetLongPathName($aFile));
+	return ($aFile eq $self->iCorrectedCase());
+}
+
+# _DistillTree - (private) Given a src tree and a dir, clean out any unowned files
+#
+# Parameters:
+# %$aTree - The source tree (hash ref containing nested hash refs and string leaves)
+# $aDir - The directory to compare against
+# $aDummy - A flag - non-zero means don't do the actual deletion
+#
+# Returns: A flag - non-zero if there were any owned files present
+sub _DistillTree($$$)
+	{
+	my $self = shift;
+	my ($aTree, $aDir, $aDummy) = @_;
+
+
+	my $keptsome = 0;
+
+	if (opendir(DIR, $aDir))
+	{	
+		my $dir = $aDir;
+		$dir =~ s/[\/\\]*$//; # Remove trailing / from dir
+	
+		foreach my $entry (readdir(DIR))
+			{
+			my $path = $dir."\\".$entry;
+	
+			if ($entry =~ /^\.\.?$/)
+				{
+				next;
+				}
+			elsif (exists $aTree->{lc($entry)})
+				{
+				my $treeentry = $aTree->{lc($entry)};
+				if (ref($treeentry) eq "HASH")
+					{
+					# Part of this path is owned
+					if (-d $path)
+						{
+						# Recurse into path
+						my $keep = $self->_DistillTree($treeentry, $path, $aDummy);
+						if ($keep)
+							{
+							$keptsome = 1;
+							}
+						else
+							{
+							# Correction; none of this path was owned
+							$self->_DeletePath($path, $aDummy);
+							}
+						}
+					elsif (-f $path)
+						{
+						my @comps = $self->_GetTreeComps($treeentry);
+						print "ERROR: RealTimeBuild: $path is a file, yet is used as a directory in components: ".join(", ",@comps)."\n";
+						}
+					else
+						{
+						print "ERROR: $path has disappeared while it was being examined\n";
+						}
+					}
+				elsif (!ref($treeentry))
+					{
+					# This path is completely owned
+					$keptsome = 1;
+					next;
+					}
+				else
+					{
+					die "ERROR: Source hash is corrupted\n";
+					}
+				}
+			else
+				{
+				$self->_DeletePath($path, $aDummy);
+				}
+			}
+		
+		closedir(DIR);
+		}
+	else
+		{
+			warn "ERROR: RealTimeBuild: Couldn't open directory '$aDir' for reading\n";
+		}
+
+	return $keptsome;
+	}
+
+# _GetTreeComps - (private) Get all the leaves out of a tree (or component
+#                           names out of a source tree)
+# Parameters:
+# %$aTree - The source tree (hash ref containing nested hash refs and string leaves)
+# 
+# Returns: A list of strings found at the leaves (or component names)
+sub _GetTreeComps($)
+	{
+	my $self = shift;
+	my ($aTree) = @_;
+
+	my @comps = ();
+
+	foreach my $entry (keys(%$aTree))
+		{
+		if (ref($aTree->{$entry}) eq "HASH")
+			{
+			push @comps, $self->_GetTreeComps($aTree->{$entry});
+			}
+		elsif (!ref($aTree->{$entry}))
+			{
+			push @comps, $aTree->{$entry};
+			}
+		else
+			{
+			die "ERROR: Source hash is corrupted\n";
+			}
+		}
+		
+	return @comps;
+	}
+
+# _DeletePath - (private) Safe path deletion (file or dir)
+#
+# $aPath - The path to delet
+# $aDummy  - A flag - non-zero means don't actually delete
+#
+# Returns: None. Prints warnings if deletion fails. Dies only in exceptional circumstances
+sub _DeletePath($$)
+	{
+	my $self = shift;
+
+	my ($aPath, $aDummy) = @_;
+
+	if (-d $aPath)
+		{
+		if ($aDummy)
+			{
+			print "DUMMY: Directory $aPath is not specified in any .mrp file\n";
+			}
+		else
+			{
+			print "REMARK: Deleting directory $aPath; ";
+			my $files = rmtree($aPath);
+			if ($files)
+				{
+				print "$files items removed\n";
+				}
+			else
+				{
+				print "\nWARNING: Problem removing directory $aPath\n";
+				}
+			}
+		}
+	elsif (-f $aPath)
+		{
+		if ($aDummy)
+			{
+			print "DUMMY: File $aPath is not specified in any .mrp file\n";
+			}
+		else
+			{
+				unless($aPath =~ /distribution.policy.s60/i)
+				{
+					print "REMARK: Deleting file $aPath\n";
+					unlink $aPath or print "WARNING: Problem deleting file $aPath\n";
+				}
+			}
+		}
+	else
+		{
+		warn "ERROR: Can't delete path $aPath; not a file or directory\n";
+		}
+	}
+
+# _PrintTree - Display a subset of the source tree
+#
+# Parameters:
+# $aPrefix - The string to prefix all paths
+# $aDepth - The number of levels of the tree to show. 0 = all levels
+#
+# Returns: None
+sub _PrintTree($$$)
+        {
+	my $self = shift;
+	
+        my ($aPrefix, $aTree, $aDepth) = @_;
+
+	my $prefix = "";
+	
+	if ($aPrefix ne "")
+		{
+		$prefix = $aPrefix."\\";
+		}
+
+        foreach my $key (sort(keys(%$aTree)))
+                {
+                if (ref($aTree->{$key}))
+                        {
+			if ($aDepth!=1)
+				{
+				my $newprefix = $prefix.$key;
+				
+				if ($key eq "")
+					{
+					$newprefix.="{empty}";
+					}
+
+                        	$self->_PrintTree($newprefix, $aTree->{$key}, $aDepth-1);
+				}
+			else
+				{
+				print $prefix.$key."\\...\n";
+				}
+                        }
+                else
+                        {
+                        print $prefix.$key." = ".$aTree->{$key}."\n";
+                        }
+                }
+        }
+
+1;