diff options
Diffstat (limited to 'perl/Git/SVN/Utils.pm')
| -rw-r--r-- | perl/Git/SVN/Utils.pm | 175 |
1 files changed, 174 insertions, 1 deletions
diff --git a/perl/Git/SVN/Utils.pm b/perl/Git/SVN/Utils.pm index 496006bc7b..3d1a0933a2 100644 --- a/perl/Git/SVN/Utils.pm +++ b/perl/Git/SVN/Utils.pm @@ -3,9 +3,18 @@ package Git::SVN::Utils; use strict; use warnings; +use SVN::Core; + use base qw(Exporter); -our @EXPORT_OK = qw(fatal can_compress); +our @EXPORT_OK = qw( + fatal + can_compress + canonicalize_path + canonicalize_url + join_paths + add_path_to_url +); =head1 NAME @@ -56,4 +65,168 @@ sub can_compress { } +=head3 canonicalize_path + + my $canoncalized_path = canonicalize_path($path); + +Converts $path into a canonical form which is safe to pass to the SVN +API as a file path. + +=cut + +# Turn foo/../bar into bar +sub _collapse_dotdot { + my $path = shift; + + 1 while $path =~ s{/[^/]+/+\.\.}{}; + 1 while $path =~ s{[^/]+/+\.\./}{}; + 1 while $path =~ s{[^/]+/+\.\.}{}; + + return $path; +} + + +sub canonicalize_path { + my $path = shift; + my $rv; + + # The 1.7 way to do it + if ( defined &SVN::_Core::svn_dirent_canonicalize ) { + $path = _collapse_dotdot($path); + $rv = SVN::_Core::svn_dirent_canonicalize($path); + } + # 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) = @_; + + return $url if !defined $path or !length $path; + + # Strip trailing and leading slashes so we don't + # wind up with http://x.com///path + $url =~ s{/+$}{}; + $path =~ s{^/+}{}; + + # If a path has a % in it, URI escape it so it's not + # mistaken for a URI escape later. + $path =~ s{%}{%25}g; + + return join '/', $url, $path; +} + 1; |