Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 672638fa2d
Fetching contributors…

Cannot retrieve contributors at this time

executable file 672 lines (539 sloc) 14.245 kb
#!/usr/bin/perl
my $APP = 'ls++';
use vars qw($VERSION);
$VERSION = '0.348';
use strict;
use Term::ExtendedColor qw(fg uncolor);
use Pod::Usage;
use Getopt::Long;
use Time::Local;
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, $symlink_delim, $symlink_color);
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,
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);
my($second, $minute, $hour, $time, $month, $day, $year, %mon2num); #for Mac OS
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, $month, $day, $time, $year) = split(/\s+/, $line);
if( (!$day) ) {
printf("%s", $line);
next;
}
($file) = $line =~ m/.*\d{2,}? (.*)/;
$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) ) {
next;
}
$file = add_ls_color($file) unless(!$ENV{DISPLAY});
if(!defined($file)) { # ignored;
next;
}
my $symlink_attr = 'italic';
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(time(), $seconds);
} elsif ( ($^O eq 'darwin') or ($^O =~ /.+bsd$/) ) {
$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_time_size_file($perm, $rel, $size, $file);
#next;
}
# OK, probably GNU/Linux
else {
$size = size($size);
$size =~ s/^\s{3}(.+)/$1 /;
}
my $user = owner($user, $group);
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 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) = @_;
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%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 owner {
my ($user, $group) = @_;
$user = fg($c[7], $user);
$group = fg($c[8], $group);
return $user . ":". $group;
}
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";
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 $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 '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 = 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, 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;
}
__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
magnus@trapd00r.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 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
Jump to Line
Something went wrong with that request. Please try again.