The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w
# dutree - print sorted indented rendition of du output
use strict;

my %Dirsize;
my %Kids;

getdots(my $topdir = input());
output($topdir);

# run du, read in input, save sizes and kids
# return last directory (file?) read
sub input { 
    my($size, $name, $parent);
    @ARGV = ("du @ARGV |");		# prep the arguments
    while (<>) {  			# magic open is our friend
	($size, $name) = split;
	$Dirsize{$name} = $size;
	($parent = $name) =~ s#/[^/]+$##;	# dirname
	push @{ $Kids{$parent} }, $name unless eof;
    } 
    return $name;
}

# figure out how much is taken up in each directory
# that isn't stored in subdirectories.  add a new
# fake kit called "." containing that much.
sub getdots {
    my $root = $_[0];
    my($size, $cursize);
    $size = $cursize = $Dirsize{$root};
    if ($Kids{$root}) {
	for my $kid (@{ $Kids{$root} }) { 
	    $cursize -= $Dirsize{$kid};
	    getdots($kid);
	}
    } 
    if ($size != $cursize) {
	my $dot = "$root/.";
	$Dirsize{$dot} = $cursize;
	push @{ $Kids{$root} }, $dot;
    } 
} 

# recursively output everything,
# passing padding and number width in as well
# on recursive calls
sub output {
    my($root, $prefix, $width) = (shift, shift || '', shift || 0);
    my $path;
    ($path = $root) =~ s#.*/##;	# basename
    my $size = $Dirsize{$root};
    my $line = sprintf("%${width}d %s", $size, $path);
    print $prefix, $line, "\n";
    for ($prefix .= $line) {  	# build up more output
	s/\d /| /;
	s/[^|]/ /g;
    }
    if ($Kids{$root}) { 		# not a bachelor node
	my @Kids = @{ $Kids{$root} };
	@Kids = sort { $Dirsize{$b} <=> $Dirsize{$a} } @Kids;
	$Dirsize{$Kids[0]} =~ /(\d+)/;
	my $width = length $1;
	for my $kid (@Kids) { output($kid, $prefix, $width) }
    }
}