1package URI::file::Unix; 2 3require URI::file::Base; 4@ISA=qw(URI::file::Base); 5 6use strict; 7use URI::Escape qw(uri_unescape); 8 9sub _file_extract_path 10{ 11 my($class, $path) = @_; 12 13 # tidy path 14 $path =~ s,//+,/,g; 15 $path =~ s,(/\.)+/,/,g; 16 $path = "./$path" if $path =~ m,^[^:/]+:,,; # look like "scheme:" 17 18 return $path; 19} 20 21sub _file_is_absolute { 22 my($class, $path) = @_; 23 return $path =~ m,^/,; 24} 25 26sub file 27{ 28 my $class = shift; 29 my $uri = shift; 30 my @path; 31 32 my $auth = $uri->authority; 33 if (defined($auth)) { 34 if (lc($auth) ne "localhost" && $auth ne "") { 35 $auth = uri_unescape($auth); 36 unless ($class->_file_is_localhost($auth)) { 37 push(@path, "", "", $auth); 38 } 39 } 40 } 41 42 my @ps = $uri->path_segments; 43 shift @ps if @path; 44 push(@path, @ps); 45 46 for (@path) { 47 # Unix file/directory names are not allowed to contain '\0' or '/' 48 return undef if /\0/; 49 return undef if /\//; # should we really? 50 } 51 52 return join("/", @path); 53} 54 551; 56