t: add tests for pull --verify-signatures
[git.git] / perl / Git / SVN / Utils.pm
blob3d1a0933a2eb27dc123730c67470be503e91bf93
1 package Git::SVN::Utils;
3 use strict;
4 use warnings;
6 use SVN::Core;
8 use base qw(Exporter);
10 our @EXPORT_OK = qw(
11 fatal
12 can_compress
13 canonicalize_path
14 canonicalize_url
15 join_paths
16 add_path_to_url
20 =head1 NAME
22 Git::SVN::Utils - utility functions used across Git::SVN
24 =head1 SYNOPSIS
26 use Git::SVN::Utils qw(functions to import);
28 =head1 DESCRIPTION
30 This module contains functions which are useful across many different
31 parts of Git::SVN. Mostly it's a place to put utility functions
32 rather than duplicate the code or have classes grabbing at other
33 classes.
35 =head1 FUNCTIONS
37 All functions can be imported only on request.
39 =head3 fatal
41 fatal(@message);
43 Display a message and exit with a fatal error code.
45 =cut
47 # Note: not certain why this is in use instead of die. Probably because
48 # the exit code of die is 255? Doesn't appear to be used consistently.
49 sub fatal (@) { print STDERR "@_\n"; exit 1 }
52 =head3 can_compress
54 my $can_compress = can_compress;
56 Returns true if Compress::Zlib is available, false otherwise.
58 =cut
60 my $can_compress;
61 sub can_compress {
62 return $can_compress if defined $can_compress;
64 return $can_compress = eval { require Compress::Zlib; };
68 =head3 canonicalize_path
70 my $canoncalized_path = canonicalize_path($path);
72 Converts $path into a canonical form which is safe to pass to the SVN
73 API as a file path.
75 =cut
77 # Turn foo/../bar into bar
78 sub _collapse_dotdot {
79 my $path = shift;
81 1 while $path =~ s{/[^/]+/+\.\.}{};
82 1 while $path =~ s{[^/]+/+\.\./}{};
83 1 while $path =~ s{[^/]+/+\.\.}{};
85 return $path;
89 sub canonicalize_path {
90 my $path = shift;
91 my $rv;
93 # The 1.7 way to do it
94 if ( defined &SVN::_Core::svn_dirent_canonicalize ) {
95 $path = _collapse_dotdot($path);
96 $rv = SVN::_Core::svn_dirent_canonicalize($path);
98 # The 1.6 way to do it
99 # This can return undef on subversion-perl-1.4.2-2.el5 (CentOS 5.2)
100 elsif ( defined &SVN::_Core::svn_path_canonicalize ) {
101 $path = _collapse_dotdot($path);
102 $rv = SVN::_Core::svn_path_canonicalize($path);
105 return $rv if defined $rv;
107 # No SVN API canonicalization is available, or the SVN API
108 # didn't return a successful result, do it ourselves
109 return _canonicalize_path_ourselves($path);
113 sub _canonicalize_path_ourselves {
114 my ($path) = @_;
115 my $dot_slash_added = 0;
116 if (substr($path, 0, 1) ne "/") {
117 $path = "./" . $path;
118 $dot_slash_added = 1;
120 $path =~ s#/+#/#g;
121 $path =~ s#/\.(?:/|$)#/#g;
122 $path = _collapse_dotdot($path);
123 $path =~ s#/$##g;
124 $path =~ s#^\./## if $dot_slash_added;
125 $path =~ s#^\.$##;
126 return $path;
130 =head3 canonicalize_url
132 my $canonicalized_url = canonicalize_url($url);
134 Converts $url into a canonical form which is safe to pass to the SVN
135 API as a URL.
137 =cut
139 sub canonicalize_url {
140 my $url = shift;
142 # The 1.7 way to do it
143 if ( defined &SVN::_Core::svn_uri_canonicalize ) {
144 return SVN::_Core::svn_uri_canonicalize($url);
146 # There wasn't a 1.6 way to do it, so we do it ourself.
147 else {
148 return _canonicalize_url_ourselves($url);
153 sub _canonicalize_url_path {
154 my ($uri_path) = @_;
156 my @parts;
157 foreach my $part (split m{/+}, $uri_path) {
158 $part =~ s/([^!\$%&'()*+,.\/\w:=\@_`~-]|%(?![a-fA-F0-9]{2}))/sprintf("%%%02X",ord($1))/eg;
159 push @parts, $part;
162 return join('/', @parts);
165 sub _canonicalize_url_ourselves {
166 my ($url) = @_;
167 if ($url =~ m#^([^:]+)://([^/]*)(.*)$#) {
168 my ($scheme, $domain, $uri) = ($1, $2, _canonicalize_url_path(canonicalize_path($3)));
169 $url = "$scheme://$domain$uri";
171 $url;
175 =head3 join_paths
177 my $new_path = join_paths(@paths);
179 Appends @paths together into a single path. Any empty paths are ignored.
181 =cut
183 sub join_paths {
184 my @paths = @_;
186 @paths = grep { defined $_ && length $_ } @paths;
188 return '' unless @paths;
189 return $paths[0] if @paths == 1;
191 my $new_path = shift @paths;
192 $new_path =~ s{/+$}{};
194 my $last_path = pop @paths;
195 $last_path =~ s{^/+}{};
197 for my $path (@paths) {
198 $path =~ s{^/+}{};
199 $path =~ s{/+$}{};
200 $new_path .= "/$path";
203 return $new_path .= "/$last_path";
207 =head3 add_path_to_url
209 my $new_url = add_path_to_url($url, $path);
211 Appends $path onto the $url. If $path is empty, $url is returned unchanged.
213 =cut
215 sub add_path_to_url {
216 my($url, $path) = @_;
218 return $url if !defined $path or !length $path;
220 # Strip trailing and leading slashes so we don't
221 # wind up with http://x.com///path
222 $url =~ s{/+$}{};
223 $path =~ s{^/+}{};
225 # If a path has a % in it, URI escape it so it's not
226 # mistaken for a URI escape later.
227 $path =~ s{%}{%25}g;
229 return join '/', $url, $path;