# Last update: 2009/08/15
# 
# READ & DRAW SUB DIRECTORY TREE
#
# (p) J. Nagasaki
#
# Reads all sub directories starting at script directory (or a given base directory)
# and stores all paths into @filepath. Afterwards an ASCII drawn subdirectory tree
# is generated in @filetree.
#
# Please note, that depending of the depth of the directory tree, the execution
# of this script can take up to several minutes before output. Therefore the 'progress
# points' in the subfunction "getdir" are set.

use Cwd;		# for: $rootdir = cwd;

@filepath;		# global directory list
@filetree;		# global tree list ASCII drawing
@treeflag;		# global tree branch flags (Size: $MAXDEPTH)

# Root directory

# $rootdir = "c:\\Progra~1\\Perl";  # absolute path, if perl-scripts are not part of PATH=
$rootdir = cwd;

$rootdir =~ s/\//\\\\/gi; # convert "/" to "\" for Windows

$rootdepth = ($rootdir =~ tr/\\//); # depth of root directory (DOS/Windows) (count # of "\")

getdir($rootdir);		# Get all Subdirectories (recursive call within)

@filepath = reverse(@filepath);	# reverse directory paths

print "\n";

# draw directory tree by reversed building
if (@filepath != 0)
{
	foreach (@filepath)
	{
		$actdir = $_;
		$actdir =~ s/.+\\(.+)$/$1/g;	# only name of subdirectory
		
		$dirnum = ($_ =~ tr/\\//);	# actual depth
		$dirnum -= $rootdepth;		# correct with root depth
		
		$treeflag[$dirnum] = 1;		# mark actual tree branch (gaps are filled with '0')	
		splice(@treeflag, $dirnum + 1); # kill all deeper branches than actual depth
		
		# draw branches, if marked in treeflag
		$line = "";
		for ($i = 1; $i < $dirnum; $i++)
		{
			if ($treeflag[$i])
			{
				$line .= "   |";
			}
			else
			{
				$line .= "    ";
			}		
		}
		push(@filetree, "$line   +-- $actdir\n");
		push(@filetree, "$line   |\n");
	}	
}
push(@filetree, "$rootdir\n");

@filetree = reverse(@filetree);	# revese tree back

# print results
print "\n";
foreach(@filetree)
{
	print $_;
}



#--------------------------

# get directory (recursive called subroutine)
# all variables has to be declared with "my" to give them their
# own area of validity in the actual recursion level

sub getdir
{
	# remove following code line, if progress points are undesired (but useful, if
	# directory tree is very deep and to see, that the script is working).
	print ".";
	
	my $dir = shift;
	
	opendir(DIR, "$dir");
	
# UPDATE: Speed-up (Files w/o "."): my @files = grep {!/\./} readdir(DIR);
	my @files = readdir(DIR);
	closedir(DIR);
	
	foreach (@files)
	{
		my $newdir = "$dir\\$_";			# create absolute path
		
		# check if directory and not "." or ".."
# UPDATE: Speed-up (Files w/o "."): if (-d $newdir)
		if ((-d $newdir) && ($_ ne "\.") && ($_ ne "\.\."))
		{
			push (@filepath, $newdir);		# add new directory
			getdir($newdir);			# recursive call
		}
	}
}