#!/usr/bin/perl -w
use strict;
use vars qw( $a $b );
use Futils qw( NL );
my($ind) = '';
my($f) = Futils->new();
my(@o) = qw( --with-paths --sl-after-dirs --no-fsdots --as-ref );
my($filetree) = {};
my($treetrunk) = '.';
{
my($subdirs,$sfiles) = $f->list_dir($treetrunk, @o);
$filetree =
[
{
$treetrunk => [ sort({ uc $a cmp uc $b } @$subdirs, @$sfiles) ]
}
];
descend($filetree->[0]{ $treetrunk },scalar(@$subdirs));
}
walk(@$filetree);
sub descend {
my($parent,$dirnum) = @_;
for (my($i) = 0; $i < $dirnum; ++$i) {
my($current) = $parent->[$i]; next unless -d $current;
my($subdirs,$sfiles) = $f->list_dir($current, @o);
map { $_ = $f->strip_path($_) } @$sfiles;
splice
(
@$parent,
$i,
1,
{
$current => [ sort({ uc $a cmp uc $b } @$subdirs, @$sfiles) ]
}
);
descend($parent->[$i]{ $current },scalar(@$subdirs));
}
$parent
}
sub walk {
my($dir) = shift(@_);
foreach (@{ [ %$dir ]->[1] }) {
my($mem) = $_;
if (ref($mem) eq 'HASH') {
print($ind . $f->strip_path([ %$mem ]->[0]) . '/',NL);
$ind .= ' ' x 3;
walk($mem);
$ind = substr($ind,3);
}
else {
print($ind . $mem,NL);
}
}
}
=pod
AUTHOR
Tommy Butler <tommy@atrixnet.com>
phone: (817)-468-7716
6711 Forest Park Dr
Arlington, TX
76001-8403
COPYRIGHT Copyright (C) Tommy Butler. All rights reserved
LISCENCE This software is free, you may use and distribute it under the
same terms as Perl itself.
This code uses Futils, a Perl module (or reusable code library) to make life
easier when doing things with files. You can download the code at:
<URL: http://ooopps.sourceforge.net/cgi-bin/archive.pl/pub/modules/Futils.pm>
Futils uses other modules, which may be also be found here at the
ooOPps Open Source Code Library under the "modules" section and at
the CPAN.
=cut