init III
This commit is contained in:
122
Perl OTRS/Kernel/cpan-lib/URI/file/Mac.pm
Normal file
122
Perl OTRS/Kernel/cpan-lib/URI/file/Mac.pm
Normal file
@@ -0,0 +1,122 @@
|
||||
package URI::file::Mac;
|
||||
|
||||
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 = shift;
|
||||
my $path = shift;
|
||||
|
||||
my @pre;
|
||||
if ($path =~ s/^(:+)//) {
|
||||
if (length($1) == 1) {
|
||||
@pre = (".") unless length($path);
|
||||
} else {
|
||||
@pre = ("..") x (length($1) - 1);
|
||||
}
|
||||
} else { #absolute
|
||||
$pre[0] = "";
|
||||
}
|
||||
|
||||
my $isdir = ($path =~ s/:$//);
|
||||
$path =~ s,([%/;]), URI::Escape::escape_char($1),eg;
|
||||
|
||||
my @path = split(/:/, $path, -1);
|
||||
for (@path) {
|
||||
if ($_ eq "." || $_ eq "..") {
|
||||
$_ = "%2E" x length($_);
|
||||
}
|
||||
$_ = ".." unless length($_);
|
||||
}
|
||||
push (@path,"") if $isdir;
|
||||
(join("/", @pre, @path), 1);
|
||||
}
|
||||
|
||||
|
||||
sub file
|
||||
{
|
||||
my $class = shift;
|
||||
my $uri = shift;
|
||||
my @path;
|
||||
|
||||
my $auth = $uri->authority;
|
||||
if (defined $auth) {
|
||||
if (lc($auth) ne "localhost" && $auth ne "") {
|
||||
my $u_auth = uri_unescape($auth);
|
||||
if (!$class->_file_is_localhost($u_auth)) {
|
||||
# some other host (use it as volume name)
|
||||
@path = ("", $auth);
|
||||
# XXX or just return to make it illegal;
|
||||
}
|
||||
}
|
||||
}
|
||||
my @ps = split("/", $uri->path, -1);
|
||||
shift @ps if @path;
|
||||
push(@path, @ps);
|
||||
|
||||
my $pre = "";
|
||||
if (!@path) {
|
||||
return; # empty path; XXX return ":" instead?
|
||||
} elsif ($path[0] eq "") {
|
||||
# absolute
|
||||
shift(@path);
|
||||
if (@path == 1) {
|
||||
return if $path[0] eq ""; # not root directory
|
||||
push(@path, ""); # volume only, effectively append ":"
|
||||
}
|
||||
@ps = @path;
|
||||
@path = ();
|
||||
my $part;
|
||||
for (@ps) { #fix up "." and "..", including interior, in relatives
|
||||
next if $_ eq ".";
|
||||
$part = $_ eq ".." ? "" : $_;
|
||||
push(@path,$part);
|
||||
}
|
||||
if ($ps[-1] eq "..") { #if this happens, we need another :
|
||||
push(@path,"");
|
||||
}
|
||||
|
||||
} else {
|
||||
$pre = ":";
|
||||
@ps = @path;
|
||||
@path = ();
|
||||
my $part;
|
||||
for (@ps) { #fix up "." and "..", including interior, in relatives
|
||||
next if $_ eq ".";
|
||||
$part = $_ eq ".." ? "" : $_;
|
||||
push(@path,$part);
|
||||
}
|
||||
if ($ps[-1] eq "..") { #if this happens, we need another :
|
||||
push(@path,"");
|
||||
}
|
||||
|
||||
}
|
||||
return unless $pre || @path;
|
||||
for (@path) {
|
||||
s/;.*//; # get rid of parameters
|
||||
#return unless length; # XXX
|
||||
$_ = uri_unescape($_);
|
||||
return if /\0/;
|
||||
return if /:/; # Should we?
|
||||
}
|
||||
$pre . join(":", @path);
|
||||
}
|
||||
|
||||
sub dir
|
||||
{
|
||||
my $class = shift;
|
||||
my $path = $class->file(@_);
|
||||
return unless defined $path;
|
||||
$path .= ":" unless $path =~ /:$/;
|
||||
$path;
|
||||
}
|
||||
|
||||
1;
|
||||
Reference in New Issue
Block a user