diff options
Diffstat (limited to 'lib/URI/file/Unix.pm')
-rw-r--r-- | lib/URI/file/Unix.pm | 58 |
1 files changed, 58 insertions, 0 deletions
diff --git a/lib/URI/file/Unix.pm b/lib/URI/file/Unix.pm new file mode 100644 index 0000000..b06acc7 --- /dev/null +++ b/lib/URI/file/Unix.pm @@ -0,0 +1,58 @@ +package URI::file::Unix; + +use strict; +use warnings; + +use parent 'URI::file::Base'; + +use URI::Escape qw(uri_unescape); + +our $VERSION = "1.69"; + +sub _file_extract_path +{ + my($class, $path) = @_; + + # tidy path + $path =~ s,//+,/,g; + $path =~ s,(/\.)+/,/,g; + $path = "./$path" if $path =~ m,^[^:/]+:,,; # look like "scheme:" + + return $path; +} + +sub _file_is_absolute { + my($class, $path) = @_; + return $path =~ m,^/,; +} + +sub file +{ + my $class = shift; + my $uri = shift; + my @path; + + my $auth = $uri->authority; + if (defined($auth)) { + if (lc($auth) ne "localhost" && $auth ne "") { + $auth = uri_unescape($auth); + unless ($class->_file_is_localhost($auth)) { + push(@path, "", "", $auth); + } + } + } + + my @ps = $uri->path_segments; + shift @ps if @path; + push(@path, @ps); + + for (@path) { + # Unix file/directory names are not allowed to contain '\0' or '/' + return undef if /\0/; + return undef if /\//; # should we really? + } + + return join("/", @path); +} + +1; |