ls++

#!/usr/bin/perl
# vim:ft=perl:et:
package App::lsplusplus;
my $APP = 'ls++';
our $VERSION = '0.68';
$App::lsplusplus::VERSION = '0.68';

use strict;
use utf8;
use open qw(:std :utf8);
use Term::ExtendedColor qw(fg uncolor);
use File::LsColor;
use Pod::Usage;
use Getopt::Long;
use Time::Local;
#use Data::Dumper;
use locale;

#{
#  package Data::Dumper;
#  no strict 'vars';
#  $Terse = $Indent = $Useqq = $Deparse = $Sortkeys = 1;
#  $Quotekeys = 0;
#}


my $ls       = '/bin/ls';
my @ls_opts  = get_ls_cmdline();
my @ls_where = get_ls_where(@ARGV);

if(not isa_tty()) {
  system($ls, @ls_where);
  exit;
}

if(not _init_config()) {;
  die "No configuration file found at $ENV{HOME}/.ls++.conf\n";
}

our(@c, @d, %ls_colors, $symlink_delim, $symlink_color, $symlink_attr);

my $colors = _get_color_support();
my ($sizelen, $stringlen, $permlen);

$ENV{DEBUG} and print "$_ x\n" for @c;

my $opt = {
  perm_file                 => undef,
  perm_time_file            => undef,
  perm_size_file            => undef,
  perm_time_size_file       => undef,
  perm_owner_time_size_file => undef,
};

Getopt::Long::Configure(
  qw(
    pass_through
    no_auto_abbrev
  )
);

GetOptions(
  'pf'        => \$opt->{perm_file},
  'psf'       => \$opt->{perm_size_file},
  'ptsf'      => \$opt->{perm_time_size_file},
  'potsf'     => \$opt->{perm_owner_time_size_file},

  'ansi'      => sub {
    $colors = 16;
    @c = (
      '30', '30;1',
      '31', '31;1',
      '32', '32;1',
      '33', '33;1',
      '34', '34;1',
      '35', '35;1',
      '36', '36;1',
      '37',

      '33;1',
      '0',
      '1',
    );
    map { $_ = "\e[$_" . 'm' } @c;
  },

  'm|man'     => sub { pod2usage(verbose => 3); },
  'h|help'    => sub { pod2usage(verbose => 1); },
  'v|version' => sub { print "$APP v$VERSION\n" and exit 0; },

);

my @ls_opts_cleaned;

for my $opt(@ls_opts) {
  if ($opt !~ /--(pf|psf|ptsf|pfs|fsp|fps|sfp|spf|pstf|sptf|pstf|ptsf|potsf)/) {
    push @ls_opts_cleaned, $opt;
  }
}
@ls_opts = @ls_opts_cleaned;

if( !(exists($ENV{DISPLAY})) and ($ENV{TERM} =~ m/^linux/) ) {
  @d = (' ', ' ', ' ', ' ');
  $ENV{LS_COLORS} = '';
  $colors = 16;
  @c = (
    '30', '30;1',
    '31', '31;1',
    '32', '32;1',
    '33', '33;1',
    '34', '34;1',
    '35', '35;1',
    '36', '36;1',
    '37',

    '33;1',
    '0',
    '1',
  );
  map { $_ = "\e[$_" . 'm' } @c;
}


if($colors > 88) {
  map { $_ = fg('gray20', $_); } @d;
}
else {
  map { $_ = fg($c[0], $_); } @d;
}

ls();


sub ls {
  my $view = shift // 'perm_size_file';
  my($perm, $hlink, $user, $group, $size, $seconds, $file, $rel, $major_num, $minor_num);
  my($userpad, $grouppad);
  my($second, $minute, $hour, $time, $month, $day, $year, %mon2num); #for Mac OS
  my $the_time=time();

  open(my $ls, '-|', "$ls @ls_opts @ls_where")
    or die("Cant popen $ls: $!");

  local $/=undef;
  foreach my $sub (split(/\n\n/, <$ls>)) {
  ($sizelen, $permlen) = get_max_col_len($sub);
  my $special_file;
  foreach my $line (split(/^/, $sub . "\n")) {
    my $firstchar = substr($line,0,1);
    if ($firstchar eq "b" || $firstchar eq "c"){
      # probably special block or character file
      $special_file = 'true';
    }
    else {
      $special_file = 'false';
    }
    if ($line =~ /^\n$/) {
      print();
      next;
    }
    # Assume GNU coreutils
    if($^O eq 'linux') {
      if ($special_file ne "true"){
        ($perm, $hlink, $user, $group, $size, $seconds, $file) = split(/\s+/, $line, 7)
          unless $line =~ /^\s/;
          chop($file);
      }
      else {
        ($perm, $hlink, $user, $group, $major_num, $minor_num, $seconds, $file) = split(/\s+|,\s*/, $line, 8)
          unless $line =~ /^\s/;
          $size = $major_num . ",". $minor_num; #special files don't list their size like regular files do
          chop($file);
      }
    ($userpad, $grouppad) = $line =~ m/\d+\s+\S+\s(\s*)\S+(\s*)\s.{$sizelen}\s\d+\s+.*/;
    }
    elsif( ($^O eq 'darwin') or ($^O =~ /.+bsd$/) ) {
        ($perm, $hlink, $user, $group, $size, $day, $month, $time, $year, $file) = split(/\s+/, $line, 10);
        chop($file);
        if( (!$day) ) {
          printf("%s", $line);
          next;
        }
        $file = uncolor($file);

        $perm =~ s/(?:\+|\@)$//g; # MacOS 'special extended attributes'

        # Mac OS date conversion
        ($hour, $minute, $second) = split(/:/, $time);
        %mon2num = qw(
          jan 0  feb 1  mar 2  apr 3  may 4  jun 5
          jul 6  aug 7  sep 8  oct 9  nov 10 dec 11
        );
        $month = $mon2num{ lc substr($month, 0, 3) };
        $seconds = timelocal($second, $minute, $hour, $day, $month, $year);

    }


    if( (!$file) ) {
      if( $line =~ /(.*):/ ) {
        # for situations like ls ~/dev/*; print the directory summary
        # with correct LS_COLORS attribute
        printf("\n%s:\n", fg(File::LsColor::can_ls_color('di'), $1));
      }
      elsif( $line =~ /^total (.*)/ ) {
        (undef, $size) = split(/\s+/, $line);
        printf("%s %s\n", fg($c[1], 'total'), ($size = size($1)) =~ s/\s+//gr);
      }
      next;
    }
    $file = add_ls_color($file) unless(!$ENV{DISPLAY});

    if(!defined($file)) { # ignored;
      next;
    }

    if($ENV{TERM} =~ m/xterm/) {
      # NOTE xterm does not support italics
      $symlink_attr = '';
    }
    $file =~ s{ ->\s(.+) }{ fg($symlink_color, "$symlink_delim ")
      . fg($symlink_attr, fg($c[4], $1))
    }ex;

    if($^O eq 'linux') {
      $rel = relative_time($the_time, $seconds);
    } elsif ( ($^O eq 'darwin') or ($^O =~ /.+bsd$/) ) {
      $rel = relative_time($the_time, $seconds);
    } else {
      $rel = '';
    }
    $perm = perm($perm);

    if( ($^O eq 'darwin') or ($^O =~ /.+bsd$/) ) {
      $size = size($size);
      $size =~ s/\s{6}//;

      $size = "\0" x 40 . "    " if !$size;

      # The only thing supported on these platforms for now.
      # Patches very welcome.
      #perm_time_size_file($perm, $rel, $size, $file);
      #next;
    }

    # OK, probably GNU/Linux
    else {
      $size = size($size);
      #$size =~ s/\s{3}(.+)/$1 /; # probably not useful anymore
    }

    my $user = owner($userpad . $user, $group . $grouppad);

    if($opt->{perm_file}) {
      perm_file($perm, $file);
      next;
    }
    elsif($opt->{perm_time_file}) {
      perm_time_file($perm, $rel, $file);
      next;
    }
    elsif($opt->{perm_size_file}) {
      perm_size_file($perm, $size, $file);
      next;
    }
    elsif($opt->{perm_owner_time_size_file}) {
      perm_owner_time_size_file($perm, $user, $rel, $size, $file);
      next;
    }
    else {
      perm_time_size_file($perm, $rel, $size, $file);
      next;
    }
  }
  }
}

sub get_max_col_len {
  my($out) = @_;
  my($perm, $size, $max_size, $cur_size, $max_perm, $cur_perm);
  $max_size = 0;
  $max_perm = 0;
  foreach my $line (split(/^/, $out)) {
    ($perm, undef, undef, undef, $size) = split(/\s+/, $line);
    $cur_size = length($size);
    $cur_perm = length($perm);
    #special files show between 4 and 7 characters + 1 space: 255, 255
    if ($line =~ /\d+,\s+\d+/){
        $cur_size += 4;
    }
    $max_size = ($max_size, $cur_size)[$max_size < $cur_size];
    $max_perm = ($max_perm, $cur_perm)[$max_perm < $cur_perm];
  }
  return $max_size, $max_perm;
}

sub add_ls_color {
  my $file = shift;

  for my $pattern(keys(%ls_colors)) {
    my $no_ls_color_file = uncolor($file);

    # check if file is a directory and add a / suffix for simple
    # matching in ls++.conf
    if(-d $no_ls_color_file) {
      $no_ls_color_file .= '/' unless $no_ls_color_file =~ m{/$};
    }

    if($no_ls_color_file =~ m{$pattern}) {
      $file = $no_ls_color_file;
      if($ls_colors{$pattern} eq 'IGNORE') {
        return undef;
      }

#      # add attributes
#      # 'README$' => 'bold italic 220 underline',
      for my $attr(split(/\s+/, $ls_colors{$pattern})) {
        $file = fg($attr, $file);
        # if several attributes are specified, the END sequence is added
        # more than once. let's get rid of it so we can remove match and
        # remove the trailing /
        $file =~ s{(\e\[0?m)+}{$1}g;
      }
    }
  }
  # remove the trailing slash again
  $file =~ s{/(\e\[0?m)$}{$1};
#  print Dumper $file;
  return $file;
}

sub perm_file {
  my ($perm, $file) = @_;
  printf("%s%s%s%s\n", $d[0], $perm, $d[3], $file);
}


sub perm_time_size_file {
  my ($perm, $rel, $size, $file) = @_;
  if(get_os() eq 'darwin') {
    printf("%s%s%s%s%s%6s%s%s\n",
      $d[0],
      $perm,
      $d[3],
      $rel,
      $d[2],
      $size,
      $d[2],
      $file,
    );
  } else {
    printf("%s %s%s%s%s%s%s%s\n",
      $d[0],
      $perm,
      $d[3],
      $rel,
      $d[2],
      $size,
      $d[2],
      $file,
    );
  }

}

sub perm_owner_time_size_file {
  my ($perm, $user, $rel, $size, $file) = @_;
  if(get_os() eq 'darwin') {
    printf("%s%s%s%s%s%s%6s%s%s\n",
      $d[0],
      $perm,
      $d[3],
      $user,
      $d[2],
      $rel,
      $d[2],
      $size,
      $d[2],
      $file,
    );
  } 
  else {
    printf("%s %s%s%s%s%s%s%s%s%s\n",
      $d[0],
      $perm,
      $d[3],
      $user,
      $d[2],
      $rel,
      $d[2],
      $size,
      $d[2],
      $file,
    );
  }
}

sub perm_size_file {
  my ($perm, $size, $file) = @_;
  if(get_os() eq 'darwin') {
    if(length($size) == 38) {
      #$size = " $size ";
    }
    elsif(length($size) == 37) {
      $size .= ' ';
    }
    elsif(length($size) == 24) {
      $size = "            $size            ";
    }
    else {
    }
    printf("%s%s%s%s%s%s%s\n", $d[0], $perm, $d[3], $size, $d[2], $file);
  }
  else {
    printf("%s%s%s%*s%s%s\n", $d[0], $perm, $d[3], $stringlen, $size, $d[2], $file);
  }
}




sub perm {
  my ($perm) = @_;
  if (length($perm) < $permlen){
    # adding an extra space to align with occasional +
    $perm .= " ";
  }

  $perm =~ s/-/$d[1]/g;
  $perm =~ s/(r)/fg($c[2], $1)/eg;
  $perm =~ s/(w)/fg($c[7], $1)/eg;
  $perm =~ s/(x)/fg($c[1], $1)/eg;

  $perm =~ s/(d)/fg($c[16],   fg('bold', $1))/eg;
  $perm =~ s/(l)/fg($c[8],  fg('bold', $1))/eg;
  $perm =~ s/(s)/fg($c[11], $1)/eg;
  $perm =~ s/(S)/fg($c[8],  $1)/eg;
  $perm =~ s/(t)/fg($c[8],  $1)/eg;
  $perm =~ s/(T)/fg($c[8],  fg('bold', $1))/eg;

  return $perm;
}

sub owner {
  my ($user, $group) = @_;

  $user  = fg($c[7], $user);
  $group = fg($c[8], $group);
  return $user . ":". $group;
}

sub size {
  my ($size) = @_;
  if ($size =~ /\d+,\s*\d+$/){ # not size but major/minor values for special files
    $size = sprintf("%*s", $sizelen, $size);
    return $size;
  }
  $size =~ s/,/./;
  #FIXME
  if($colors > 16) {
    #$size =~ s/(\S+)(K)/$c[2]$1\e[0m$c[4]$2\e[0m/gi;# and print "AA\n";
    if($sizelen < 4){ # constraining size length between 4 and 8 characters max
        $stringlen = 4;
    }
    elsif($sizelen >= 8){
        $stringlen = 7;
    }
    else
    {
        $stringlen = $sizelen;
    }
    if($size =~ m/^(\S+)(K)/) {
      $size = sprintf("%27s",
        fg($c[7], sprintf("%*g", $stringlen, $1))
          . fg($c[2], fg('bold', $2))
        );
    }
    elsif($size =~ m/^(\S+)(M)/) {
      $size = sprintf("%29s",
        fg($c[7], sprintf("%*g", $stringlen, $1))
          . fg($c[9], fg('bold', $2))
        );
    }
    elsif($size =~ m/^(\S+)(G)/) {
      $size = sprintf("%27s",
        fg($c[7], sprintf("%*g", $stringlen, $1))
          . fg($c[3], fg('bold', $2))
        );
    }
    elsif($size =~ m/^(\d+)/) {
      $size = sprintf("%27s",
        fg($c[7], sprintf("%*d", $stringlen, $1))
          . fg($c[14], fg('bold', 'B'))
        );
    }
      return $size;
  }

  # ANSI
  else {
    return sprintf("% 26s", $size)
      if ($size =~ s/(.*)(K)/$c[2]$1$c[2]$c[17]$2$c[16]/);
    return sprintf("% 23s", $size)
      if ($size =~ s/(.*)(M)/$c[7]$1$c[17]$2$c[16]/);
    return sprintf("% 23s", $size)
      if ($size =~ s/(.*)(G)/$c[3]$1$c[17]$2$c[16]/);
    return sprintf("% 21s", $size) # 1012B
      if ($size =~ s/(\d+)/$c[14]$1$c[17]B$c[16]/);
  }
}



sub relative_time_format {
  my ($color, $string, $unit) = @_;
  return sprintf("%s%-3s%-3s", $color, $string, $unit);
}



sub relative_time {
  my ($cur, $sec) = @_;
  my $delta = $cur - $sec;
  my ($unit, $ret);

  ## 0 < sec < 60
  $unit = "sec ";
  $ret = $delta;

  return relative_time_format(fg($c[3]), "<", $unit)
    if $delta < 10;
  return relative_time_format(fg($c[3]), $ret, $unit)
    if $delta < 60;

  ## 1 < min < 45
  $unit = "min ";
  $ret = int($ret/60);

  return relative_time_format(fg($c[15]), "<", $unit)
    if $delta < 2 * 60;
  return relative_time_format(fg($c[15]), $ret, $unit)
    if $delta < 45 * 60;

  ## 0.75 < hour < 42
  $unit = "hour";
  $ret = int($ret/60);

  return relative_time_format(fg($c[9]), "<", $unit)
    if $delta < 90 * 60;
  return relative_time_format(fg($c[9]), $ret, $unit)
    if $delta < 24 * 60 * 60;
  return relative_time_format(fg($c[9]), $ret, $unit)
    if $delta < 30 * 60 * 60;
  return relative_time_format(fg($c[9]), $ret, $unit)
    if $delta < 36 * 60 * 60;

  ## 0.75 < day < 30
  $unit = "day ";
  $ret = int($ret/24);

  return relative_time_format(fg($c[4]), "<", $unit)
    if $delta < 48 * 60 * 60;
  return relative_time_format(fg($c[4]), $ret, $unit)
    if $delta < 7 * 24 * 60 * 60;
  return relative_time_format(fg($c[4]), $ret, $unit)
    if $delta < 14 * 24 * 60 * 60;
  return relative_time_format(fg($c[4]), $ret, $unit)
    if $delta < 28 * 24 * 60 * 60;
  return relative_time_format(fg($c[4]), $ret, $unit)
    if $delta < 30 * 24 * 60 * 60;

  ## 1 < month < 12
  $unit = "mon ";
  $ret = int($ret/30);

  return relative_time_format(fg($c[14]), "<", $unit)
    if $delta < 2 * 30 * 24 * 60 * 60;
  return relative_time_format(fg($c[14]), $ret, $unit)
    if $delta < 12 * 30 * 24 * 60 * 60;

  ## 1 < years < inf
  $unit = "year";
  $ret = int($ret/12);

  return relative_time_format(fg($c[0]), $ret, $unit);
}


sub _get_color_support {
  my $colors = 8;
  if(exists($ENV{DISPLAY}) && !($ENV{DISPLAY})) {
    $colors = 16;
    return $colors;
  }
  if(
    $ENV{TERM} eq 'xterm'
      or($ENV{TERM} eq 'xterm-256color') # What Mac OS Lion terminal pretends to be
      or($ENV{TERM} eq 'rxvt-256-color')
      or($ENV{TERM} =~ /screen-256/)
      or($ENV{TERM} eq 'Eterm-256color')
      or($ENV{TERM} eq 'gnome-256color')
      or($ENV{TERM} eq 'konsole-256color')
      or($ENV{TERM} eq 'putty-256color')
      or($ENV{TERM} eq /rxvt-unicode-256color/)
      or($ENV{TERM} =~ /u?rxvt-256color/)
  ) {
    $colors = 256;
  }
  elsif($ENV{TERM} eq 'rxvt-unicode') {
    $colors = 88;
  }
  elsif($ENV{TERM} eq 'screen') {
    $colors = $ENV{TMUX} ? 256 : 8;
  }
  else {
    chomp($colors = `tput colors`); # fail silently
  }

  return $colors;
}


sub _init_config {
  my $config;

  if($ENV{DEBUG}) {
    require('./ls++.conf');
    print "Using ./ls++.conf\n" unless $@;
  }

  require "$ENV{HOME}/.ls++.conf",
  return 1;
}


sub isa_tty {
  return 1 if -t STDOUT;
  return 0;
}

sub get_ls_where {
  my @files;
  for(@_) {
    if(-e $_) {
      push(@files, escape($_));
    }
    else {
      push(@ls_opts, $_);
    }
  }
  return (wantarray()) ? @files : scalar(@files);
}


sub get_ls_cmdline {
  my $os = get_os();

  if( ($os eq 'darwin') || ($os =~ m/.*bsd$/) ) {
    return '-lvGcTh ' . join('', @ls_opts);
  }

  return '-hlv --group-directories-first --color=always --time=ctime ' .
         '--time-style=+%s ' . join('', @ls_opts);
}

sub escape {
  my $p = shift;
  $p =~ s/([;<>*|`&\$!#()[\]{}:'" ])/\\$1/g;
  return $p;
}

sub get_os {
  return $^O;
}



1;
__END__


=pod

=head1 NAME

ls++ - colorized ls on steroids

=head1 USAGE

ls++ [VIEW..] [OPTIONS..] [FILE]

=head1 DESCRIPTION

ls++ is what GNU/BSD ls would look like with extensive makeup applied.

=head1 OPTIONS

=head3 Views

  --pf    permissions, file
  --psf   permissions, size, file
  --ptsf  permissions, time, size, file
  --potsf permissions, owner, time, size, file

=head3 Documentation

  --help  show the help and exit
  --man   show the manpage and exit

Not known parameters will be passed through to B<ls>, so to show hidden files,
C<-a> or C<-A> might be added. See ls(1) for more information.

=head1 HISTORY

I wanted to re-arrange the ls output just like one can do with the -printf
option to GNU find. Sadly, there are no -printf option available for ls, so I
threw together a quick hack called 'pilsner' that did what I wanted and nothing
more, nothing less. Not very useful to others.

Mattias Svanström crafted together the 'l' application which did basicly the
same thing but more elegant and with a nice twist; it calculated relative
mtimes.

I really liked that idea, but there were a couple of annoyances, so I forked the
project and added a configuration file, support for flags that'll control the
different views and possiblity to ignore certain files amongst other things.

=head1 AUTHOR

  Magnus Woldrich
  CPAN ID: WOLDRICH
  m@japh.se
  http://japh.se

=head1 CONTRIBUTORS

The relative time calculations is made by Mattias Svanström.

crshd added optional user:group display.

=head1 COPYRIGHT

Copyright 2010, 2011, 2019- the B<ls++> L</AUTHOR> and L</CONTRIBUTORS> as listed
above.

=head1 LICENSE

This application is free software; you may redistribute it and/or modify it
under the same terms as Perl itself

=head1 SEE ALSO

L<ls++.conf(1)>

L<ls(1)>

L<l|http://github.com/mmso/scripts>

=cut