#!perl -w
# $Id: dtree.pl,v 1.3 2004/09/30 07:34:13 jlinoff Exp $
# ================================================
# Copyright Notice
# Copyright (C) 1998-2003 by Joe Linoff (http://www.joelinoff.com)
# 
# Permission is hereby granted, free of charge, to any person obtaining
# a copy of this software and associated documentation files (the
# "Software"), to deal in the Software without restriction, including
# without limitation the rights to use, copy, modify, merge, publish,
# distribute, sublicense, and/or sell copies of the Software, and to
# permit persons to whom the Software is furnished to do so, subject to
# the following conditions:
# 
# The above copyright notice and this permission notice shall be
# included in all copies or substantial portions of the Software.
# 
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
# IN NO EVENT SHALL JOE LINOFF BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
# ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
# OTHER DEALINGS IN THE SOFTWARE.
# 
# Comments and suggestions are always welcome.
# ================================================
#
# This tool creates a directory tree.
#
# Usage: perl dtree.pl <directory>
#
use strict;
&Main;

# ================================================
# MAIN
# ================================================
sub Main {
  my %ignore = ();
  my @dirs = ();
  my $format = 1;
  my $report_files = 0;
  my $maxcol = 1000;
  while ( $#ARGV >= 0 ) {
    my $arg = shift @ARGV;
    if ( $arg eq "-c" ) {
      $format = 0;
    }
    elsif ( $arg eq "-e" ) {
      $format = 1;
    }
    elsif ( $arg eq "-f" ) {
      $report_files = 1;
    }
    elsif ( $arg eq "-i" ) {
      my $id = shift @ARGV;
      $ignore{"$id"} = 1;
    }
    elsif ( $arg eq "-m" ) {
      $maxcol = shift @ARGV;
    }
    elsif ( $arg eq "-version" ) {
      my $X = "\$";
      print "\$Id: dtree.pl,v 1.3 2004/09/30 07:34:13 jlinoff Exp $X\n";
      exit 0;
    }
    elsif ( $arg eq "-h" || $arg eq "-help" ) {
      &Help;
      exit 0;
    }
    else {
      push @dirs,$arg;
    }
  }

  my $dir;
  foreach $dir ( @dirs ) {
    &PrintDir( $dir, $format, $report_files, $maxcol, \%ignore );
  }
}
# ================================================
# PrintDir
# ===============================================
sub PrintDir {
  my $dir = shift;
  my $format = shift;
  my $report_files = shift;
  my $maxcol = shift;
  my $ignore = shift;

  my @maxcolwidth = ();
  my %top = ();
  my @cols = ();

  push @cols,$dir;
  &PopulateTables($dir,
		  $dir,
		  \@cols,
		  \@maxcolwidth,
		  \%top,
		  $maxcol,
		  \%$ignore,
		  $report_files );
  
  # PrintLeafs
  &PrintLeafs( \%top, \@maxcolwidth, $format );

}
# ================================================
# PopulateTables
# ================================================
sub PopulateTables {
  my $path = shift;
  my $dir = shift;
  my $cols = shift;
  my $maxcolwidth = shift;
  my $parent = shift;
  my $maxcol = shift;
  my $ignore = shift;
  my $report_files = shift;

  return if ( defined %$ignore->{"$dir"} );

  if ( 0 == $report_files ) {
    if ( ! -d $path ) {
      print STDERR "ERROR: '$path' is not a directory.\n";
      print STDERR "       Use the -h switch to get more information.\n";
      print STDERR "\n";
      return;
    }
  }

  # ====================================
  # Determine the column id and set the
  # max col width.
  # ====================================
  my @x = @$cols;
  my $col = $#x;
  return if ( $col > $maxcol );
  while ( ! defined @$maxcolwidth[$col] ) {
    push @$maxcolwidth,0;
  }
  my $len = length($dir);
  if ( $len > @$maxcolwidth[$col] ) {
    @$maxcolwidth[$col] = $len;
  }

  # ====================================
  # Update the parent node information.
  # ====================================
  if ( !defined %$parent->{"NUM_CHILDREN"} ) {
    my @children = ();
    %$parent->{"NAME"} = "TOP";
    %$parent->{"NUM_CHILDREN"} = 1;
    %$parent->{"CHILDREN"} = \@children;
    %$parent->{"COL"} = $col;
    %$parent->{"SCRATCH"} = 0;
    %$parent->{"PRINTED"} = 0;
    %$parent->{"VISITED"} = 0;
  }
  else {
    my $x = %$parent->{"NUM_CHILDREN"};
    %$parent->{"NUM_CHILDREN"} = $x + 1;
  }

  # ====================================
  # Update the node information.
  # ====================================
  my $children_ref = %$parent->{"CHILDREN"};
  my @node_children = ();
  my %node = ();
  %node->{"NAME"} = $dir;
  %node->{"NUM_CHILDREN"} = 0;
  %node->{"CHILDREN"} = \@node_children;
  %node->{"PARENT"} = $parent;
  %node->{"COL"} = $col;
  %node->{"SCRATCH"} = 0;
  %node->{"PRINTED"} = 0;
  %node->{"VISITED"} = 0;
  push @$children_ref,\%node;

  # ====================================
  # Find the subdirectories.
  # ====================================
  opendir DIR,"$path" || die "ERROR: '$path' is not a directory.\n";
  my @subdirs = ();
  @subdirs = grep { -d "$path/$_" } readdir(DIR) if ( 0 == $report_files );
  @subdirs = grep { "$path/$_" } readdir(DIR) if ( 1 == $report_files );
  closedir DIR;

  my $subdir;
  my $num = 0;
  foreach $subdir ( @subdirs ) {
    next if($subdir eq "." || $subdir eq "..");
    push @$cols,$subdir;
    &PopulateTables( "$path/$subdir", 
		     "$subdir",
		     \@$cols,
		     \@$maxcolwidth,
		     \%node,
		     $maxcol,
		     \%$ignore,
		     $report_files );
    $num++;
    pop @$cols;
  }
}
# ================================================
# PrintLeafs
# ================================================
sub PrintLeafs {
  my $node = shift;
  my $maxcolwidth = shift;
  my $format = shift;

  if ( %$node->{"NUM_CHILDREN"} ) {
    my $children_ref = %$node->{"CHILDREN"};
    my $child;
    foreach $child ( @$children_ref ) {
      &PrintLeafs( $child, \@$maxcolwidth, $format );
    }
  }
  else {
    # This is a leaf, print it.
    my @path_nodes = ();
    &GetPathNodes( $node, \@path_nodes );

    my $node;
    foreach $node ( @path_nodes ) {
      &PrintConnector( $node );
      &PrintName( $node, \@$maxcolwidth );
    }
    print "\n";
    if ( $format == 1 ) {
      foreach $node ( @path_nodes ) {
	&PrintConnector( $node );
	&PrintName( $node, \@$maxcolwidth );
      }
      print "\n";
    }
  }
}
# ================================================
# PrintName
# ================================================
sub PrintName {
  my $node = shift;
  my $maxcolwidth = shift;

  # Print the node.
  my $col = %$node->{"COL"};
  my $width = @$maxcolwidth[$col];
  $width += 2;
  if ( ! %$node->{"PRINTED"} ) {
    %$node->{"PRINTED"} = 1;
    my $name = %$node->{"NAME"};
    if ( %$node->{"NUM_CHILDREN"} > 0 ) {
      my $len = length $name;
      print " $name";
      if ( $len < $width ) {
	my $diff = $width - $len;
	if ( $diff > 0 ) {
	  print " ";
	  $diff--;
	  while ( $diff > 0 ) {
	    print "-";
	    $diff--;
	  }
	}
      }
    }
    else {
      printf " %-*s",$width,$name;
    }
  }
  else {
    printf " %-*s",$width," ";
  }
}
# ================================================
# PrintConnector
# ================================================
sub PrintConnector {
  my $node = shift;

  # Update the scratch variable.
  if ( %$node->{"COL"} > 0 ) {
    my $parent = %$node->{"PARENT"};
    my $visited = %$node->{"VISITED"};
    if ( ! $visited ) {
      %$node->{"VISITED"} = 1;
      my $val = %$parent->{"SCRATCH"};
      $val++;
      %$parent->{"SCRATCH"} = $val;
    }
    my $scratch = %$parent->{"SCRATCH"};
    my $children = %$parent->{"NUM_CHILDREN"};
    
    # Print the connector from the previous node
    # before the current node is printed.
    if ( $children ) {
      # The parent has children.
      my $printed = %$node->{"PRINTED"} ;
      if ( $children > 0 ) {
	if ( $scratch == 1 ) {
	  # This is the first entry.
	  if ( $printed ) {
	    if ( $children != $scratch ) {
	      print "  |    ";
	    }
	    else {
	      print "       ";
	    }
	  }
	  else {
	    if ( $children > 1 ) {
	      print "--+--->" ;
	    }
	    else {
	      print "------>" ;
	    }
	  }
	}
	else {
	  if ( $printed ) {
	    if ( $children != $scratch ) {
	      #printf "  |%3d ",$scratch;
	      print "  |    ";
	    }
	    else {
	      print "       ";
	    }
	  }
	  else {
	    print "  +--->" ;
	  }
	}
      }
      else {
	print "------>";
      }
    }
    else {
      # The parent does not have children.
      print "         ";
    }
  }
}
# ================================================
# IsLeaf
# ================================================
sub IsLeaf {
  my $node = shift;
  return 0 if ( %$node->{"NUM_CHILDREN"} );
  return 1;
}
# ================================================
# GetPathEntries
# ================================================
sub GetPathNodes {
  my $node = shift;
  my $path_nodes = shift;

  # Generate the full path.
  my @tmplist = ();
  my $tmp = $node;
  while( defined %$tmp->{"PARENT"} ) {
    push @tmplist,$tmp;
    $tmp = %$tmp->{"PARENT"};
  }

  # Now reverse the order.
  my $i;
  for($i=$#tmplist;$i>=0;$i--) {
    push @$path_nodes,$tmplist[$i];
  }
}
# ================================================
# GetPath
# ================================================
sub GetPath {
  my $node = shift;

  # Generate the full path.
  my $tmp = $node;
  my $path = "";
  while( defined %$tmp->{"PARENT"} ) {
    my $nm = %$tmp->{"NAME"};
    if ( $path eq "" ) {
      $path = "$nm";
    }
    else {
      $path = "$nm/$path";
    }
    $tmp = %$tmp->{"PARENT"};
  }

  return $path;
}
# ================================================
# PrintNodes
# ================================================
sub PrintNodes {
  my $node = shift;
  my $level = shift;

  printf "%*s",$level," " if ( $level );
  if ( %$node->{"NUM_CHILDREN"} ) {
    print "NODE: ";
    print %$node->{"NAME"};
    print " children=";
    print %$node->{"NUM_CHILDREN"};
    print " col=";
    print %$node->{"COL"};
  }
  else {
    print "LEAF: ";
    print %$node->{"NAME"};
  }

  # Generate the full path.
  my $path = &GetPath( $node );
  print "  $path";
  print "\n";

  my $children_ref = %$node->{"CHILDREN"};
  my $child;
  foreach $child ( @$children_ref ) {
    &PrintNodes( $child, $level+1 );
  }
}
# ================================================
# Help
# ================================================
sub Help {
  my $X = "\$";
  print <<END

\$Id: dtree.pl,v 1.3 2004/09/30 07:34:13 jlinoff Exp $X

usage: perl dtree.pl [-c] [-e] [-h] [-help] [-i <name>] [-m <num>] [-version] <dir> [<dir>]*

  -c         Compressed output format.

  -e         Expanded output format (default).


  -f         Report all of the files in addition to the directories.
             This option slows things down quite a bit.
  -h
  -help      On-line help.

  -i <name>  The name of a subdirectory to ignore.

  -m <num>   The maximum column to report. If this is
             not specified, all subdirectories will be
             reported.

  -version   Print the program version and exit.

examples\:

  prompt> perl dtree.pl -c c\:/test
   test ---+---> 1 ---+---> 1.1  
           |          +---> 1.2  
           +---> 2 ---+---> 2.1 ---+---> 2.1.1  
           |          |            +---> 2.1.2  
           |          +---> 2.2  
           +---> 3  
  prompt> perl dtree.pl -e c\:/test
   test ---+---> 1 ---+---> 1.1  
           |          |          
           |          +---> 1.2  
           |                     
           +---> 2 ---+---> 2.1 ---+---> 2.1.1  
           |          |            |            
           |          |            +---> 2.1.2  
           |          |                         
           |          +---> 2.2  
           |                     
           +---> 3  

  prompt> perl dtree.pl -c -m 1 c\:/test
   test ---+---> 1
           +---> 2
           +---> 3  
  prompt> perl dtree.pl -c -m 1 -i 2 c\:/test
   test ---+---> 1
           +---> 3  
END
}