view release on metacpan or  search on metacpan

lib/Git/SVN/Utils.pm  view on Meta::CPAN

	}
	# The 1.6 way to do it
	# This can return undef on subversion-perl-1.4.2-2.el5 (CentOS 5.2)
	elsif ( defined &SVN::_Core::svn_path_canonicalize ) {
		$path = _collapse_dotdot($path);
		$rv = SVN::_Core::svn_path_canonicalize($path);
	}

	return $rv if defined $rv;

	# No SVN API canonicalization is available, or the SVN API
	# didn't return a successful result, do it ourselves
	return _canonicalize_path_ourselves($path);
}


sub _canonicalize_path_ourselves {
	my ($path) = @_;
	my $dot_slash_added = 0;
	if (substr($path, 0, 1) ne "/") {
		$path = "./" . $path;
		$dot_slash_added = 1;
	}
	$path =~ s#/+#/#g;
	$path =~ s#/\.(?:/|$)#/#g;
	$path = _collapse_dotdot($path);
	$path =~ s#/$##g;
	$path =~ s#^\./## if $dot_slash_added;
	$path =~ s#^\.$##;
	return $path;
}


=head3 canonicalize_url

    my $canonicalized_url = canonicalize_url($url);

Converts $url into a canonical form which is safe to pass to the SVN
API as a URL.

=cut

sub canonicalize_url {
	my $url = shift;

	# The 1.7 way to do it
	if ( defined &SVN::_Core::svn_uri_canonicalize ) {
		return SVN::_Core::svn_uri_canonicalize($url);
	}
	# There wasn't a 1.6 way to do it, so we do it ourself.
	else {
		return _canonicalize_url_ourselves($url);
	}
}


sub _canonicalize_url_path {
	my ($uri_path) = @_;

	my @parts;
	foreach my $part (split m{/+}, $uri_path) {
		$part =~ s/([^!\$%&'()*+,.\/\w:=\@_`~-]|%(?![a-fA-F0-9]{2}))/sprintf("%%%02X",ord($1))/eg;
		push @parts, $part;
	}

	return join('/', @parts);
}

sub _canonicalize_url_ourselves {
	my ($url) = @_;
	if ($url =~ m#^([^:]+)://([^/]*)(.*)$#) {
		my ($scheme, $domain, $uri) = ($1, $2, _canonicalize_url_path(canonicalize_path($3)));
		$url = "$scheme://$domain$uri";
	}
	$url;
}


=head3 join_paths

    my $new_path = join_paths(@paths);

Appends @paths together into a single path.  Any empty paths are ignored.

=cut

sub join_paths {
	my @paths = @_;

	@paths = grep { defined $_ && length $_ } @paths;

	return '' unless @paths;
	return $paths[0] if @paths == 1;

	my $new_path = shift @paths;
	$new_path =~ s{/+$}{};

	my $last_path = pop @paths;
	$last_path =~ s{^/+}{};

	for my $path (@paths) {
		$path =~ s{^/+}{};
		$path =~ s{/+$}{};
		$new_path .= "/$path";
	}

	return $new_path .= "/$last_path";
}


=head3 add_path_to_url

    my $new_url = add_path_to_url($url, $path);

Appends $path onto the $url.  If $path is empty, $url is returned unchanged.

=cut

sub add_path_to_url {
	my($url, $path) = @_;