home *** CD-ROM | disk | FTP | other *** search
/ Big Green CD 8 / BGCD_8_Dev.iso / NEXTSTEP / UNIX / GNU / recode-3.4-MIHS / src / dosfn < prev    next >
Encoding:
Text File  |  1994-04-13  |  2.1 KB  |  100 lines
  1. #!/usr/bin/perl -s
  2. eval "exec /usr/bin/perl -s -S $0 $*"
  3.     if $running_under_some_shell;
  4.  
  5. # Turn the given filenames into MSDOS filenames by renaming them.
  6. # Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
  7. # Francois Pinard <pinard@iro.umontreal.ca>, 1992.
  8.  
  9. # Usage: $0 [-tcc] [FILE]...
  10.  
  11. if ($ARGV[0] eq "-v")
  12. {
  13.     $verbose = 1;
  14.     shift @ARGV;
  15. }
  16.  
  17. while ($oldname = shift @ARGV)
  18. {
  19.     $newname = &dosfn ($oldname);
  20.     if ($newname ne $oldname)
  21.     {
  22.     warn "Renaming `$oldname' to `$newname'\n" if $verbose;
  23.     rename ($oldname, $newname)
  24.         || warn "WARNING: Could not rename `$oldname' to `$newname'\n";
  25.     }
  26. }
  27.  
  28. # Turn the argument into an MSDOS file name.
  29. # Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
  30. # Francois Pinard <pinard@iro.umontreal.ca>, 1992.
  31.  
  32. # Predefine $tcc if necessary.
  33.  
  34. sub dosfn
  35. {
  36.     local ($whole, $prefix, $name, $ext);
  37.  
  38.     $whole = $_[0];
  39.     $whole =~ y/A-Z/a-z/;
  40.  
  41.     # Change any beginning period with an underline.
  42.  
  43.     $whole =~ s/^\./_/;
  44.  
  45.     # Change all periods except the last with underlines.
  46.  
  47.     while ($whole =~ /(.*)\.(.*)\.(.*)/)
  48.     {
  49.     $whole = "$1_$2.$3";
  50.     }
  51.  
  52.     # If no period at all, let flow characters after the 8th into the
  53.     # the extension.
  54.  
  55.     if ($whole =~ /^(.*\/)?([^.\/]+)$/)
  56.     {
  57.     ($prefix, $name, $ext) = ($1, $2, "");
  58.     if (length ($name) > 8)
  59.     {
  60.         $ext = substr ($name, 8);
  61.         $name = substr ($name, 0, 8);
  62.         $ext = substr ($ext, 0, 3) if length ($ext) > 3;
  63.         return "$prefix$name.$ext";
  64.     }
  65.     return "$prefix$name";
  66.     }
  67.  
  68.     # There is only one period, truncate to 8 characters before it and
  69.     # to 3 characters after it.
  70.  
  71.     if ($whole =~ /^(.*\/)?([^.\/]+)\.([^.\/]+)$/)
  72.     {
  73.     ($prefix, $name, $ext) = ($1, $2, $3);
  74.     $name = substr ($name, 0, 8) if length ($name) > 8;
  75.     if ($ext eq "a" && $tcc)
  76.     {
  77.         $ext = "lib";
  78.     }
  79.     elsif ($ext eq "o" && $tcc)
  80.     {
  81.         $ext = "obj";
  82.     }
  83.     elsif ($ext eq "texi" || $ext eq "texinfo")
  84.     {
  85.         $ext = "ti";
  86.     }
  87.     elsif (length ($ext) > 3)
  88.     {
  89.         $ext = substr ($ext, 0, 3);
  90.     }
  91.     return "$prefix$name.$ext";
  92.     }
  93.  
  94.     # This should not happen.
  95.  
  96.     warn "Error in dosfn.pl for \`$_[0]'\n";
  97.     return $_[0];
  98. }
  99.  
  100.