summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/site/lib/URI/file/Unix.pm
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2016-04-05 22:27:26 +0000
committerKarl Berry <karl@freefriends.org>2016-04-05 22:27:26 +0000
commitb56b320b5e2515160073fa1b469514002688fe11 (patch)
tree965a7100c5e45fca8ec803d22b8b6ce14fca4633 /Master/tlpkg/tlperl/site/lib/URI/file/Unix.pm
parentd26c206452d2e285c3bbf949f34011e4a55fd8f9 (diff)
tlperl 5.22.1 from siep
git-svn-id: svn://tug.org/texlive/trunk@40252 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/site/lib/URI/file/Unix.pm')
-rw-r--r--Master/tlpkg/tlperl/site/lib/URI/file/Unix.pm59
1 files changed, 59 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/site/lib/URI/file/Unix.pm b/Master/tlpkg/tlperl/site/lib/URI/file/Unix.pm
new file mode 100644
index 00000000000..e75887b0227
--- /dev/null
+++ b/Master/tlpkg/tlperl/site/lib/URI/file/Unix.pm
@@ -0,0 +1,59 @@
+package URI::file::Unix;
+
+use strict;
+use warnings;
+
+use parent 'URI::file::Base';
+
+use URI::Escape qw(uri_unescape);
+
+our $VERSION = '1.71';
+$VERSION = eval $VERSION;
+
+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;