#!perl

use warnings;
use strict;
use Tk;
use Tk::Tree;

my $rootPath = shift;

ShowHelp() if !defined $rootPath;
ShowHelp( -2, "Error finding folder $rootPath\n\n" ) if !-d $rootPath;

my $main = MainWindow->new( -title => "Folder stats for $rootPath" );
my $tree = $main->ScrlTree(
    #-font      => 'FixedSys 8',
    -itemtype  => 'text',
    -separator => '/',

    #  Having scrollbars-only-when-needed-option, 'o', does not make t
+he
    #  scrollbars appear when the content overflows display area (Free
+BSD
    #  6-STABLE & Tk-804.027).
    -scrollbars => 'sw'
);

my @pathStack  = (1);
my $maxNesting = 0;
my $totalLines;
my $maxLineLength = 0;
my $currPath      = join "/", @pathStack;

$tree->add( $currPath, -text => $rootPath );
my ( $subDirCount, $subFileCount, $subTotalSize ) =
  buildSubTree( $tree, $rootPath, \@pathStack, \$maxNesting, \$totalLi
+nes,
    \$maxLineLength );
$tree->entryconfigure( $currPath,
    -text => annotate( $rootPath, $subDirCount, $subFileCount, $subTot
+alSize )
);

$totalLines = 40 if $totalLines > 40;
$main->geometry(
    ( $maxLineLength + @pathStack * 4 ) * 5 . 'x' . ( 40 + $totalLines
+ * 20 ) );
closeTree( $tree, '' );

$tree->pack( -fill => 'both', -expand => 1 );

MainLoop;

sub closeTree {
    my $tree = shift;
    my ( $entryPath, $hideChildren ) = @_;
    my @children = $tree->info( children => $entryPath );

    return if !@children;

    for (@children) {
        closeTree( $tree, $_, 1 );
        $tree->hide( 'entry' => $_ ) if $hideChildren;
    }
    $tree->setmode( $entryPath, 'open' ) if length $entryPath;
}

sub buildSubTree {
    my ( $tree, $rootPath, $pathStack, $maxNesting, $totalLines,
        $maxLineLength ) = @_;
    my $dirCount  = 0;
    my $fileCount = 0;
    my $sizeTotal = 0;

    push @$pathStack, 1;
    $$maxNesting = @$pathStack if $$maxNesting < @$pathStack;

    my $dir;
    opendir $dir, $rootPath;

    while ( my $currDir = readdir $dir ) {
        next if $currDir =~ /^\.\.?$/;

        my $path = "$rootPath/$currDir";
        ++$$totalLines;

        my $currPath = join "/", @$pathStack;
        my $nodeText = $path;

        $tree->add( $currPath, -text => $nodeText );

        if ( -d $path && !-l $path ) {
            my ( $subDirCount, $subFileCount, $subTotalSize ) =
              buildSubTree( $tree, $path, $pathStack, $maxNesting, $to
+talLines,
                $maxLineLength );

            $dirCount  += $subDirCount + 1;
            $fileCount += $subFileCount;
            $sizeTotal += $subTotalSize;

            $tree->entryconfigure(
                $currPath,
                -text => annotate(
                    $nodeText, $subDirCount, $subFileCount, $subTotalS
+ize
                )
            );
        }
        else {
            my $fileSize = -s $path;
            $tree->entryconfigure( $currPath,
                -text => $nodeText . ' (' . size_in_kilobyte($fileSize
+) . ')' );
            ++$fileCount;
#warn $path unless defined $fileSize;
            $sizeTotal += $fileSize;
        }

        $$maxLineLength = length($nodeText)
          if length($nodeText) > $$maxLineLength;
        ++$pathStack->[-1];
    }

    closedir $dir;
    pop @$pathStack;
    return ( $dirCount, $fileCount, $sizeTotal );
}

sub annotate {
    my ( $path, $dirs, $files, $byte_size ) = @_;
    return
      $path
      . " \t("
      . $dirs . ' dir' . count_to_plural_suffix($dirs) . ', '
      . $files . ' file' . count_to_plural_suffix($files) . ', '
      . size_in_kilobyte($byte_size)
      . ')';
}

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

sub size_in_kilobyte {
    defined $_[0] ? sprintf( '%0.1f', $_[0] / 1024 ) . ' kB' : 'UNKNOW
+N SIZE';
}

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 s
+uch as

number of files, their total size, and the count and sizes of sub-fold
+ers.

Note that the statistics are not dynamically updated as files and fold
+ers are
altered on disk.

Usage:

FolderStats <root folder>

HELP

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