1package URI::file::Mac; 2 3require URI::file::Base; 4@ISA=qw(URI::file::Base); 5 6use strict; 7use URI::Escape qw(uri_unescape); 8 9 10 11sub _file_extract_path 12{ 13 my $class = shift; 14 my $path = shift; 15 16 my @pre; 17 if ($path =~ s/^(:+)//) { 18 if (length($1) == 1) { 19 @pre = (".") unless length($path); 20 } else { 21 @pre = ("..") x (length($1) - 1); 22 } 23 } else { #absolute 24 $pre[0] = ""; 25 } 26 27 my $isdir = ($path =~ s/:$//); 28 $path =~ s,([%/;]),$URI::Escape::escapes{$1},g; 29 30 my @path = split(/:/, $path, -1); 31 for (@path) { 32 if ($_ eq "." || $_ eq "..") { 33 $_ = "%2E" x length($_); 34 } 35 $_ = ".." unless length($_); 36 } 37 push (@path,"") if $isdir; 38 (join("/", @pre, @path), 1); 39} 40 41 42sub file 43{ 44 my $class = shift; 45 my $uri = shift; 46 my @path; 47 48 my $auth = $uri->authority; 49 if (defined $auth) { 50 if (lc($auth) ne "localhost" && $auth ne "") { 51 my $u_auth = uri_unescape($auth); 52 if (!$class->_file_is_localhost($u_auth)) { 53 # some other host (use it as volume name) 54 @path = ("", $auth); 55 # XXX or just return to make it illegal; 56 } 57 } 58 } 59 my @ps = split("/", $uri->path, -1); 60 shift @ps if @path; 61 push(@path, @ps); 62 63 my $pre = ""; 64 if (!@path) { 65 return; # empty path; XXX return ":" instead? 66 } elsif ($path[0] eq "") { 67 # absolute 68 shift(@path); 69 if (@path == 1) { 70 return if $path[0] eq ""; # not root directory 71 push(@path, ""); # volume only, effectively append ":" 72 } 73 @ps = @path; 74 @path = (); 75 my $part; 76 for (@ps) { #fix up "." and "..", including interior, in relatives 77 next if $_ eq "."; 78 $part = $_ eq ".." ? "" : $_; 79 push(@path,$part); 80 } 81 if ($ps[-1] eq "..") { #if this happens, we need another : 82 push(@path,""); 83 } 84 85 } else { 86 $pre = ":"; 87 @ps = @path; 88 @path = (); 89 my $part; 90 for (@ps) { #fix up "." and "..", including interior, in relatives 91 next if $_ eq "."; 92 $part = $_ eq ".." ? "" : $_; 93 push(@path,$part); 94 } 95 if ($ps[-1] eq "..") { #if this happens, we need another : 96 push(@path,""); 97 } 98 99 } 100 return unless $pre || @path; 101 for (@path) { 102 s/;.*//; # get rid of parameters 103 #return unless length; # XXX 104 $_ = uri_unescape($_); 105 return if /\0/; 106 return if /:/; # Should we? 107 } 108 $pre . join(":", @path); 109} 110 111sub dir 112{ 113 my $class = shift; 114 my $path = $class->file(@_); 115 return unless defined $path; 116 $path .= ":" unless $path =~ /:$/; 117 $path; 118} 119 1201; 121