ls++

#!/usr/bin/perl
my $APP = 'ls++';
use vars qw($VERSION);
$VERSION = '0.340';

use strict;
use Term::ExtendedColor qw(fg uncolor);
use Pod::Usage;
use Getopt::Long;

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\n";
}

our(@c, @d, %ls_colors);

my $colors = _get_color_support();

$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,
};

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},

  '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; },

);

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

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

  while(my $line = <$ls>) {
    #total 1.7M
    next if $line =~ /^total/;


    # Assume GNU coreutils
    if($^O eq 'linux') {
      ($perm, $hlink, $user, $group, $size, $seconds) = split(/\s+/, $line)
        unless $line =~ /^\s/;

      ($file) = $line =~ m/.* \d{6,}? (.+)/;
    }
    elsif( ($^O eq 'darwin') or ($^O =~ /.+bsd$/) ) {
      ($perm, $hlink, $user, $group, $size) = split(/\s+/, $line);
      ($file) = $line =~ m/.*\d{2,}? (.*)/;

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


    if( (!$file) ) {
      next;
    }
    $file = add_ls_color($file) unless(!$ENV{DISPLAY});

    if(!defined($file)) { # ignored;
      next;
    }
    $file =~ s/-> (.+)/fg($c[15], '▪▶ ') . fg('italic', fg($c[4], $1))/e;

    if($^O eq 'linux') {
      $rel = relative_time(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_size_file($perm, $size, $file);
      next;
    }

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



    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;
    }
    else {
      perm_time_size_file($perm, $rel, $size, $file);
      next;
    }
  }
}

sub add_ls_color {
  my $file = shift;

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

    if($no_ls_color_file =~ /$pattern/) {
      if($ls_colors{$pattern} eq 'IGNORE') {
        return undef;
      }
      $file = $no_ls_color_file;
      $file = fg($ls_colors{$pattern}, $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) = @_;
  printf("%s %s%s%s%s%s%s%s\n",
    $d[0],
    $perm,
    $d[3],
    $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\n", $d[0], $perm, $d[3], $size, $d[2], $file);
  }
  else {
    printf("%s%s%s%19s%s%s\n", $d[0], $perm, $d[3], $size, $d[2], $file);
  }
}




sub perm {
  my ($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[2],  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 size {
  my ($size) = @_;

  #FIXME
  if($colors > 16) {
    #$size =~ s/(\S+)(K)/$c[2]$1\e[0m$c[4]$2\e[0m/gi;# and print "AA\n";

    # MacOS, BSD
    if(get_os() eq 'darwin') {
      return sprintf("% 40s", $size)
        if ($size =~ s/^\s*(.*)(K)$/fg($c[2], $1); fg($c[2], $2)/e);
        # 23 MacOS
        # 27 GNU
      return sprintf("% 23s", $size)
        if ($size =~ s/^(.*)(M)$/fg($c[7], $1); fg($c[17], $2)/e);
      return sprintf("% 27s", $size)
        if ($size =~ s/^(.*)(G)$/fg($c[3], $1); fg($c[17], $2)/e);
      return sprintf("% 27s", $size) # 1012B
        if ($size =~ s/^(\d+)$/fg($c[14], $1); fg($c[17], 'B')/e);
    }
    # GNU
    else {
      if($size =~ m/^(\S+)(K)/) {
        $size = sprintf("% 27s",
          fg($c[7], sprintf("% 4g", $1))
            . fg($c[2], fg('bold', $2))
          );
      }
      elsif($size =~ m/^(\S+)(M)/) {
        $size = sprintf("% 29s",
          fg($c[7], sprintf("% 4g", $1))
            . fg($c[4], fg('bold', $2))
          );
      }
      elsif($size =~ m/^(\S+)(G)/) {
        $size = sprintf("% 27s",
          fg($c[7], sprintf("% 4g", $1))
            . fg($c[3], fg('bold', $2))
          );
      }
      elsif($size =~ m/^(\d+)/) {
        $size = sprintf("% 27s",
          fg($c[7], sprintf("%4d", $1))
            . fg($c[14], fg('bold', 'B'))
          );
      }
      # return sprintf("% 27s", $size)
      #   if ($size =~ s/^(.*)(M)$/fg($c[7], $1);fg($c[17], $2)/e);
      # return sprintf("% 29s", $size)
      #   if ($size =~ s/^(.*)(G)$/fg($c[3], $1);fg($c[17], $2)/e);
      # return sprintf("% 27s", $size) # 1012B
      #   if ($size =~ s/^(\d+)$/fg($c[14], $1);fg($c[17], 'B')/e);
      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(!($ENV{DISPLAY})) {
    $colors = 16;
    return $colors;
  }
  if(
    $ENV{TERM} eq 'xterm'
      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} =~ /u?rxvt-256color/)
  ) {
    $colors = 256;
  }
  elsif($ENV{TERM} eq 'rxvt-unicode') {
    $colors = 88;
  }
  elsif($ENV{TERM} eq 'screen') {
    $colors = 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 $@;
  }

  my @locations = (
    "./ls++.conf",
    "$ENV{XDG_CONFIG_HOME}/ls++/ls++.conf",
    "$ENV{HOME}/.config/ls++/ls++.conf",
    "$ENV{HOME}/.ls++.conf",
    "$ENV{HOME}/.ls++/ls++.conf",
    "/etc/ls++.conf",
  );

  for my $conf(@locations) {
    if(-f $conf) {
      require $conf;
      if($@) {
        next;
      }
      return 1;
    }
  }
  return 0;
}


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

sub get_ls_where {
  my @files;
  for(@_) {
    if(-e $_) {
      push(@files, $_);
    }
    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 '-lvGc ' . join('', @ls_opts);
  }

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


sub get_os {
  return $^O;
}


__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

=head3 COLORS

  -ansi   use the standard ANSI colors

=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
  magnus@trapd00r.se
  http://japh.se

=head1 CONTRIBUTORS

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

=head1 COPYRIGHT

Copyright 2010, 2011 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