Skip to content
Permalink
main
Switch branches/tags
Go to file
 
 
Cannot retrieve contributors at this time
executable file 331 lines (297 sloc) 7.63 KB
#!/usr/bin/env perl
# treeify - display a list of files as a tree
# (c) 2013-2016 Mantas Mikulėnas <grawity@gmail.com>
# Released under the MIT License (dist/LICENSE.mit)
use v5.10;
use warnings;
use strict;
use constant { true => 1, false => 0 };
use File::Spec;
use Getopt::Long qw(:config bundling no_ignore_case);
my %GRAPH = (
# tree
s_mid => "",
i_mid => "",
i_end => "",
s_end => " ",
# tree branch extension/padding
i_br => "",
s_br => " ",
# sideways branch
br_cont => "",
br_leaf => "",
# ghost nodes
ghost_pre => "[",
ghost_suf => "]",
);
my %COLOR = (
tree => "",
ghost => "",
reset => "",
);
my %opt = (
style => "normal",
color => "auto",
fake_root => undef,
max_depth => 0,
no_ghosts => 0,
path => undef,
print_full => 0,
reverse => 0,
separator => "/",
);
sub color {
my ($color, $str) = @_;
if ($color && $COLOR{$color}) {
return $COLOR{$color}.$str.$COLOR{"reset"};
} else {
return $str;
}
}
sub canonpath {
my ($path) = @_;
if ($opt{separator} ne "/") {
return $path;
} elsif ($path =~ m|^(\./)|) {
return $1 . File::Spec->canonpath($path);
} else {
return File::Spec->canonpath($path);
}
}
sub split_path {
my ($path) = @_;
$path = canonpath($path);
my @path;
for (split(/\Q$opt{separator}\E+/, $path)) {
if ($_ eq "") { push @path, $opt{separator}; }
elsif (!@path) { push @path, $_; }
elsif ($_ eq ".") { next; }
elsif ($_ eq "..") { pop @path; }
else { push @path, $_; }
}
if ($opt{reverse}) {
@path = reverse @path;
}
return @path ? @path : $opt{separator};
}
sub walk {
my ($branch, $path) = @_;
for (split_path($path)) {
$branch = $branch->{$_} //= {};
}
return $branch;
}
sub crawl {
my ($branch, $child) = @_;
while ($branch->{$child}) {
$branch = $branch->{$child};
}
return $branch;
}
sub deepcount {
my ($branch) = @_;
my $count = 0;
for (values %$branch) {
$count += 1 + deepcount($_);
}
return $count;
}
sub show {
my ($branch, $seen, $depth, $graph, $path) = @_;
$depth //= 0;
$graph //= [""];
$path //= "";
# Child tree indent level
my $sub_indent = $opt{sub_indent} // 1;
# Rightwards branch length
my $branch_pad = $opt{branch_pad} // 1;
# Whether child trees descend from the branch
my $sideways = $opt{sideways} // false;
# Space between branch and label (currently sideways-only)
my $name_pad = $opt{name_pad} // 0;
# Whether we have reached maximum allowed depth (don't descend, just show count)
my $at_max_depth = ($opt{max_depth} && $depth >= $opt{max_depth});
# If a fake root is shown, do not prefix it to paths (skip 1st level).
my $skip_path_levels = defined($opt{fake_root}) ? 1 : 0;
my @keys = keys %$branch;
if (eval {require Sort::Naturally}) {
@keys = Sort::Naturally::nsort(@keys);
} else {
@keys = sort @keys;
}
while (@keys) {
my $name = shift @keys;
my $node = $branch->{$name};
my $exists = $opt{no_ghosts} || exists($seen->{$node});
my $n_children = keys %$node;
if ($at_max_depth && $n_children) {
$n_children = deepcount($node);
}
if ($opt{print_full}) {
# Display full path of the current node
if ($path eq $opt{separator}) {
$name = $opt{reverse}
? $name.$path
: $path.$name;
} elsif ($depth > $skip_path_levels) {
$name = $opt{reverse}
? $name.$opt{separator}.$path
: $path.$opt{separator}.$name;
}
}
if ($depth > 0) {
$graph->[$depth] = (@keys ? $GRAPH{i_mid} : $GRAPH{i_end}).($GRAPH{i_br} x $branch_pad);
} elsif ($sideways) {
# For sideways graphs (where subtrees descend directly
# from the branch, rather than from the name), even the
# root has a branch, therefore needs padding.
$graph->[$depth] = ($GRAPH{i_br} x $branch_pad);
} else {
$graph->[$depth] = "";
}
my $tree_str = join(" " x $sub_indent, @$graph);
if ($sideways) {
$tree_str .= ($n_children ? $GRAPH{br_cont} : $GRAPH{br_leaf});
}
if ($depth > 0) {
$graph->[$depth] = (@keys ? $GRAPH{s_mid} : $GRAPH{s_end}).($GRAPH{s_br} x $branch_pad);
} elsif ($sideways) {
$graph->[$depth] = ($GRAPH{s_br} x $branch_pad);
} else {
$graph->[$depth] = "";
}
my $line_str;
$line_str .= color("tree", $tree_str);
$line_str .= " " x $name_pad;
if ($exists) {
$line_str .= $name;
} else {
$line_str .= color("tree", $GRAPH{ghost_pre});
$line_str .= color("ghost", $name);
$line_str .= color("tree", $GRAPH{ghost_suf});
}
if ($at_max_depth && $n_children) {
$line_str .= color("tree", " ($n_children)");
}
print "$line_str\n";
show($node, $seen, $depth+1, $graph, $name) if !$at_max_depth;
}
pop @$graph;
}
sub usage {
print "$_\n" for
"Usage: treeify [-d DEPTH] [-f] [-g] [-r ROOT] [-R] [-s SEP] [-y STYLE] [PATH]",
"", #
" -d, --max-depth DEPTH Limit tree depth",
" -f, --full-names Show full names of branches and leaves",
" -g, --no-ghosts Do not highlight 'ghost' branches",
" -r, --fake-root PATH Prefix with a fake root container",
" -R, --reverse Process paths in reverse (for DNS domains)",
" -s, --separator SEP Split paths at SEP instead of '/'",
" -y, --style STYLE Change appearance (pass 'help' for options)",
" PATH Only show items under given branch";
}
GetOptions(
"help" => sub { usage(); exit; },
"C|color=s" => \$opt{color},
"d|max-depth=i" => \$opt{max_depth},
"f|full-names+" => \$opt{print_full},
"g|no-ghosts" => \$opt{no_ghosts},
"r|fake-root=s" => \$opt{fake_root},
"R|reverse" => \$opt{reverse},
"s|separator=s" => \$opt{sep},
"y|style=s" => \$opt{style},
# Handle oldstyle digit options such as '-10'
map {
$_ => sub { $opt{max_depth} = ($opt{max_depth} * 10) + int($_[0]) },
} 0..9,
) or exit(2);
for (@ARGV) {
if (/^@(.+)$/) {
$opt{fake_root} = $1;
} else {
$opt{path} = canonpath($_);
}
}
# decide on output features
if ($opt{style} eq "normal") {
1;
} elsif ($opt{style} eq "compact") {
$opt{sub_indent} = 0;
} elsif ($opt{style} eq "vcompact") {
$opt{sub_indent} = 0;
$opt{branch_pad} = 0;
} elsif ($opt{style} eq "sideways") {
$opt{sideways} = true;
$opt{sub_indent} = 0; # required
$opt{name_pad} = 1; # adjustable
} elsif ($opt{style} eq "sideways-compact") {
$opt{sideways} = true;
$opt{sub_indent} = 0;
$opt{name_pad} = 0;
} elsif ($opt{style} eq "sideways-vcompact") {
$opt{sideways} = true;
$opt{sub_indent} = 0;
$opt{branch_pad} = 0;
$opt{name_pad} = 0;
} elsif ($opt{style} eq "help") {
warn "Supported styles:\n";
warn " - $_\n" for qw(
normal
compact
vcompact
sideways
sideways-compact
sideways-vcompact
);
exit(1);
} else {
die "error: Unknown style '$opt{style}'\n";
}
if ($opt{color} eq "auto") {
my $term = (-t 1) ? $ENV{TERM} : undef;
if (!$term || $term eq "dumb") {
$opt{color} = "off";
} elsif ($term =~ /-256color$/ || $term =~ /^(xterm|tmux)/) {
$opt{color} = "256";
} else {
$opt{color} = "16";
}
}
if ($opt{color} eq "256") {
%COLOR = (
tree => "\e[38;5;59m",
ghost => "\e[38;5;109m",
reset => "\e[m",
);
} elsif ($opt{color} !~ /^(no|off)$/) {
%COLOR = (
tree => "\e[36m",
ghost => "\e[36m",
reset => "\e[m",
);
}
# parse input
my $node;
my $tree = {};
my $seen = {};
# Parse input
while (<STDIN>) {
chomp;
$seen->{walk($tree, $_)} = 1;
}
# Descend into specified path
if ($opt{path}) {
# Discard any "./" prefix, so that 'find | treeify foo' would Do What
# You Mean and correctly descend into "./foo".
$tree = crawl($tree, ".");
$tree = {$opt{path} => walk($tree, $opt{path})};
}
# Prefix with fake root node
if ($opt{fake_root}) {
# If the input starts at "/", we want to throw that away when showing a
# custom root prefix.
$tree = crawl($tree, "/");
$tree = {$opt{fake_root} => $tree};
}
show($tree, $seen);