Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

tree.pl - kinda like tree

by crazyinsomniac (Prior)
on Mar 04, 2002 at 20:42 UTC ( [id://149208]=sourcecode: print w/replies, xml ) Need Help??
Category: Utility Scripts
Author/Contact Info /tell crazyinsomniac
Description: heard of the Perl Power Tools, well this one was a missing one (tree). This version builds a LoL, with the first element in each list being the directory name. Output of the real tree utility looks like
F:\DEV\FILE_TREE\B
|   file
|
\---c
    |   file
    |
    \---d
            file
Improvements are welcome.
#!/usr/bin/perl -w
use strict;
use warnings;
use File::Find;
use Data::Dumper qw/ DumperX /;
use vars qw/ $TR $TREE $ROOT %DEMDIRS/;

die "YOU CANNOT use/require ".__FILE__ if caller();

$ROOT = shift @ARGV;

$TREE = $TR = ["$ROOT"];

&find( { wanted => \&build_tree,
         preprocess => \&Pre,
         postprocess => \&Post,
         bydepth => 0, # don't override
       ,}
       , $ROOT,
     ,);

print DumperX($TREE) if @ARGV > 1;

print "\n";

DumpTree($TREE);

exit;

sub Post {
    $DEMDIRS{$File::Find::dir} = $TR;

#    warn "post $File::Find::dir";
}

sub Pre {
    my @it = sort { -d $b <=> -d $a } @_;
    return @it;
}

sub build_tree {
    if( $_ eq '.' or $_ eq '..') {
        return;
    }

    if(-d) {
        my $tTR = [$_];

        if(exists $DEMDIRS{$File::Find::dir}) {
            $TR = $DEMDIRS{$File::Find::dir};
        }

        $DEMDIRS{$File::Find::dir} = $TR;

        push @$TR, $tTR;

        $TR = $tTR;

        return;
    }

    push @$TR, $_;
}


sub DumpTree {
    my $ARRAY = shift or die "hello?";
    my $DEPTH = shift || 0; # only 0 the first time
    my $atWhat = shift || 0;

    print shift(@$ARRAY), "\n" unless $DEPTH;

    my $FILE_OR_REF;

    while(defined($FILE_OR_REF = shift(@$ARRAY))) {
        if(ref $FILE_OR_REF) {
            if($DEPTH) {
                print Depthy($DEPTH,$atWhat);
                print "\n";
                print Depthy($DEPTH, $atWhat);
            } else {
                print "\n";
            }

            print '+';
            print '---';
            print shift(@$FILE_OR_REF);
            print "\n";

            DumpTree($FILE_OR_REF, $DEPTH + 1, $atWhat + 1);
            next;

        } else {
            if($DEPTH) {
                print Depthy($DEPTH, $atWhat);
            } else {
                print '|   ';
            }

            print $FILE_OR_REF;
            print "\n";
        }
    }
}


sub Depthy {
    my $depth = shift;
    my $opy = shift || 0;

    my $string;

    for my $i (1..$depth) {
        if($opy) {
            $string .= '|';
            $string .= ' ' x 3;
        } else {
            $string .= ' ' x 4;
        }
    }

    return $string;
}

__END__
## READMORE FOLLOWS

F:\dev\File_Tree>perl tree.pl F:\dev\File_Tree

F:\dev\File_Tree
|   tmon.out
|   tree2.pl
|   tree.pl
|   tree2
|   echo
|   dumptree.pl
|   tree.pl.bak

+---b
|   file
|
|   +---c
|   |   file
|   |
|   |   +---d
|   |   |   file

+---a
|   aabcccfile
|   file
|   bbcccfile
|
|   +---234
|
|   +---b
|   |   bcccfile
|   |   FILE
|   |
|   |   +---a
|   |   |   FILE
|   |   |
|   |   |   +---AAAAAADIRRRRRR
|   |   |
|   |   |   +---DIRRRRRR
|   |   |   |   file
|   |   |
|   |   |   +---b
|   |   |   |   FILE
|   |   |   |
|   |   |   |   +---c
|   |   |   |   |   FILE
|   |   |   |   |
|   |   |   |   |   +---d
|   |   |   |   |   |   FILE
|   |   |   |   |   |
|   |   |   |   |   |   +---f
|   |   |   |   |   |   |   FILE
|   |
|   |   +---b
|   |   |   file
|   |   |
|   |   |   +---c
|   |   |   |   file
|   |   |   |
|   |   |   |   +---d
|   |   |   |   |   file
|   |
|   |   +---c
|   |   |   cfile
|   |   |   ccfile
|   |   |   cccfile
|   |   |
|   |   |   +---d
|   |   |   |   dfile
|   |   |   |
|   |   |   |   +---e
|   |   |   |   |   efile

+---echo0

+---File
|   fily.txt
|
|   +---Tree
|   |   Tree.pm
|   |   Makefile.PL
|   |   README
|   |   test.pl
|   |   Changes
|   |   MANIFEST

### I INVITE YOU TO MAKE THE OUTPUT LOOK MORE LIKE
### AND AN EXTRA ++ IF YOU DO IT WITHOUT BUILDING THE ARRAY :)

F:\dev\File_Tree>tree /a /f .
F:\DEV\FILE_TREE
|   echo
|   dumptree.pl
|   tmon.out
|   tree2.pl
|   tree.pl
|   tree2
|   tree.pl.bak
|
+---File
|   |   fily.txt
|   |
|   \---Tree
|           Tree.pm
|           Makefile.PL
|           README
|           test.pl
|           Changes
|           MANIFEST
|
+---echo0
+---a
|   |   bbcccfile
|   |   aabcccfile
|   |   file
|   |
|   +---b
|   |   |   bcccfile
|   |   |   FILE
|   |   |
|   |   +---c
|   |   |   |   cfile
|   |   |   |   ccfile
|   |   |   |   cccfile
|   |   |   |
|   |   |   \---d
|   |   |       |   dfile
|   |   |       |
|   |   |       \---e
|   |   |               efile
|   |   |
|   |   +---b
|   |   |   |   file
|   |   |   |
|   |   |   \---c
|   |   |       |   file
|   |   |       |
|   |   |       \---d
|   |   |               file
|   |   |
|   |   \---a
|   |       |   FILE
|   |       |
|   |       +---b
|   |       |   |   FILE
|   |       |   |
|   |       |   \---c
|   |       |       |   FILE
|   |       |       |
|   |       |       \---d
|   |       |           |   FILE
|   |       |           |
|   |       |           \---f
|   |       |                   FILE
|   |       |
|   |       +---DIRRRRRR
|   |       |       file
|   |       |
|   |       \---AAAAAADIRRRRRR
|   \---234
\---b
    |   file
    |
    \---c
        |   file
        |
        \---d
                file


F:\dev\File_Tree>
Replies are listed 'Best First'.
Re: tree.pl - kinda like tree
by willianbr (Initiate) on Dec 22, 2011 at 14:21 UTC
    Thank you! It's save me a lot of time. The IBM AIX doesn't have TREE utility.
    Willian Silva Rodrigues
    Radio(NXTL):55*112*109193
    BBM PIN: 238d4349

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://149208]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others pondering the Monastery: (8)
As of 2024-04-23 16:36 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found