Below is the patch (generated after running C on original code & the new code) ...

• skips a directory (as identified by C<-d>) which is also a symbolic link (identified by C<-l>);
• refactors the creation of C<$annotation>;
• converts the size to kilobytes;
• comments out the C<-font> setting as C font is missing here and the substituted fonts turns out to be too tiny;
• enables the always-on scrollbars (as scrollbars-only-when-needed-option, 'o', was not working here);

--- 535607.pl.tdy	Fri Mar 10 21:16:23 2006
+++ dir-explore.pl	Fri Mar 10 21:43:49 2006
@@ -1,3 +1,5 @@
+#!perl
+
 use warnings;
 use strict;
 use Tk;
@@ -10,10 +12,14 @@
 
 my $main = MainWindow->new( -title => "Folder stats for $rootPath" );
 my $tree = $main->ScrlTree(
-    -font       => 'FixedSys 8',
-    -itemtype   => 'text',
-    -separator  => '/',
-    -scrollbars => "osoe"
+    #-font      => 'FixedSys 8',
+    -itemtype  => 'text',
+    -separator => '/',
+
+    #  Having scrollbars-only-when-needed-option, 'o', does not make the
+    #  scrollbars appear when the content overflows display area (FreeBSD
+    #  6-STABLE & Tk-804.027).
+    -scrollbars => 'sw'
 );
 
 my @pathStack  = (1);
@@ -26,11 +32,9 @@
 my ( $subDirCount, $subFileCount, $subTotalSize ) =
   buildSubTree( $tree, $rootPath, \@pathStack, \$maxNesting, \$totalLines,
     \$maxLineLength );
-my $annotation = $rootPath . " \t(";
-my $plural = $subDirCount != 1 ? 's' : '';
-$annotation .= $subDirCount . " dir$plural, " if $subDirCount;
-$annotation .= "$subFileCount files, $subTotalSize bytes)";
-$tree->entryconfigure( $currPath, -text => $annotation );
+$tree->entryconfigure( $currPath,
+    -text => annotate( $rootPath, $subDirCount, $subFileCount, $subTotalSize )
+);
 
 $totalLines = 40 if $totalLines > 40;
 $main->geometry(
@@ -79,7 +83,7 @@
 
         $tree->add( $currPath, -text => $nodeText );
 
-        if ( -d $path ) {
+        if ( -d $path && !-l $path ) {
             my ( $subDirCount, $subFileCount, $subTotalSize ) =
               buildSubTree( $tree, $path, $pathStack, $maxNesting, $totalLines,
                 $maxLineLength );
@@ -88,17 +92,19 @@
             $fileCount += $subFileCount;
             $sizeTotal += $subTotalSize;
 
-            my $annotation = $nodeText . " \t(";
-            my $plural = $subDirCount != 1 ? 's' : '';
-            $annotation .= $subDirCount . " dir$plural, " if $subDirCount;
-            $annotation .= "$subFileCount files, $subTotalSize bytes)";
-            $tree->entryconfigure( $currPath, -text => $annotation );
+            $tree->entryconfigure(
+                $currPath,
+                -text => annotate(
+                    $nodeText, $subDirCount, $subFileCount, $subTotalSize
+                )
+            );
         }
         else {
             my $fileSize = -s $path;
             $tree->entryconfigure( $currPath,
-                -text => $nodeText . " ($fileSize bytes)" );
+                -text => $nodeText . ' (' . size_in_kilobyte($fileSize) . ')' );
             ++$fileCount;
+#warn $path unless defined $fileSize;
             $sizeTotal += $fileSize;
         }
 
@@ -110,6 +116,25 @@
     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' : 'UNKNOWN SIZE';
 }
 
 sub ShowHelp {

Updated program follows ...

#!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 the
    #  scrollbars appear when the content overflows display area (FreeBSD
    #  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, \$totalLines,
    \$maxLineLength );
$tree->entryconfigure( $currPath,
    -text => annotate( $rootPath, $subDirCount, $subFileCount, $subTotalSize )
);

$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, $totalLines,
                $maxLineLength );

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

            $tree->entryconfigure(
                $currPath,
                -text => annotate(
                    $nodeText, $subDirCount, $subFileCount, $subTotalSize
                )
            );
        }
        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' : 'UNKNOWN SIZE';
}

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

    print $_ while $_ = shift;

    print <

HELP

    exit( $exitValue || -1 );
}

Re^2: Directory tree explorer with stats reporting

parv

created: 2006-03-10 23:02:17

perlmonks

• reply
• node
• thread
• author

• node
• author
• thread

prlmnks

• node
• thread
• author

there still one more location where size comes out to be C due to circular/unresolved symbolic link which i could not locate

Well, i do see the problem now; it would happen while calculating the size of C<$path> in the alternate branch ...

if ( -d $path && !-l $path ) {
...
}
else {
            my $fileSize = -s $path;
            ...
            $sizeTotal += $fileSize;
}

The C<-s> function causes chase of symlink via C which brings back unresolved link which gives C to C<$fileSize>. So when C is added to C<$sizeTotal>, we get the previously mentioned "uninitialized" error message.

Updated code follows to use C especially for those who are having problem on non-Unix operating systems; please test & report. Additionally, it binds 'q' to quit the Tk window, and displays the size in more appropriate units (see the C block).

#!perl

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

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

my $rootPath = shift;
$rootPath = $fspec->canonpath($rootPath);

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

my $main = MainWindow->new( -title => "Folder stats for $rootPath" );
#$main->withdraw;

my $tree = $main->ScrlTree(
    #-font      => 'FixedSys 8',
    -itemtype  => 'text',
    -separator => '/',

    #  Having scrollbars-only-when-needed-option, 'o', does not make the
    #  scrollbars appear when the content overflows display area (FreeBSD
    #  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, \$totalLines,
    \$maxLineLength );

$tree->entryconfigure( $currPath,
    -text => annotate( $rootPath, $subDirCount, $subFileCount, $subTotalSize )
);

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

closeTree( $tree, '' );
$tree->pack( -fill => 'both', -expand => 1 );
$main->bind( '' , \&exit );
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 ) = @_;

    #warn "$rootPath , ";
    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 eq $fspec->updir
          or $currDir eq $fspec->curdir;

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

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

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

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

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

            $tree->entryconfigure(
                $currPath,
                -text => annotate(
                    $nodeText, $subDirCount, $subFileCount, $subTotalSize
                )
            );
        }
        else {
            my $fileSize = -s $path;

            #warn $path unless defined $fileSize;
            $tree->entryconfigure( $currPath,
                -text => $nodeText . ' (' . size_in_xbyte($fileSize) . ')' );
            ++$fileCount;
            $sizeTotal += $fileSize if defined $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_xbyte($byte_size)
      . ')';
}

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

#  Convert size in bytes to a unit (upto TB) appropriate for the order of the
#  size.
BEGIN {

    #  Number of bytes.
    my %units = (
        1    => 'B',
        1024 => 'KB',
        1024 * 1024 => 'MB',
        1024 * 1024 * 1024 => 'GB',
        1024 * 1024 * 1024 * 1024 => 'TB'
    );

    sub size_in_xbyte {
        my ($size) = @_;

        return 'UNKNOWN SIZE' unless defined $size;

        my $factor = 1;
        foreach my $u ( sort { $a <=> $b } keys %units ) {
            $size < $u and last;
            $factor = $u;
        }
        my $format = $factor == 1 ? '%0d %s' : '%0.1f %s';
        return sprintf $format, $size / $factor, $units{$factor};
    }
}

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

    print $_ while $_ = shift;

    print <

HELP

    exit( $exitValue || -1 );
}

Re^2: Directory tree explorer with stats reporting

GrandFather

created: 2006-03-11 20:58:04

perlmonks

• reply
• node
• thread
• author

• node
• author
• thread

prlmnks

• node
• thread
• author

Thanks for the improvements. A couple of minor things:

count_to_plural_suffix would be better return $_[0] != 1 ? 's' : ''; In English - 0 apples, 1 apple, many apples.

The new display size is nice for general purpose, but for the application that catalysed the code I needed the exact number of bytes. Just shows, you can't write code to suit everyone. :)

---

DWIM is Perl's answer to Gödel

Re^3: Directory tree explorer with stats reporting

parv

created: 2006-03-11 21:45:13

perlmonks

• reply
• node
• thread
• author

• node
• author
• thread

prlmnks

• node
• thread
• author

I personally like seeing "0 X" than to "0 Xs" where things are being counted like in this case. (Or, just do away w/ the C). But as you said, "you can't...".

I have been myself in situation where i wanted to see the exact number of bytes (or rather in 512-blocks), so no argument there. (I suppose "more appropriate units" caused your response?:)

This is my first experience w/ Tk, otherwise i would have added some more key bindings (namely rebuilding the tree on request) and options to (interactively) modify the display. Slowly, but surely, one day ...

Re^4: Directory tree explorer with stats reporting

GrandFather

created: 2006-03-11 22:06:12

perlmonks

• reply
• node
• thread
• author

• node
• author
• thread

prlmnks

• node
• thread
• author

"0 apple" isn't conventional English usage. In Russian useage I understand that there are three plural cases - perhaps you could redo the user interface in Russian? :)

Not sure I noticed "more appropriate units", not to the point of objecting anyway. More comment concerning units was a "more than one way to use it" type comment. I'll likely change my version to insert comas however to make the numbers more readable. Perhaps we need to add a configuration menu?

I use Tk in a fairly light weight way fairly often for simple GUI apps such as this. I guess I didn't spend much more than an hour on the original code before I posted it - post early and often they say.

---

DWIM is Perl's answer to Gödel