Merge branch 'js/use-sc-open-max'
[git] / perl / Git / SVN / Utils.pm
1 package Git::SVN::Utils;
2
3 use strict;
4 use warnings;
5
6 use SVN::Core;
7
8 use base qw(Exporter);
9
10 our @EXPORT_OK = qw(
11         fatal
12         can_compress
13         canonicalize_path
14         canonicalize_url
15         join_paths
16         add_path_to_url
17 );
18
19
20 =head1 NAME
21
22 Git::SVN::Utils - utility functions used across Git::SVN
23
24 =head1 SYNOPSIS
25
26     use Git::SVN::Utils qw(functions to import);
27
28 =head1 DESCRIPTION
29
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.
34
35 =head1 FUNCTIONS
36
37 All functions can be imported only on request.
38
39 =head3 fatal
40
41     fatal(@message);
42
43 Display a message and exit with a fatal error code.
44
45 =cut
46
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 }
50
51
52 =head3 can_compress
53
54     my $can_compress = can_compress;
55
56 Returns true if Compress::Zlib is available, false otherwise.
57
58 =cut
59
60 my $can_compress;
61 sub can_compress {
62         return $can_compress if defined $can_compress;
63
64         return $can_compress = eval { require Compress::Zlib; };
65 }
66
67
68 =head3 canonicalize_path
69
70     my $canoncalized_path = canonicalize_path($path);
71
72 Converts $path into a canonical form which is safe to pass to the SVN
73 API as a file path.
74
75 =cut
76
77 # Turn foo/../bar into bar
78 sub _collapse_dotdot {
79         my $path = shift;
80
81         1 while $path =~ s{/[^/]+/+\.\.}{};
82         1 while $path =~ s{[^/]+/+\.\./}{};
83         1 while $path =~ s{[^/]+/+\.\.}{};
84
85         return $path;
86 }
87
88
89 sub canonicalize_path {
90         my $path = shift;
91         my $rv;
92
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);
97         }
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);
103         }
104
105         return $rv if defined $rv;
106
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);
110 }
111
112
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;
119         }
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         $path =~ s#^\.$##;
127         return $path;
128 }
129
130
131 =head3 canonicalize_url
132
133     my $canonicalized_url = canonicalize_url($url);
134
135 Converts $url into a canonical form which is safe to pass to the SVN
136 API as a URL.
137
138 =cut
139
140 sub canonicalize_url {
141         my $url = shift;
142
143         # The 1.7 way to do it
144         if ( defined &SVN::_Core::svn_uri_canonicalize ) {
145                 return SVN::_Core::svn_uri_canonicalize($url);
146         }
147         # There wasn't a 1.6 way to do it, so we do it ourself.
148         else {
149                 return _canonicalize_url_ourselves($url);
150         }
151 }
152
153
154 sub _canonicalize_url_path {
155         my ($uri_path) = @_;
156
157         my @parts;
158         foreach my $part (split m{/+}, $uri_path) {
159                 $part =~ s/([^~\w.%+-]|%(?![a-fA-F0-9]{2}))/sprintf("%%%02X",ord($1))/eg;
160                 push @parts, $part;
161         }
162
163         return join('/', @parts);
164 }
165
166 sub _canonicalize_url_ourselves {
167         my ($url) = @_;
168         if ($url =~ m#^([^:]+)://([^/]*)(.*)$#) {
169                 my ($scheme, $domain, $uri) = ($1, $2, _canonicalize_url_path(canonicalize_path($3)));
170                 $url = "$scheme://$domain$uri";
171         }
172         $url;
173 }
174
175
176 =head3 join_paths
177
178     my $new_path = join_paths(@paths);
179
180 Appends @paths together into a single path.  Any empty paths are ignored.
181
182 =cut
183
184 sub join_paths {
185         my @paths = @_;
186
187         @paths = grep { defined $_ && length $_ } @paths;
188
189         return '' unless @paths;
190         return $paths[0] if @paths == 1;
191
192         my $new_path = shift @paths;
193         $new_path =~ s{/+$}{};
194
195         my $last_path = pop @paths;
196         $last_path =~ s{^/+}{};
197
198         for my $path (@paths) {
199                 $path =~ s{^/+}{};
200                 $path =~ s{/+$}{};
201                 $new_path .= "/$path";
202         }
203
204         return $new_path .= "/$last_path";
205 }
206
207
208 =head3 add_path_to_url
209
210     my $new_url = add_path_to_url($url, $path);
211
212 Appends $path onto the $url.  If $path is empty, $url is returned unchanged.
213
214 =cut
215
216 sub add_path_to_url {
217         my($url, $path) = @_;
218
219         return $url if !defined $path or !length $path;
220
221         # Strip trailing and leading slashes so we don't
222         # wind up with http://x.com///path
223         $url  =~ s{/+$}{};
224         $path =~ s{^/+}{};
225
226         # If a path has a % in it, URI escape it so it's not
227         # mistaken for a URI escape later.
228         $path =~ s{%}{%25}g;
229
230         return join '/', $url, $path;
231 }
232
233 1;