home *** CD-ROM | disk | FTP | other *** search
/ Borland Programmer's Resource / Borland_Programmers_Resource_CD_1995.iso / ntcode / ntperlb / eg / ls.cmd < prev    next >
Encoding:
Text File  |  1995-05-19  |  2.3 KB  |  104 lines
  1. @rem = '-*- Perl -*-';
  2. @rem = '
  3. @echo off
  4. perl %0.cmd %1 %2 %3 %4 %5 %6 %7 %8 %9
  5. goto endofperl
  6. ';
  7. #
  8. # A clone of an ls -CF
  9. # no options at present
  10. #
  11.  
  12. $dodirs = 1;            # expand directories by default
  13.  
  14. #
  15. # if no arguments, do current directory
  16. #
  17. if (scalar(@ARGV) == 0) {
  18.     opendir (D, ".") || die "Can't open directory .:$!\n";
  19.     @ARGV = sort readdir(D);
  20.     closedir(D);
  21.     $dodirs = 0;        # don't expand directories
  22. }
  23. elsif (scalar(@ARGV) == 1) {
  24.     local($dir) = $ARGV[0];
  25.     if (-d $dir) {
  26.     opendir (D, $dir) || die "Can't open directory $dir:$!\n";
  27.     @ARGV = sort readdir(D);
  28.     closedir(D);
  29.     chdir($dir);
  30.     } 
  31.     $dodirs = 0;        # don't expand directories
  32. }
  33.  
  34. #
  35. # weed out non-existent files
  36. #
  37. @bad = grep (! -e && print ("ls: $_: no such file or directory\n"), @ARGV);
  38. if (scalar(@bad)) {
  39.     @ARGV = grep (-e, @ARGV);
  40.     print "\n";
  41. }
  42.  
  43.  
  44. #
  45. # get rid of . and .., then lower-case the filenames
  46. #
  47. @ARGV = grep(!/^[.]/ && !/^[.][.]/ && (tr/A-Z/a-z/ || 1), @ARGV); 
  48.  
  49. #
  50. # if we're expanding directorys, pull the dirs out of ARGV
  51. #
  52. if ($dodirs) {
  53.     @dirs = grep(-d, @ARGV);
  54.     @ARGV = grep (!-d, @ARGV);
  55. }
  56. else {
  57.     grep(-d && s/^(.*)$/\1\\/ && 0, @ARGV);
  58. }
  59.  
  60. &column_out(@ARGV);    # now print them
  61. &expand_dirs(@dirs) if $dodirs;
  62. exit(0);
  63.  
  64. sub expand_dirs {
  65.     local(@dirs) = @_;
  66.     local(@filelist);
  67.  
  68.     foreach $dir (@dirs) {
  69.     opendir(D, $dir) || die "Can't open $dir: $!\n";
  70.     @filelist = 
  71.         sort grep(!/^[.]/ && !/^[.][.]/ && (tr/A-Z/a-z/ || 1), readdir(D));
  72.     closedir(D);
  73.     grep(-d && s/^(.*)$/\1\\/ && 0, @filelist);
  74.     print "\n$dir:\n";
  75.     &column_out(@filelist);
  76.     }
  77. }
  78.  
  79. #
  80. # This routine stolen from Kazumasa Utashiro <utashiro@sran230.sra.co.jp>
  81. # (coombs.anu.edu.au archive file lsC2.pl)
  82. #
  83. # Thanks!
  84. #
  85.  
  86. sub column_out {
  87.     local(@item) = @_;
  88.     local($[, $i, $maxlen, $w, $c, $l) = (0, 0, 8);
  89.  
  90.     return unless @item;
  91.     for (@item) { $w = (length() + 1 + 7) & ~7 if length() > $w - 1; } # width
  92.     $c = $w >= 80 ? 1 : int(80 / $w);    # column
  93.     $l = int((@item + $c - 1) / $c);    # line
  94.     $c-- while $l * $c - @item + 1 > $l;
  95.  
  96.     for (@item[sort {$a % $l <=> $b % $l || $a <=> $b} $[ .. $#item]) {
  97.     print;
  98.     print $i == $#item || ++$i % $c == 0 ? "\n" : ' ' x ($w - length);
  99.     }
  100. }
  101.  
  102. __END__
  103. :endofperl
  104.