treeify

#!/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);