home *** CD-ROM | disk | FTP | other *** search
/ Borland Programmer's Resource / Borland_Programmers_Resource_CD_1995.iso / ntcode / ntperlb / eg / find83.cmd next >
Encoding:
Text File  |  1995-05-19  |  2.1 KB  |  114 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. require 'ntfind.pl';
  9. require 'getopts.pl';
  10.  
  11. &Getopts('i');
  12.  
  13. @badmsg = @badfiles = ();
  14.  
  15. #
  16. # find all the files that don't fit the stupid 8.3 filename rules
  17. #
  18.  
  19. foreach $dir (@ARGV) {
  20.     &find($dir) if -d $dir;
  21. }
  22.  
  23. #
  24. # Now print them out
  25. #
  26.  
  27. while(@badfiles > 0) {
  28.     $file = pop (@badfiles);
  29.     $msg = pop (@badmsg);
  30.     if ($opt_i) {
  31.     &do_rename($file, $msg);
  32.     }
  33.     else {
  34.     print "$file : $msg\n";
  35.     }
  36. }
  37.  
  38. sub wanted {
  39.     local ($msg);
  40.     if ($msg = &checkname($_)) {
  41.     push(@badfiles, $name);
  42.     push(@badmsg, $msg);
  43.     }
  44. }
  45.  
  46. sub checkname {
  47.     local(@parts) = split (/\./, $_[0]);
  48.     local($checkmsg) = "";
  49.  
  50.     if ($#parts > 2) {
  51.     $checkmsg = "too many dots";
  52.     }
  53.     elsif (length($parts[0]) > 8) {
  54.     $checkmsg =  "name greater than 8 characters";
  55.     }
  56.     elsif (length($parts[1]) > 3) {
  57.     $checkmsg = "extension greater than 3 characters";
  58.     }
  59.     $checkmsg;
  60. }
  61.  
  62. sub do_rename {
  63.     local($path, $msg) = @_;
  64.     local($valid_name) = 0;
  65.     local($newname);
  66.  
  67.     #
  68.     # Tell the user what's wrong with the file, then prompt
  69.     # for a new name. Make sure that the new name doesn't exist,
  70.     # and that it's a legal 8.3 name. Then do the rename.
  71.     #
  72.  
  73.     $path =~ s|/|\\|g;
  74.  
  75.     do {
  76.     print "$msg\nRename $path to: ";
  77.     $newname = &gets;
  78.     if (-e $newname) {
  79.         print STDERR "Can't rename $file to $newname (file exists)\n";
  80.         redo;
  81.     }
  82.     split(m;[/\\];, $newname);
  83.     if (($msg = &checkname($_[$#_])) == ""){
  84.         rename($path, $newname) && ($valid_name = 1);
  85.         warn "rename of $path to $newname failed: $!\n" 
  86.         if $valid_name == 0;
  87.     }
  88.     } while (! $valid_name);
  89.  
  90.     #
  91.     # Now log the old and new names
  92.     #
  93.  
  94.     open(M, ">>rename.map") 
  95.     || warn "Can't open rename.map for append: $!\n" && return;
  96.     print M "$file -> $newname\n";
  97.     close M;
  98. }
  99.  
  100. sub gets {
  101.     local ($c);
  102.     local (@string) = ();
  103.  
  104.     while(($c = getc) ne "\n") {
  105.     push(@string, $c);
  106.     }
  107.     join (//, @string);
  108. }
  109.  
  110.  
  111.  
  112. __END__
  113. :endofperl
  114.