#!/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; }