home *** CD-ROM | disk | FTP | other *** search
/ CLIX - Fazer Clix Custa Nix / CLIX-CD.cdr / mac / lib / auto / URI / URL / file / mac_path.al < prev    next >
Encoding:
Text File  |  1996-08-02  |  2.4 KB  |  97 lines  |  [TEXT/McPL]
  1. # NOTE: Derived from ./blib/lib/URI/URL/file.pm.  Changes made here will be lost.
  2. package URI::URL::file;
  3.  
  4. sub mac_path
  5. {
  6.     my $self = shift;
  7.     my $path = $self->path; #this gives me an unescaped path
  8.     $path = nettolocal($path);
  9.     return $path;
  10. }
  11.  
  12. sub nettolocal {
  13.     my $inpath = $_[0];
  14.     my $macpath = '';
  15. #
  16. #  First nail all groups of /, and convert them to single /.
  17. #
  18.     $inpath =~ s:/{2,}:/:g;
  19. #
  20. #  Next get rid of the no-op, ./.  But we must make sure names like
  21. #  /g./f./h. are treated as legal file names and not touched.  First
  22. #  nail the possible /. at the end...
  23. #
  24.     $inpath =~ s,/\.$,/,;
  25. #
  26. #  and then nail the interior ./
  27. #
  28.     $inpath =~ s,/(\./)+,/,g;
  29. #
  30. #  Now that they're all taken care of, only the leading one should be
  31. #  left.
  32. #
  33.     $inpath =~ s,^\./,,;
  34. #
  35. #  If after this $inpath is empty, it must have been all ./'s.  Just return
  36. #  ":" here.
  37. #
  38.     return ":" unless ($inpath);
  39. #
  40. #  If here $inpath = "/", we'll return an error.  Guessing what might
  41. #  have been meant on a Mac is too hard.  Let the user fix the path.
  42. #
  43.    Carp::croak("root directory: which one do you mean?") if ($inpath eq "/");
  44. #
  45. #  If there are no / left in the name, it's a file in the pwd.  Simply
  46. #  return it as a Mac relative (could leave off the :, but why foster
  47. #  bad habits)
  48. #
  49.     return ":".$inpath if ($inpath !~ m,/,);
  50. #
  51. #  Now all that should be left are names and ../.
  52. #
  53.    my @names = split(/\//,$inpath);
  54. #
  55. #  There may be a null on the front if the path began with /
  56. #
  57.    shift (@names) unless $names[0];
  58.    my @outname = ();
  59. #
  60. #  Work from the end.
  61. #
  62.     my $i;
  63.     for($i = $#names;$i >= 0;$i--) {
  64.         if ($names[$i] eq "..") {
  65.             unshift(@outname,"");
  66.         } else {
  67.             unshift(@outname,$names[$i]);
  68.         }
  69.     }
  70. #
  71. #  Now check for illegal Mac names before joining them all
  72. #  together
  73. #
  74.     foreach $name (@outname) {
  75.         if(length($name) > 31 or $name =~ /:/) {
  76.             Carp::croak("$name is > 31 characters or contains :");
  77.         }    
  78.     }
  79.     $macpath = join(":",@outname);
  80. #
  81. #  If the Unix path is relative, so should be the Mac path.
  82. #  Prepend a : (this also puts the proper number of : at the beginning if it
  83. #  already has one or more).
  84. #
  85.     $macpath = ":".$macpath if ($inpath !~ m,^/,);
  86. #
  87. #  This is just a nicety: if the Unix path ends in /, the Mac path should
  88. #  end in : unless it already does.
  89. #
  90.     if ($inpath =~ m,/$,) {
  91.     $macpath .= ":" unless ($macpath =~ m,:$,);
  92.     }
  93.     return $macpath;
  94. }
  95.  
  96. 1;
  97.