#!/opt/perl/bin/perl
# This code copyright 1999 by
# W.M. Richards, NiEstu, Phoenix, AZ -- chipr@niestu.com
#
# This software is made freely available under the provisions of the Perl
# "Artistic" license:  http://language.perl.com/misc/Artistic.html
#
# This code is not supported and is not warranteed to perform any particular
# function. Contact chipr@niestu.com for aditional information.
# If you find bugs or make enhancements, it would be appreciated if you
# sent them on to the author at chipr@niestu.com.
#
# Determine (!?) OS type
$wnt  = ($0 =~ /.cmd$/i) ;
$dos  = ($0 =~ /.bat$/i) ;
$vms  = 0 ;  # how?
$unix = ! ($wnt || $dos || $vms) ;

#
# Some OS-specific things
$pwd_cmd = 'pwd' if ($unix) ;
$pwd_cmd = 'cd'  if ($wnt || $dos) ;

#
# Constants
$false = 0 ;
$true = 1 ;
@months = ( 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
            'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec' ) ;
$badchr = "?"; # Character to indicate bad soft link

$columns = defined ($ENV {'COLUMNS'}) ? $ENV {'COLUMNS'} : 80 ;


#
# Process command-line switches
for ($arg = 0 ;   $arg <= $#ARGV ;   ++$arg)
{
   if ($ARGV [$arg] =~ /^-/)
   {
      $option = $ARGV [$arg] ;
      $a = $true if $option =~ /[a]/i ;  # show hidden files, too
      $d = $true if $option =~ /[d]/i ;  # don't expand directory contents
      $e = $true if $option =~ /[e]/i ;  # sort by "extension"
      $f = $true if $option =~ /[f]/i ;  # sort by filename
      $l = $true if $option =~ /[l]/i ;  # long list
      $p = $true if $option =~ /[p]/i ;  # include full pathnames
      $s = $true if $option =~ /[s]/i ;  # sort by size
      $t = $true if $option =~ /[t]/i ;  # totals across directories
   }
}


#
# Settings based on options
$sortby = 'bytime' ;
$sortby = 'bysize' if $s ;
$sortby = 'byname' if $f ;
$sortby = 'byext'  if $e ;


#
# Cycle through all directories given, or current if no args
$overall_total = 0 ;
$skipping_options = $true ;
$dirs_tried = 0 ;
$dirs_listed = 0 ;
undef @files ;
for ($arg = 0 ;   $arg <= $#ARGV ;   ++$arg)
{
   $name = $ARGV [$arg] ;
   if ($skipping_options && $name =~ /^-/)
   {
      if ($name =~ /^--$/)
      {
         $skipping_options = $false ;
      }
      else
      {
         next ;
      }
   }
   ++$dirs_tried ;
   if (-d $name && (! $d))
   {
      &list_files ('') if (defined (@files)) ;
      &list_dir ($name) ;
   }
   else
   {
      push (@files, $name) ;
   }
}

#
# If we have files pending, list them
&list_files ('') if (defined (@files)) ;

#
# If we didn't list any directories, then at least list the current
if ($dirs_tried < 1)
{
   $name = `$pwd_cmd` ;
   chop ($name) ;
   &list_dir ($name) ;
}

#
# Overall total, if requested
print "\n$overall_total bytes total\n" if ($dirs_listed > 1 && $t) ;

exit (0) ;





#
# Main procedure
sub list_dir
{
   local ($dir) = @_ ;


   if (!opendir (DIR, $dir))
   {
      print STDERR  "Can't open directory '$dir':  $!\n" ;
      next ;
   }
   @files = readdir (DIR) if $a ;
   @files = grep (/^[^\.]/, readdir (DIR)) if ! $a ;
   closedir (DIR) ;

   &list_files ($dir) ;
}


#
# List files named in @files array (which are in directory $dir); undefs @files
sub list_files
{
   local ($dir) = @_ ;


   print "---\n" if $dirs_listed > 0 ;
   ++$dirs_listed ;  # a list of files qualifies as a "directory"
   print "$dir:\n" if $dir ;

   $n_listed = 0 ;
   $total_size = 0 ;
   $widest_name = 0 ;
   $widest_size = 0 ;
   $path = $dir ? "$dir/" : '' ;
   foreach $file (@files)
   {
      ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks) = lstat ("${path}$file") ;
      $name_len = length ($file) ;
      $widest_name = $name_len if $name_len > $widest_name ;
      $size_len = $l ? &ndigits ($size) : &ndigits (&ceil_tb ($size)) ;
      $widest_size = $size_len if $size_len > $widest_size ;
      $datestamp {$file} = $mtime ;
      $datestamp {$file} = time if ! -e _ ;  # what else?
      $sizes {$file} = $size ;
      $class {$file} = ' ' ;
      $class {$file} = '*' if -x _ ;
      $class {$file} = '/' if -d _ ;
      $class {$file} = '?' if ! -e _ ;
      if ($unix || $wnt)
      {
         $class {$file} = '|' if -S _ ;
         $class {$file} = '=' if -p _ ;
         $class {$file} = '@' if $unix && -l _ ;
      }
      $link {$file} = readlink ($file) if $unix && $l && -l _ ;
   }
   @files = sort $sortby @files if (! $o) ;

   $nwidth = $widest_name + ($p ? length ($path) : 0) + 1 ;
   $swidth = $widest_size ;
   $n_listed = $#files + 1 ;
   if ($l)
   {
      foreach $file (@files)
      {
         ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime ($datestamp {$file}) ;
$year += 1900;
         printf "%-${nwidth}s %s  %2d-%s-%02d  %2d:%02d:%02d", 
                ($p ? "${path}$file" : $file) . $class {$file}, &display_size ($file), 
                $mday, $months [$mon], $year, $hour, $min, $sec ;
         if ($class {$file} eq '@')
         {
          print " --> $link{$file}";
          if (!-e $link{$file})
          {
           print " $badchr"; 
          }
         }

         print "\n" ;
         $total_size += $sizes {$file} ;
      }
   }
   else
   {
      $colwidth = $swidth + $nwidth + 2 ;  # bSSSSbFFFF (2 blanks each)
      $cols = int ($columns / $colwidth) ;
      $cols = 1 if ($cols < 1);  # Fix divide-by-zero bug WMR 30 jul 98
      $rows = int (($n_listed + $cols - 1) / $cols);
      for ($row = 0 ;   $row < $rows ;   ++$row)
      {
         for ($col = 0 ;   $col < $cols ;   ++$col)
         {
            $findex = ($col * $rows) + $row ;
            if ($findex <= $#files)
            {
               $file = $files [$findex] ;
               printf " %s %-${nwidth}s", &display_size ($file),
                      ($p ? "${path}$file" : $file) . $class {$file} ;
               $total_size += $sizes {$file} ;
            }
         }
         print "\n" ;
      }
   }
   printf "%-${nwidth}s ", ' ' if $l ;
   printf "%${swidth}d bytes, $n_listed items listed\n", $total_size ;
   $overall_total += $total_size ;

   undef (@files) ;
}


#
# Smallest thousands-of-bytes larger than given size
sub ceil_tb
{
   local ($size) = @_ ;

   ($size + 999) / 1000 ;
}


#
# Under Unix, the size of directories is interesting; not
# so for DOS and NT.  The size of non-existent objects is never
# interesting
sub display_size
{
   local ($file) = @_ ;

   if ($class {$file} ne '?' && ($unix || $class {$file} ne '/'))
   {
      sprintf ("%${swidth}d", &ceil_tb ($sizes {$file})) ;
   }
   else
   {
      sprintf ("%${swidth}s", ' ') ;
   }
}


#
# A nice log function would probably be better, so go right ahead!
sub ndigits
{
   local ($n) = @_ ;

#
# Assume a positive number
   $n < 10           &&  return 1 ;
   $n < 100          &&  return 2 ;
   $n < 1000         &&  return 3 ;
   $n < 10000        &&  return 4 ;
   $n < 100000       &&  return 5 ;
   $n < 1000000      &&  return 6 ;
   $n < 10000000     &&  return 7 ;
   $n < 100000000    &&  return 8 ;
   $n < 1000000000   &&  return 9 ;
   $n < 10000000000  &&  return 10 ;
   return 11 ;
}


#
# Sort's comparison subroutines
sub bytime
{
   $datestamp {$a} <=> $datestamp {$b} ;
}

sub bysize
{
   $sizes {$a} <=> $sizes {$b} ;
}

sub byname
{
   $a cmp $b ;
}

sub byext
{
   local ($aext, $bext) ;


   $aext = ($a =~ /\.([^\.]+)$/) ? $1 : '' ;
   $bext = ($b =~ /\.([^\.]+)$/) ? $1 : '' ;
   $aext cmp $bext ;
}
__END__
:endofperl
