#! perl

# Copyright (c) 2006-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;

use Getopt::Long;

sub Usage(;$)

	{

	my ($errmsg) = @_;

	print "\nERROR: $errmsg\n" if (defined $errmsg);

	print <<'EOF';

perl make_directory_tree.pl [options] specfile

perl make_directory_tree.pl [options] -check specfile 

Create a tree of empty directories, specified in specfile.

The specification is one or more lines of the form

   path/name/separated/by/forward/slash   # optional comment

Paths should not contain "." or "..". Paths ending in "*"

imply that other subdirectories are permitted by the -check

option, but ignored.

If no specfile is given on the command line, the tool will

read from standard input.

The -check option compares an existing directory tree

with the one which would have been created, and reports 

differences.

Options:

-r rootdir           root of the directory tree 

-o newspecfile       specfile describing the new tree, 

                     mostly for use with the -check option

-fix                 attempt to correct directory names which 

                     have the wrong case - used with -check

If no rootdir is specified, the tree will be assumed to start

in the current directory. 

EOF

	exit 1;

	}

my $rootdir;

my $check;

my $fix;

my $newspecfile;

my $help;

my $verbose;

Usage() if !GetOptions(

	'r=s' => \$rootdir,

	'o=s' => \$newspecfile,

	'check' => \$check,

	'fix' => \$fix,

	'h' => \$help,

	'v' => \$verbose,

	);

Usage() if ($help);

my $line;

my %dirnames;		# actual capitalisation

my %lc_dirnames;	# forced to lowercase

my %wilddirs;

while ($line=<>)

	{

	chomp $line;

	$line =~ s/\s*#.*$//;	# hash is comment to end of line

	$line =~ s/^\s*//;		# remove leading whitespace

	$line =~ s/\s*$//;		# remove trailing whitespace

	# also accepts the output of "p4 have"

	if ($line =~ /^\/\/epoc\/master\/(.*)\/[^\/]+$/i)

		{

		# output of p4 have

		$line = $1;

		}

	next if ($line eq "");	# ignore blanks

	# tolerate some minor errors in the input format

	$line =~ s/\\/\//g;	# convert any \ to /

	$line =~ s/^\///;	# remove leading /, if present

	my $wilddir = 0;

	if ($line =~ /\/\*$/)

		{

		$line = substr $line, 0, -2;	# cut off last two characters

		$wilddir = 1;

		}

	my @dirs = split /\//, $line;

	my $path = "";

	my $lc_path = lc $path;

	foreach my $subdir (@dirs)

		{

		my $parent = $path;

		$path .= "/$subdir";

		$lc_path .= lc "/$subdir";

		next if (defined $dirnames{$path});	# already seen this one

		if (defined $lc_dirnames{$lc_path})

			{

			my $fixed_path = $lc_dirnames{$lc_path};

			print "WARNING: input file has ambiguous case for $path (should be $fixed_path)\n";

			$path = $fixed_path;	# recover by using the earlier entry?

			next;

			}

		# found a new directory

		@{$dirnames{$path}} = ();	# empty list of subdirs

		$lc_dirnames{$lc_path} = $path;

		push @{$dirnames{$parent}}, $subdir;

		next;

		}

	$wilddirs{$path} = 1 if ($wilddir);		

	}

print "* Processed input file\n";

Usage("No directories specified") if (scalar keys %dirnames == 0);

# %dirnames now contains all of the approved names as keys

# The associated value is the list of subdirectories (if any)

# Subroutine to create a completely new directory tree

sub make_new_tree($)

	{

	my ($root) = @_;

	my $errors = 0;

	foreach my $path (sort keys %dirnames)

		{

		next if ($path eq "");	# root directory already exists

		print "** mkdir $root$path\n" if ($verbose);

		if (!mkdir $root.$path)

			{

			print "ERROR: failed to make $root$path: $!\n";

			$errors++;

			}

		}

	return ($errors == 0);

	}

# recursive routine to remove a subtree from %dirnames

sub remove_subtree($);

sub remove_subtree($)

	{

	my ($subdir) = @_;

	my @absent = @{$dirnames{$subdir}};

	delete $dirnames{$subdir};	# delete the parent

	if (defined $wilddirs{$subdir})

		{

		# Remove from %wilddirs as well - directory should exist

		delete $wilddirs{$subdir};

		}

	foreach my $dir (@absent)

		{

		remove_subtree("$subdir/$dir");	# recursively delete the children

		}

	}

# recursive routine to check a subtree against %dirnames

sub check_subtree($$$);

sub check_subtree($$$)

	{

	my ($root,$subdir,$expected) = @_;

	my $currentdir = $root.$subdir;

	opendir DIR, $currentdir;

	my @contents = grep !/^\.\.?$/, readdir DIR;

	closedir DIR;

	printf ("** checking $currentdir - %d entries\n", scalar @contents) if ($verbose);

	my @confirmed = ();

	foreach my $expected (@{$dirnames{$subdir}})

		{

		push @confirmed,$expected;

		if (!-d "$currentdir/$expected")

			{

			# Note: this does not check the correctness of the case,

			# that comes in the scan through @contents

			print "REMARK: cannot find expected directory $currentdir/$expected\n";

			if ($fix && defined $newspecfile)

				{

				print "** removing $currentdir/$expected/... from specification\n";

				remove_subtree("$subdir/$expected");

				pop @confirmed;	

				}

			}

		}

	@{$dirnames{$subdir}} = @confirmed;	# update the description of the tree

	foreach my $name (@contents)

		{

		if (!-d "$currentdir/$name")

			{

			next; # ignore files

			}

		my $newpath = "$subdir/$name";

		if ($expected)

			{

			if (defined $dirnames{$newpath})

				{

				# we expected this one, and it has the correct case

				check_subtree($root,$newpath,1);

				next;

				}

			my $lc_newpath = lc $newpath;

			if (defined $lc_dirnames{$lc_newpath})

				{

				# expected directory, but wrong name

				$newpath = $lc_dirnames{$lc_newpath};	# get the correct name

				if ($fix && rename("$currentdir/$name","$root$newpath"))

					{

					print "* corrected $currentdir/$name to $root$newpath\n";

					}

				else

					{

				    print "ERROR: $currentdir/$name should be $root$newpath\n";

				    }

				check_subtree($root,$newpath,1);

				next;

				}

			}

		# unexpected subdirectory

		if ($wilddirs{$subdir})

			{

			# unexpected directory in a directory which allows "extras"

			next;

			}

		print "REMARK: New subtree found: $newpath\n" if ($expected);

		# add unexpected subtrees to the $dirnames structure

		@{$dirnames{$newpath}} = ();	# empty list of subdirs

		push @{$dirnames{$subdir}}, $name;

		# no %lc_dirnames entry required

		check_subtree($root,$newpath,0);

		}

	}

# subroutine to generate a new input file

sub print_leaf_dirs($)

	{

	my ($filename) = @_;

	open FILE, ">$filename" or die "Cannot write to $filename: $!\n";

	foreach my $path (sort keys %dirnames)

		{

		my @subdirs = @{$dirnames{$path}};

		if (defined $wilddirs{$path})

			{

			print FILE "$path/*\n";	# always print wildcard directories

			next;

			}

		next if (scalar @subdirs != 0);	# ignore interior directories

		print FILE "$path\n";

		}

	close FILE;

	}

$rootdir =~ s/\\/\//g if (defined $rootdir);	# convert rootdir to forward slashes

if ($check)

	{

	$rootdir = "." if (!defined $rootdir);

	print "* checking $rootdir ...\n";

	check_subtree($rootdir,"",1);

	}

else

	{

	if (defined $rootdir && !-d $rootdir)

		{

		Usage("Cannot create $rootdir: $!") if (!mkdir $rootdir);

		print "* created root directory $rootdir\n";

		}

	else

		{

		$rootdir = ".";

		}

	print "* creating directory tree in $rootdir\n";

	make_new_tree($rootdir);

	}

if (defined $newspecfile)

	{

	print_leaf_dirs($newspecfile);

	print "* created $newspecfile\n";

	}