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