FM / file

/usr/share/perl5/URI/file

Name	Size	Mode	Actions
Base.pm	1501	0644	edit dl rm
FAT.pm	523	0644	edit dl rm
Mac.pm	2511	0644	edit dl rm
OS2.pm	587	0644	edit dl rm
QNX.pm	363	0644	edit dl rm
Unix.pm	1048	0644	edit dl rm
Win32.pm	1783	0644	edit dl rm

Edit: /usr/share/perl5/URI/file/Mac.pm (2511B)

package URI::file::Mac;

use strict;
use warnings;

use parent 'URI::file::Base';

use URI::Escape qw(uri_unescape);

our $VERSION = '1.73';
$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;
}

cmd: