#!/usr/bin/env perl

# archive_color (by Wolfgang Friebel), a slightly enhanced tarcolor
# changed date recognition (allow for localized dates), 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 http://geoff.greer.fm/lscolors/

use warnings;
use strict;

my $RESET = "\033[0m";


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

	if (substr($_, 0, 1) eq 'l') {
		return 'ln';
	} 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 $suntar_date = m{
		(?: [A-Z]\w\w)	# Month
		\s+
		\d{1,2}		# Day
		\s+
		\d{2}:\d{2}	# Time
		\s+
		\d{4}		# Year
		[\s,]+
		(.+?)		# Capture group 1: filename
		(?=\s->|$)
	}gx;

	if ($suntar_date) {
		return $1, pos();
	}

	my $bsdtar_date = m{
		(?: [A-Z]\w\w)	# Month
		\s+
		\d{1,2}		# Day
		\s+
		(?: (?: \d{4}) | (?: \d{2}:\d{2}))	# Year or time
		\s
		(.+?)		# Capture group 1: filename
		(?=\s->|$)
	}gx;

	if ($bsdtar_date) {
		return $1, pos();
	}

	my $bsdtar_date_dmy = m{
		\d{1,2}		# Day
		\s+
		(?: [A-Z]\w\w)	# Month
		\s+
		(?: (?: \d{4}) | (?: \d{2}:\d{2}))	# Year or time
		\s+
		(.+?)		# Capture group 1: filename
		(?=\s->|$)
	}gx;

	if ($bsdtar_date_dmy) {
		return $1, pos();
	}

	my $gnutar_date = m{
		\d{4}-\d{2}-\d{2}	# Date (%Y-%m-%d)
		\s
		\d{2}:\d{2}		# Time (%H:%M)
		(?: :\d{2})?		# [Optional] seconds in time
		\s+
		(.+?)			# Capture group 1: filename
		(?=\s->|$)
	}gx;

	if ($gnutar_date) {
		return $1, pos();
	}
}

sub color_filename {
	my ($color) = @_;

	my ($filename, $pos) = get_filename();

	if ($filename && $pos) {
		substr($_, $pos - length($filename), length($filename)) = $color . $filename . $RESET;
	}
}

sub default_ls_colors {
	return '';
}

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",
);

my $tar_colors = $ENV{'TAR_COLORS'} || $ENV{'LS_COLORS'} || default_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