"Fossies" - the Fresh Open Source Software Archive

Member "lesspipe-1.89/tarcolor" (25 Aug 2021, 4865 Bytes) of package /linux/misc/lesspipe-1.89.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 #!/usr/bin/env perl
    2 
    3 # tarcolor
    4 #
    5 # by Marc Abramowitz <marc at marc-abramowitz dot com>
    6 #
    7 # https://github.com/msabramo/tarcolor
    8 #
    9 # Colors output of `tar tvf` similarly to the way GNU ls (in GNU
   10 # coreutils) would color a directory listing.
   11 #
   12 # Colors can be customized using an environment variable:
   13 #
   14 # 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'
   15 #
   16 # The format for TAR_COLORS is similar to the format used by LS_COLORS
   17 # Check out the online LSCOLORS generator at http://geoff.greer.fm/lscolors/
   18 
   19 use warnings;
   20 use strict;
   21 
   22 my $RESET = "\033[0m";
   23 
   24 
   25 sub get_file_type {
   26     return if (length($_) < 10);
   27 
   28     if (substr($_, 0, 1) eq 'l') {
   29         return 'ln';
   30     } elsif (substr($_, 0, 1) eq 'd') {
   31         return 'di';
   32     } elsif (substr($_, 0, 1) eq 's') {
   33         return 'so';
   34     } elsif (substr($_, 3, 1) eq 'S') {
   35         return 'su';
   36     } elsif (substr($_, 6, 1) eq 'S') {
   37         return 'sg';
   38     } elsif (substr($_, 0, 1) eq 'p') {
   39         return 'pi';
   40     } elsif (substr($_, 0, 1) eq 'c') {
   41         return 'cd';
   42     } elsif (substr($_, 0, 1) eq 'b') {
   43         return 'bd';
   44     } elsif (substr($_, 0, 1) eq 'D') {
   45         return 'do';
   46     } elsif (substr($_, 3, 1) eq 'x') {
   47         return 'ex';
   48     } elsif (/\.\w{1,3}$/) {
   49         return '*' . $&;
   50     }
   51 }
   52 
   53 sub get_filename {
   54     my $suntar_date = m{
   55         (?: Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)  # Month
   56         \s+
   57         \d{1,2}                                               # Day
   58         \s+
   59         \d{2}:\d{2}                                           # Time
   60         \s+
   61         \d{4}                                                 # Year
   62         [\s,]+
   63         (.+?)                                                 # Capture group 1: filename
   64         (?=\s->|$)
   65     }gx;
   66 
   67     if ($suntar_date) {
   68         return $1, pos();
   69     }
   70 
   71     my $bsdtar_date = m{
   72         (?: Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)   # Month
   73         \s+
   74         \d{1,2}                                                # Day
   75         \s+
   76         (?: (?: \d{4}) | (?: \d{2}:\d{2}))                     # Year or time
   77         \s+
   78         (.+?)                                                  # Capture group 1: filename
   79         (?=\s->|$)
   80     }gx;
   81 
   82     if ($bsdtar_date) {
   83         return $1, pos();
   84     }
   85 
   86     my $bsdtar_date_dmy = m{
   87         \d{1,2}                                                # Day
   88         \s+
   89         (?: Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)   # Month
   90         \s+
   91         (?: (?: \d{4}) | (?: \d{2}:\d{2}))                     # Year or time
   92         \s+
   93         (.+?)                                                  # Capture group 1: filename
   94         (?=\s->|$)
   95     }gx;
   96 
   97     if ($bsdtar_date_dmy) {
   98         return $1, pos();
   99     }
  100 
  101     my $gnutar_date = m{
  102         \d{4}-\d{2}-\d{2}   # Date (%Y-%m-%d)
  103         \s 
  104         \d{2}:\d{2}         # Time (%H:%M)
  105         (?: :\d{2})?        # [Optional] seconds in time
  106         \s+
  107         (.+?)               # Capture group 1: filename
  108         (?=\s->|$)
  109     }gx;
  110 
  111     if ($gnutar_date) {
  112         return $1, pos();
  113     }
  114 }
  115 
  116 sub color_filename {
  117     my ($color) = @_;
  118 
  119     my ($filename, $pos) = get_filename();
  120 
  121     if ($filename && $pos) {
  122         substr($_, $pos - length($filename), length($filename)) = $color . $filename . $RESET;
  123     }
  124 }
  125 
  126 sub default_ls_colors {
  127     return '';
  128 }
  129 
  130 if ( -t STDIN ) {
  131     print "Example: tar tvzf some_tarball.tar.gz | tarcolor\n";
  132     exit(0);
  133 }
  134 
  135 
  136 my %FILE_TYPE_TO_COLOR = (
  137     "di" => "\033[01;34m",
  138     "ln" => "\033[01;36m",
  139     "ex" => "\033[01;32m",
  140     "so" => "\033[01;35m",
  141     "pi" => "\033[40;33m",
  142     "bd" => "\033[40;33;01m",
  143     "cd" => "\033[40;33;01m",
  144     "su" => "\033[37;41m",
  145     "sg" => "\033[30;43m",
  146 );
  147 
  148 my $tar_colors = $ENV{'TAR_COLORS'} || $ENV{'LS_COLORS'} || default_ls_colors();
  149 
  150 foreach (split(':', $tar_colors)) {
  151     my ($type, $codes) = split('=');
  152     $FILE_TYPE_TO_COLOR{$type} = "\033[" . $codes . "m";
  153 }
  154 
  155 while (<>) {
  156     my $type = get_file_type();
  157 
  158     if ($type && $FILE_TYPE_TO_COLOR{$type}) {
  159         color_filename($FILE_TYPE_TO_COLOR{$type});
  160     }
  161 
  162     print;
  163 }
  164 
  165 
  166 # ABSTRACT: colors output of `tar tvf`
  167 # PODNAME: tarcolor
  168 
  169 =pod
  170 
  171 =head1 SYNOPSIS
  172 
  173 tar tvzf <tarball.tar.gz> | tarcolor
  174 
  175 =head1 DESCRIPTION
  176 
  177 Tarcolor colors the output of `tar tvf` similarly to how ls does it.
  178 
  179 Colors output of `tar tvf` similarly to the way GNU ls (in GNU coreutils) would
  180 color a directory listing.
  181 
  182 Colors can be customized using an environment variable:
  183 
  184 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'
  185 
  186 The format for TAR_COLORS is similar to the format used by LS_COLORS Check out
  187 the online LSCOLORS generator at http://geoff.greer.fm/lscolors/
  188 
  189 =head1 SEE ALSO
  190 
  191 tarcolorauto(1)
  192 
  193 =head1 SOURCE CODE
  194 
  195 https://github.com/msabramo/tarcolor
  196 
  197 =cut