home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #30 / NN_1992_30.iso / spool / comp / lang / perl / 7387 < prev    next >
Encoding:
Text File  |  1992-12-13  |  2.9 KB  |  82 lines
  1. Newsgroups: comp.lang.perl
  2. Path: sparky!uunet!munnari.oz.au!uniwa!cujo!peter
  3. From: peter@cujo.curtin.edu.au (Peter N Lewis)
  4. Subject: Re: Wanted: Perl script to convert file names from Unix to DOS
  5. Message-ID: <1992Dec13.071718.24757@cujo.curtin.edu.au>
  6. Organization: Curtin University of Technology
  7. References: <1992Dec9.205342.20218@zip.eecs.umich.edu> <1992Dec10.064406.1201@netcom.com>
  8. Date: Sun, 13 Dec 1992 07:17:18 GMT
  9. Lines: 71
  10.  
  11. jfh@netcom.com (Jack Hamilton) writes:
  12.  
  13. >>It would be nice if the algorithm used can be
  14. >>inverted, so that the Unix filenames can be extracted back from their
  15. >>DOS translation.
  16.  
  17. >In general, I don't think that will be possible unless the Unix filenames
  18. >are already in 8x3 format with no unacceptable characters.   The only way 
  19. >you could do it reliably would be to save a table and use it for the
  20. >conversion back.
  21.  
  22. I did more or less the same thing for converting Mac file names in to
  23. unix file names.  I wanted to guarentee that each unique Mac name was
  24. converted to exactly one unix name (and thus could be inverted back to
  25. the Mac file name).  I did this by using an associative array thing,
  26. using the ndbm features in Perl, the code looks like this:
  27.  
  28. $filenamelen = 25;
  29.  
  30. sub fixname {
  31.         local ($macname) = @_[0];
  32.         local ($name);
  33.         return $name if ($name = $MACNAMES{$macname});
  34.         $name = $macname;
  35.         $name = substr($name,0,$filenamelen);
  36.         $name =~ tr/A-Z/a-z/; # lower case
  37.         $name =~ tr/a-z0-9_./_/c; # improve this...
  38.         $name =~ s/^\./_/;
  39.         $name = ":" . $name;
  40.         if ($MACNAMES{$name}) {
  41.                 $name .= "~";
  42.                 $extra = "aa";
  43.                 while ($MACNAMES{$name . $extra}) { $extra++; }
  44.                 $name .= $extra;
  45.         }
  46.         $MACNAMES{$name} = $macname;
  47.         $name = substr($name,1);
  48.         $MACNAMES{$macname} = $name;
  49. # it'd be nice to reset the cache now, but I don't want to reset
  50. # everything starting with an M :-(
  51.         $name;
  52. }
  53.  
  54. dbmopen(MACNAMES,"macnames",0600) || &mydie("DBMOpen failed");
  55. while ($line=<STDIN>) {
  56.         print $line, " ", &fixname($line), "\n";
  57. }
  58. dbmclose(MACNAMES);
  59.  
  60.  
  61. Note: The above is just a fragment of the code, it probably won't work
  62. on its own, but might give you some ideas.
  63.  
  64. Note2: The associative array has two kinds of mappings:
  65. :unixname --> macname
  66. macname --> unixname
  67. So it can map the names in either direction.
  68.  
  69. Note3: Because Mac names don't traditionally have extensions, I didn't
  70. make any attempt to convert extensions, but with unix->msdos
  71. translation, you'd probably want to do that.  All that requires is a
  72. slight change to the fixname subroutine...  The latter half of fixname
  73. will guarentee uniqueness and invertability.
  74.  
  75. Have fun all,
  76.    Peter.
  77. Just a newbie Perl hacker :-)
  78.  
  79. -- 
  80. _______________________________________________________________________
  81. Peter N Lewis <peter@ncrpda.curtin.edu.au>           Ph: +61 9 368 2055
  82.