#!/usr/bin/env perl

# archive_color (by Wolfgang Friebel), a modified tarcolor, works also for
# other archive listings, such as rpm, debian, ar, isoinfo archives
#
# originally by Marc Abramowitz <marc at marc-abramowitz dot com>
#
# https://github.com/msabramo/tarcolor
#
# Colors output of `tar tvf` similarly to the way GNU ls (in GNU
# coreutils) would color a directory listing.
#
# Colors can be customized using an environment variable:
#
# TAR_COLORS='di=01;34:ln=01;36:ex=01;32:so=01;40:pi=01;40:bd=40;33:cd=40;33:su=0;41:sg=0;46'
#
# The format for TAR_COLORS is similar to the format used by LS_COLORS
# Check out the online LSCOLORS generator at https://geoff.greer.fm/lscolors/

use warnings;
use strict;

sub get_file_type {
	return if (length($_) < 20);

	if (substr($_, 0, 1) eq 'l') {
		return 'ln';
	} elsif (substr($_, 0, 10) eq 'drwxrwxrwx') {
		return 'ow';
	} elsif (substr($_, 0, 10) eq 'drwxrwxrwt') {
		return 'tw';
	} elsif (substr($_, 0, 1) eq 'd') {
		return 'di';
	} elsif (substr($_, 0, 1) eq 's') {
		return 'so';
	} elsif (substr($_, 3, 1) eq 'S') {
		return 'su';
	} elsif (substr($_, 6, 1) eq 'S') {
		return 'sg';
	} elsif (substr($_, 0, 1) eq 'p') {
		return 'pi';
	} elsif (substr($_, 0, 1) eq 'c') {
		return 'cd';
	} elsif (substr($_, 0, 1) eq 'b') {
		return 'bd';
	} elsif (substr($_, 0, 1) eq 'D') {
		return 'do';
	} elsif (substr($_, 3, 1) eq 'x') {
		return 'ex';
	} elsif (substr($_, -3, 2) =~ /.\//) {
		return 'di';
	} elsif (/\.\w{1,3}$/) {
		return '*' . $&;
	}
}

sub get_filename {
	my @items = split;
	return "@items[8..$#items]";
}

sub color_filename {
	my ($color) = @_;
	my $filename = get_filename();
	if ($filename) {
		s/$filename$/$color$filename\033[0m/;
	}
}

if ( -t STDIN ) {
	print "Example: tar tvzf some_tarball.tar.gz | archive_color\n";
	exit(0);
}

my %FILE_TYPE_TO_COLOR = (
	"di" => "\033[01;34m",
	"ln" => "\033[01;36m",
	"ex" => "\033[01;32m",
	"so" => "\033[01;35m",
	"pi" => "\033[40;33m",
	"bd" => "\033[40;33;01m",
	"cd" => "\033[40;33;01m",
	"su" => "\033[37;41m",
	"sg" => "\033[30;43m",
	"do" => "\033[01;35m",
	"tw" => "\033[30;42m",
	"ow" => "\033[34;42m",
);

my $tar_colors = $ENV{'TAR_COLORS'} || $ENV{'LS_COLORS'} || '';

foreach (split(':', $tar_colors)) {
	my ($type, $codes) = split('=');
	$FILE_TYPE_TO_COLOR{$type} = "\033[" . $codes . "m";
}

while (<>) {
	my $type = get_file_type();

	if ($type && $FILE_TYPE_TO_COLOR{$type}) {
		color_filename($FILE_TYPE_TO_COLOR{$type});
	}
	print;
}

# ABSTRACT: colors output of `tar tvf`
# PODNAME: archive_color

=pod

=head1 SYNOPSIS

tar tvzf <tarball.tar.gz> | archive_color

=head1 DESCRIPTION

Tarcolor colors the output of `tar tvf` similarly to how ls does it.

Colors output of `tar tvf` similarly to the way GNU ls (in GNU coreutils) would
color a directory listing.

Colors can be customized using an environment variable:

TAR_COLORS='di=01;34:ln=01;36:ex=01;32:so=01;40:pi=01;40:bd=40;33:cd=40;33:su=0;41:sg=0;46'

The format for TAR_COLORS is similar to the format used by LS_COLORS Check out
the online LSCOLORS generator at http://geoff.greer.fm/lscolors/

=head1 SEE ALSO

tarcolorauto(1)

=head1 SOURCE CODE

https://github.com/msabramo/tarcolor

=cut