#! /usr/bin/env perl
#
# Colors detailed lists of archive contents similarly to the way GNU ls (in
# GNU coreutils) would color a directory listing.
#
# Copyright (c) 2012  Marc Abramowitz
# Copyright (c) 2017, 2022  Pauline Emily
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are
# met:
#
#   * Redistributions of source code must retain the above copyright
#     notice, this list of conditions and the following disclaimer.
#
#   * Redistributions in binary form must reproduce the above copyright
#     notice, this list of conditions and the following disclaimer in the
#     documentation and/or other materials provided with the distribution.
#
#   * Neither the name of Marc Abramowitz nor the names of its
#     contributors may be used to endorse or promote products derived from
#     this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
# IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
# TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
# PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR
# CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
# EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
# PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
# PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
# LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
# NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

use feature 'unicode_strings';
use open ':locale';
use strict;
use warnings;

my %FILE_TYPE_TO_COLOR = (
    "rs" => "\033[0m",
    "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",
);

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 (/\.\w+$/) {
        return '*' . $&;
    }
}

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

    my $match_date = m{
        \s+
        (?: \d{4}-\d{2}-\d{2} |   # Date (yyyy-mm-dd)
            \d{2}-\w{3}-\d{2} |   # Date (yy-mmm-dd)
            \d{1,2} \s+ \w{3} |   # Date (dd mmm)
            \w{3} \s+ \d{1,2} )   # Date (mmm dd)
        \s+
        (?: \d{2}:\d{2} \s+ \d{4}   |   # Time + Year
            \d{2}:\d{2}(?: :\d{2})? |   # Time (+ optional seconds)
            \d{4} )                     # Year
        [\s,]+
        (.+?)   # Capture group 1: filename
        (?=\s->|$)
    }gx;

    if ($match_date) {
        substr($_, pos() - length($1), length($1)) = $color . $1 . $FILE_TYPE_TO_COLOR{"rs"};
    }
}

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

while (<>) {
    $_ =~ s/[ \t]+$//; # trim trailing whitespace

    my $type = get_file_type();

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

    print;
}

=pod

=encoding utf8

=head1 NAME

B<colortar> — colors lists of archive contents

=head1 SYNOPSIS

B<cpio -i -tv> < I<file> | B<colortar>

B<dpkg -c --> I<file> | B<colortar>

B<pax -v> < I<file> | B<colortar>

B<rpm -qlv --> I<package> | B<colortar>

B<tar -tvf> I<file> | B<colortar>

B<unsquashfs -ll> I<file> | B<colortar>

B<xar -tvf> I<file> | B<colortar>

B<zipinfo --> I<file> | B<colortar>

=head1 DESCRIPTION

B<colortar> colors detailed lists of archive contents similarly to the way
GNU ls (in GNU coreutils) would color a directory listing. It works with the
B<cpio>,
B<dpkg>,
B<pax>,
B<rpm>,
B<tar>,
B<unsquashfs>,
B<xar> and
B<zipinfo>
utilities.

=head1 ENVIRONMENT

=over 12

=item LS_COLORS

Specifies what color to use for which attribute or file suffix.

=back

=head1 SEE ALSO

L<cpio(1)>,
L<dircolors(1)>,
L<dpkg(1)>,
L<pax(1)>,
L<rpm(1)>,
L<tar(1)>,
L<unsquashfs(1)>,
L<xar(1)>,
L<zipinfo(1)>

=head1 AUTHOR

Written by Marc Abramowitz and Pauline Emily.

=head1 COPYRIGHT

Copyright © 2012  Marc Abramowitz.
Copyright © 2017, 2022  Pauline Emily.
License BSD-3-Clause: L<Revised BSD License|https://directory.fsf.org/wiki/License:BSD-3-Clause>.

This is free software: you are free to change and redistribute it.
There is NO WARRANTY, to the extent permitted by law.

=cut