--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/bldsystemtools/commonbldutils/make_directory_tree.pl Tue Feb 02 01:39:43 2010 +0200
@@ -0,0 +1,323 @@
+#! 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";
+ }