#!/usr/bin/perl 
# dim ( Directory IMage ) v. 1.1
# Copyright 2001 by Matt Chisholm - matt@theory.org
# 
# changelog:
# v. 1.0 first release
# v. 1.1 sep 19 2001 added:
#        -s display file-size 
#        -b display in bytes
#        -k display in kilobytes
#        -m display in megabytes
#        added support for rendering multiple directories in a single command 
#
# TODO: 
#        -d date support
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA

use strict;
#use Term::ReadKey;
use Getopt::Std;
use vars qw( $color $DEBUG $opt_a $opt_l $opt_h $opt_s $opt_k $opt_b $opt_m);
$DEBUG = 0;

&main();

sub main {
  getopts('alhsbkm');
  $color = Color->new();                                # read colors
  my @dirs = ();
  if ($opt_b or $opt_k or $opt_m ) { $opt_s = 1; }      # display size...

  map { push @dirs, $_ if ($_ !~ m/^-/); } (@ARGV);     # eliminate - opts
  
  if ($opt_h) { help() };

  if ($#dirs == -1) {                                   # no dirs listed
    showdir( "." );
  } elsif ($#dirs == 0) {                               # one dir listed
    showdir( $dirs[0] ) ;
  } else {
    foreach my $dir (@dirs) {                           # multiple dirs listed
      print "$dir:\n";
      showdir( $dir );
    }
  }
} 

sub help {
  print "dim ( Directory IMage ) v. 1.1
Copyright 2001 by Matt Chisholm - matt\@theory.org

-a list all files
-h show this help 
-l list mode (for future development) - currently lists total # of files
-s display file-size intelligently
-b display file-size in bytes
-k display file-size in kilobytes
-m display file-size in megabytes
";
exit;
}

sub showdir {
  my $dir = shift;
  
  opendir DIR, $dir;                                      # read directory
  my @dir = readdir( DIR ); 
  closedir DIR;
  
  if ($opt_l) {print "total ", $#dir-1, "\n";}
  if ($#dir<2) { exit; }
  
  if($DEBUG){ print "@dir", join ( ", ", @dir ), "\n" ;}
  
  my @file = ();
  foreach $_ (0..$#dir) {                                 # prune directory
    if (!(($dir[$_] =~ m/.+\~$/) or ($dir[$_] =~ m/^\./)) or ( $opt_a )) { 
      push @file, $dir[$_];
    }
  }

  if($DEBUG){ print "@file", join ( ", ", @file ), "\n";}
  
  my $tabl = Table->new( \@file, $dir, " ", "" );         # make table

  if($DEBUG){ $tabl->printt();  print "-"x 80, "\n";}

  $tabl->collapsetable();                                 # collapse table
  my $t = $tabl->printt();
  if($DEBUG){ print $tabl->{c}, "chars / entry\n"; }
  print render( $t, $#{$t}, (($tabl->{c}+2)*$tabl->{e})); # render table to terminal
}

sub termsize {
  # This lifted from /usr/lib/perl5/5.005/i386-linux/Term/ReadKey.pm
  # For some reason not all systems have this module...
  my @results;
  my($prog) = "resize";
                
  # Workaround for Solaris path sillyness
  if(-f "/usr/openwin/bin/resize") { $prog = "/usr/openwin/bin/resize"}
  
  my($resize) = scalar(`$prog`);
  if($resize =~ /COLUMNS\s*=\s*(\d+)/ or 
     $resize =~ /setenv\s+COLUMNS\s+'?(\d+)/)  {
     $results[0] = $1;
     if( $resize =~ /LINES\s*=\s*(\d+)/ or
	 $resize =~ /setenv\s+LINES\s+'?(\d+)/) {
	 $results[1] = $1;
      } else {
	@results = ();
      }
   } else {
     @results = ();
   }
  return @results;
}

sub render {
#  $DEBUG = 1;
  my ($list, $lh, $lw) = @_;
  my ($sw, $sh) = termsize();

#  my ($sw, $sh, undef, undef) = Term::ReadKey::GetTerminalSize STDOUT; 
#  my $sw = $ENV{COLUMNS};
#  my $sh = $ENV{LINES};
#  my $sw = `echo \$COLUMNS\n`;
#  my $sh = `echo \$LINES\n`;
 
  my $return;

  if($DEBUG){ print "screen width $sw line width $lw\n"; }

  if ($lh > $sh ) {          # if the table to render is longer than the screen
    my $cols = $sw / $lw ;
    my $cram = 0;
    if($DEBUG){ print "cols: $cols\n"; }
    $cols = int( $cols );
    if ($cols == 0) { $cols = 1; $cram = 1;}

    my $rows = int( $lh / $cols )+1;    
    if($DEBUG){ print "$cols columns\t$rows rows\n"; }
    
    my @start = ();
    
    foreach $_ ( 0 .. $cols ) {
      push @start, ($_*$rows);
    }
    if($DEBUG){ print join( ", ", @start), "\n"; }

    foreach my $sr ( 0 .. $rows-1 ) {
      if($DEBUG){ $return .= $sr; }
      foreach my $sc ( @start ) {
	$return .= $list->[$sr+$sc];
      }
      if ($cram) { $return =~ s/\ +\n$/\n/; } # try to cram the render into small space
      $return .= "\n";
    }
  } else {
    map { s/\ +$//g; $return .= $_."\n" ; } @{$list};
  } 
  return $return;
}
 
sub size {
  my $s = shift;

  if ($opt_b) {                # list bytes
    return $s."b";
  } elsif ($opt_k) {           # list kilobytes
    $s = int( $s / 1000 );
    return $s."k";
  } elsif ($opt_m) {           # list megabytes
    $s = int( $s / 1000000 );
    return $s."m";
  }

  my $l = length( $s );        # list sizes intelligently
  if ($l <= 2){                # Xb, XXb
    return $s."b";
  } elsif ( $l <= 3 ){         # .Xk
    $s = int( $s / 100 );    
    return ".".$s."k";
  } elsif ( $l <= 5 ){         # Xk, XXk
    $s = int( $s / 1000 );
    return $s."k";
  } elsif ( $l <= 6 ){         # .Xm
    $s = int( $s / 100000 ); 
    return ".".$s."m"; 
  } else {                     # Xm, XXm, XXXm, &c. 
    $s = int( $s / 1000000 );
    return $s."m";
  }
}


package Color;    

sub new {
  my $pkg = shift; 
  my @col = split ":", $ENV{LS_COLORS};
  my %col= ();
  map {
    my ($pat, $col) = split "=", $_;
    $col{$pat} = $col;
    if($main::DEBUG){print "$pat => $col\t" };
  } @col;

  bless \%col, $pkg;
}

sub ize {                  
  my ($self, $name) = @_;
  if($main::DEBUG){print "\"$name->{e}\" ==> ",$self->{"*.".$name->{e}},"\n",$name->{n}.".".$name->{e}, "\t";}
  my $path = $name->path();
  if ( -d $path ) { return $self->{di}; }
  if ( -l $path ) { return $self->{ln}; }
  if ( -p $path ) { return $self->{pi}; }
  if ( -S $path ) { return $self->{so}; }
  if ( -b $path ) { return $self->{bd}; }
  if ( -c $path ) { return $self->{cd}; }
#  if (( -l $path ) and (!( -e $path ))) { return $self->{or}; }
  if ( -x $path ) { return $self->{ex}; }
  return $self->{"*.".$name->{e}};
}

package Table;

sub new { 
  my ($pkg, $list, $dir, $itemsep, $linesep) = @_;
  my $i = 0;
  my $cellsize = 0;
  my $names = ();
  my $exts = ();
  my %names = ();
  my %exts = ();
  my $tabl = ();

  if (!defined($itemsep)) { $itemsep = " "; }                 # item separator
  if (!defined($linesep)) { $linesep = "|\n"; }               # line separator

  foreach $_ ( @{$list} ) {
    $_ = Name->new( $_, $dir);
    $names{$_->{n}} = 1;
    $exts{$_->{e}}  = 1;
    if ($_->{l} > $cellsize){ $cellsize = $_->{l};}#calculates longest filename
    if($main::DEBUG){ print "new elt $_->{n}, $_->{e}\n"; }
  }

  if($main::DEBUG){ print "cell size=$cellsize\n";}

# No longer necessary 
#  delete $names{""};                                     # eliminates .dotfiles 

  map { $names{$_} = $i ++; } (sort keys %names);        #  sorts names
  $names = $i;                                           # counts names 
  $i = 0;
  map { $exts{$_} = $i ++; } (sort keys %exts);          #  sorts extensions
  $exts = $i;                                            # counts extensions

  if($main::DEBUG){  print %names, "\n"; print %exts, "\n";}

  foreach $_ ( @{$list} ) {          
    $tabl->[ $names{$_->{n}} ][ $exts{$_->{e}} ] = $_;   # creates table 
    if($main::DEBUG){ print  $tabl->[ $names{$_->{n}} ][ $exts{$_->{e}} ];}
  }

  bless {
	 t => $tabl,
	 n => $names,
	 e => $exts,
	 c => $cellsize,
	 l => $linesep,
	 i => $itemsep,
	 d => $dir,
	}, $pkg; 
}

sub collapsetable {
  my $self = shift;
  my $i = 1;         # must start from 1 to avoid trying to collapse row 0 and col 0 
  my $maxname = 0;
  my $maxext  = 0;

  # the collapse-table loop alternates between collapsing a row, and a column. 
  # there may be more intelligent ways to do this.
  while (( $i <= $self->{e} ) or ( $i <= $self->{n} )) { 
    if ($i <= $self->{n} ) {
      my $j = $self->collapsename( $i );                  # collapse row i 
      if ($j > $maxname) { $maxname = $j ; }
    }
    if ($i <= $self->{e} ) {
      my $j = $self->collapseext( $i );                   # collapse col i
      if ($j > $maxext) { $maxext = $j ; }
    }
    $i++;
  }
  if($main::DEBUG){ print "$maxname, $maxext\n";}
  $self->{n} = $maxname + 1;
  $self->{e} = $maxext + 1;
}

sub collapsename {
  my ($self, $i) = @_;
  my $name = $self->calcnamefill( $i );                   # determine filled entries in row i
  my $j = $i;
  while ($self->nameempty( $j-1, $name ) and ($j > 0) ) { # look back to find empty previous rows
    $j-- ;
  } 
  if ( $j < $i ) {                                        # move filled entries in row i to row j 
    $self->movename( $i, $j, $name ); 
  }
  return $j;
}

sub collapseext {
  my ($self, $i) = @_;
  my $ext = $self->calcextfill( $i );                     # determine filled entries in col i
  my $j = $i;
  while ($self->extempty( $j-1, $ext ) and ($j > 0) ) {   # look back to find empty previous cols
    $j-- ;
  }
  if ( $j < $i ) {                                        # move filled entries in col i to col j
    $self->moveext( $i, $j, $ext ); 
  }
  return $j;
}

sub calcnamefill {
  my ( $self, $i ) = @_;
  my $r = 0;
  my @list = ();
  while ( $r <= $self->{e} ) {
    if ( defined( $self->{t}->[$i][$r] )) {
      push @list, $r;
    }
    $r++;
  }
  return \@list;
}

sub calcextfill {
  my ($self, $i) = @_;
  my $r = 0;
  my @list = ();
  while ( $r <= $self->{n} ) {
    if ( defined( $self->{t}->[$r][$i] )) {
      push @list, $r;
    }
    $r++;
  }
  return \@list;
}

sub nameempty {
  my ($self, $i, $list) = @_;
  foreach my $r ( @{$list} ) {
    if ( defined( $self->{t}->[$i][$r] )) { return 0; }
  }
  return 1;
}

sub extempty { 
  my ($self, $i, $list) = @_;
  foreach my $r ( @{$list} ) {
    if ( defined( $self->{t}->[$r][$i] )) { return 0; }
  }
  return 1;
}

sub movename {
  my ($self, $i, $j, $list) = @_;
  foreach my $r ( @{$list} ) {
    $self->{t}->[$j][$r] = $self->{t}->[$i][$r] ;
    $self->{t}->[$i][$r] = undef;
  }
}
    
sub moveext {
  my ($self, $i, $j, $list) = @_;
  foreach my $r ( @{$list} ) {
    $self->{t}->[$r][$j] = $self->{t}->[$r][$i] ;
    $self->{t}->[$r][$i] = undef;
  }
}

sub printt {
  my $self = shift;
  my $i = 0;   my $j = 0;
  my @return = ();

  if($main::DEBUG){  print $self->{e}, $self->{n},$self->{c},"\n";}
  while ($j < $self->{n} ) {
    my $return;
    if($main::DEBUG){ print "$j ";}
    while ($i < $self->{e} ) {
      if($main::DEBUG){print "$i ";}
      if (defined ( $self->{t}->[$j][$i] )){
	my $item = $self->{t}->[$j][$i];
	my $out  = $item->printn();
	$return .= $out . " "x(($self->{c})-$item->{l});
      } else {
	$return .= (" "x($self->{c}));
      }
      $return .= $self->{i};
      $i++;
    }
    $i = 0;
    $return .= $self->{l};#"\n";
    push @return, $return;
    $j++;
  }
  return \@return;
}

sub printt2 {
  my $self = shift;
  my $i = 0;   my $j = 0;
  my $return; 
  if($main::DEBUG){  print $self->{e}, $self->{n},$self->{c},"\n";}
  while ($j < $self->{n} ) {
    if($main::DEBUG){ print "$j ";}
    while ($i < $self->{e} ) {
      if($main::DEBUG){print "$i ";}
      if (defined ( $self->{t}->[$j][$i] )){
	my $item = $self->{t}->[$j][$i];
	my $out  = $item->printn();
	$return .= $out . " "x(($self->{c})-($item->{l}));
      } else {
	$return .= (" "x($self->{c}));
      }
      $return .= $self->{i};
      $i++;
    }
    $i = 0;
    $return .= $self->{l};
    $j++;
  }
  return $return;
}

package Name;

sub new {
  my ($pkg, $str, $dir ) = @_;
  my @dots = split /\./, $str;
  my $name = shift @dots; 
  my $ext = pop @dots;
  my $color = undef;
  if (@dots) {
    $name .= ".".join( ".", @dots );
  }
  if($main::DEBUG){ print "new name: $name, $ext\n"};
  my $size = " ".main::size((stat( $dir."/".$str ))[7]) if ($main::opt_s);

  bless {
	 n => $name, 
	 e => $ext, 
	 c => $color,
	 l => length($str)+length($size),
	 d => $dir,
	 s => $size
	}, $pkg;
}

sub name {
  my $self = shift;
  if ( defined $self->{e}) {
    return $self->{n}.".".$self->{e}
  } else {
    return $self->{n};
  }
}

sub path { 
  my $self = shift;
  return $self->{d}."/".$self->name();
}

sub printn {
  my $self = shift;
  my $ret = "\033[".$main::color->ize( $self ).";9m".$self->name()."\033[0m".$self->{s};
  return $ret;
}