#!perl

#  This is a modified copy of the directory explorer code posted on
#  PerlMonks by 'GrandFather' at ...
#
#  http://perlmonks.org/index.pl?node_id=535607
#  http://perlmonks.org/index.pl?displaytype=print;node_id=535607;repl
+ies=1

use warnings; use strict; use Carp (qw[ croak carp ]);

use Data::Dumper;

use Tk;
use Tk::Tree;
use Tk::Font;

use File::Spec;

BEGIN
{
   #  Tk-related variable(s).
   our ( $node_sep ) = ( '/' );

   sub stack_as_string
   { return join $node_sep , ref $_[0] ? @{ $_[0] } : @_; }

   #  Number of bytes.
   my %units =
      (
         1                         => 'B'
      , 1024                      => 'KB'
      , 1024 * 1024               => 'MB'
      , 1024 * 1024 * 1024        => 'GB'
      , 1024 * 1024 * 1024 * 1024 => 'TB'
      ) ;
   my @ordered = sort { $a <=> $b } keys %units;
   #  Convert size in bytes to a unit (upto TB) appropriate for the or
+der of
   #  the size.
   sub size_in_xbyte
   {
      my ( $size ) = @_;

      return 'UNKNOWN SIZE' unless defined $size;

      my $factor = $ordered[0];
      foreach my $u ( @ordered )
      {
         $size < $u and last;
         $factor = $u;
      }
      #  Use number of bytes (B) as is (knowing that $factor will be 1
+).
      my $format = $factor != $ordered[0] ? '%0.1f %s' : '%0d %s';
      return sprintf $format, $size / $factor, $units{$factor};
   }
}
our ( $node_sep );
my $tree_start = 1;

my $path = shift;
ShowHelp() unless defined $path;

# Adjust as you like.
# In pixel.
my $window_width = 1200;
my $window_height = 800;
my $geom = sprintf q[%dx%d], $window_width, $window_height;

#  In File::Spec pod, there is no constructor method noted, nor is 'si
+mple
#  use' defined for which functional forms of methods are available.  
+Missing
#  also is a list of exported function.
my $fspec = 'File::Spec';

$path = $fspec->canonpath($path);
ShowHelp( -2 , "Error finding folder $path\n\n" ) unless -d $path;

my $main = MainWindow->new( '-title' => "Statistics for $path" );
$main->geometry( $geom );

# Size is in point.
my $font = $main->Font( '-family' => 'Helvetica', '-size' => 14 );
#warn join ' ' , $font->Name(), $font->Size(), "\n";

my $tree = $main->ScrlTree( '-font' => $font
                           , '-itemtype'  => 'text'
                           , '-separator' => $node_sep

                              #  Once, having scrollbars-only-when-nee
+ded-option, 'o', did not make the
                              #  scrollbars appear when the content ov
+erflows display area (FreeBSD
                              #  6-STABLE & Tk-804.027, Tk 8.4.11.2). 
+Now (Sun Mar 12 13:18:18 UTC 2006)
                              #  optional scrollbars are behaving as a
+dvertised.  And i do not know
                              #  why|how!
                           , '-scrollbars' => 'osow'
                           )
                           ->pack( '-fill' => 'both' , '-expand' => 1 
+) ;

my @node_stack = ($tree_start);
my $node = $tree_start;
$tree->add( $node , '-text' => $path );

printf( qq[Starting with "%s" ...\n], $path );
my ( $subDirCount , $subFileCount , $subTotalSize ) =
   buildSubTree( $tree , $path , \@node_stack );

$tree->entryconfigure( $node
                     , '-text' => annotate( $path , $subTotalSize , $s
+ubDirCount , $subFileCount )
                     );

$tree->autosetmode;

collapse_nodes( $tree );
$tree->open( $node );

$main->bind( '<KeyPress-q>' , sub { exit ; } );
$tree->bind( '<KeyPress-Return>' , \&toggle_tree_expand );

$tree->focus;

MainLoop;

#  Key binding function to expand|collapse a subtree.
sub toggle_tree_expand
{
   my $root = $tree->info( 'selection' );
   return unless defined $root && length $root;

   my @nodes = $tree->info( 'children' , $root );
   return unless scalar @nodes;

   #  $tree->open() does not (sometimes) expands a tree, but $tree->cl
+ose() does
   #  collapse an open()'d tree.
   #  --
   #  Handle both open & close cases for now.
   my ( $meth );
   foreach ( @nodes )
   {
      $meth = $tree->info( 'hidden' , $nodes[-1] ) ? 'show' : 'hide';
      $tree->setmode( $root , $meth eq 'show' ? 'close' : 'open' );
      $tree->$meth( 'entry' , $_ );
   }
   $tree->update;
}

sub collapse_nodes
{
   my ( $tree , $node , $collapse ) = @_;

   my @subnodes = $tree->info( 'children' , $node );
   return unless scalar @subnodes;

   foreach my $n ( @subnodes )
   {
      collapse_nodes( $tree , $n , 1 );
      $tree->hide( 'entry' , $n ) if $collapse;
   }
   $tree->setmode( $node , 'open' ) if $node;
}

sub buildSubTree
{
   my ( $tree , $path , $stack ) = @_ ;

   my ( $dirCount , $fileCount , $sizeTotal ) = (0) x3 ;

   push @$stack , $tree_start;

   my $DH;
   if ( ! opendir $DH , "$path" )
   {
      warn( qq[Cannot open "$path": $!\n] );
      return ( 0, 0, 0 );
   }
   #printf qq[Fetching data for %s ...\n], $path;
   foreach my $dir ( sort readdir $DH )
   {
      next if $dir eq $fspec->updir or $dir eq $fspec->curdir;

      #  Don't know what will happen if catfile() is substitued w/ cat
+dir()
      #  on non-Unix operating systems.
      my $path = $fspec->catfile( $path , $dir );

      my $node = stack_as_string( $stack );
      $tree->add( $node , '-text' => $path );

      my ( $size , $dirs , $files );
      #  Use lstat to avoid chasing circular|dangling symbolic links.
      lstat $path;
      if ( ! -d _ )
      {
         ++$fileCount;
         $size = -s _;
         $sizeTotal += $size if defined $size;
      }
      else
      {
         ( $dirs , $files , $size ) = buildSubTree( $tree , $path , $s
+tack );
         $dirCount  += $dirs + 1;
         $fileCount += $files;
         $sizeTotal += $size;
      }
      my $annotation = annotate( $path , $size , $dirs , $files );
      warn qq[$annotation], "\n";
      $tree->entryconfigure( $node , '-text' => $annotation );

      ++$stack->[-1];
   }
   closedir $DH or die qq[Cannot close "$path": $!\n];
   pop @$stack;

   printf( "=== %s\n", annotate( $path, $sizeTotal, $fileCount, $dirCo
+unt ) );
   return ( $dirCount , $fileCount , $sizeTotal );
}

sub annotate
{
   my ( $path , $size , $dirs , $files ) = @_;
   return
      join q//
      , $path
      , "\t("
      , size_in_xbyte( $size )
      , ( map
         { !$_->[0]
            ? ()
            : sprintf ', %s %s%s' , @{$_} , count_to_plural_suffix( $_
+->[0] )
         }
            [ $dirs , 'dir' ] , [ $files , 'file' ]
         )
      , ')'
      ;
}

sub count_to_plural_suffix { return $_[0] > 1 ? 's' : ''; }

sub ShowHelp
{
my $exitValue = 0;
$exitValue = shift if defined $_[0] and $_[0] =~ /^[-+]?\d+$/;

print $_ while $_ = shift;

print <<HELP;
FolderStats scans a directory tree starting at the folder given on the
command line and generates an explorer like tree giving folder content
stats such as number of files, their total size, and the count and
sizes of sub-folders.

Note that the statistics are not dynamically updated as files and
folders are altered on disk.

Usage:

FolderStats <root folder>

Key Binding:

            q: quits the program.

      Enter: expands or collapses a tree.

   Up, Down: Vertically move up or down.
      arrows:

Left, Right: Move one level up or down.
      arrows:

HELP

exit( $exitValue || -1 );
}
[download]