Commit | Line | Data |
---|---|---|
c2768fa1 MS |
1 | package Git::SVN::Utils; |
2 | ||
3 | use strict; | |
4 | use warnings; | |
5 | ||
82009f30 MS |
6 | use SVN::Core; |
7 | ||
c2768fa1 MS |
8 | use base qw(Exporter); |
9 | ||
91e6e0c5 MS |
10 | our @EXPORT_OK = qw( |
11 | fatal | |
12 | can_compress | |
13 | canonicalize_path | |
14 | canonicalize_url | |
ca475a61 | 15 | join_paths |
d2fd119c | 16 | add_path_to_url |
91e6e0c5 | 17 | ); |
c2768fa1 MS |
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 | ||
91e6e0c5 MS |
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 | ||
280ad88a MS |
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 | ||
91e6e0c5 | 89 | sub canonicalize_path { |
3def8d08 MS |
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 { | |
91e6e0c5 MS |
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 | } | |
91e6e0c5 MS |
120 | $path =~ s#/+#/#g; |
121 | $path =~ s#/\.(?:/|$)#/#g; | |
280ad88a | 122 | $path = _collapse_dotdot($path); |
91e6e0c5 MS |
123 | $path =~ s#/$##g; |
124 | $path =~ s#^\./## if $dot_slash_added; | |
91e6e0c5 MS |
125 | $path =~ s#^\.$##; |
126 | return $path; | |
127 | } | |
128 | ||
129 | ||
130 | =head3 canonicalize_url | |
131 | ||
132 | my $canonicalized_url = canonicalize_url($url); | |
133 | ||
134 | Converts $url into a canonical form which is safe to pass to the SVN | |
135 | API as a URL. | |
136 | ||
137 | =cut | |
138 | ||
139 | sub canonicalize_url { | |
82009f30 MS |
140 | my $url = shift; |
141 | ||
142 | # The 1.7 way to do it | |
143 | if ( defined &SVN::_Core::svn_uri_canonicalize ) { | |
144 | return SVN::_Core::svn_uri_canonicalize($url); | |
145 | } | |
146 | # There wasn't a 1.6 way to do it, so we do it ourself. | |
147 | else { | |
148 | return _canonicalize_url_ourselves($url); | |
149 | } | |
150 | } | |
151 | ||
152 | ||
93c3fcbe MS |
153 | sub _canonicalize_url_path { |
154 | my ($uri_path) = @_; | |
155 | ||
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; | |
160 | } | |
161 | ||
162 | return join('/', @parts); | |
163 | } | |
164 | ||
82009f30 | 165 | sub _canonicalize_url_ourselves { |
91e6e0c5 | 166 | my ($url) = @_; |
93c3fcbe MS |
167 | if ($url =~ m#^([^:]+)://([^/]*)(.*)$#) { |
168 | my ($scheme, $domain, $uri) = ($1, $2, _canonicalize_url_path(canonicalize_path($3))); | |
169 | $url = "$scheme://$domain$uri"; | |
170 | } | |
171 | $url; | |
91e6e0c5 MS |
172 | } |
173 | ||
174 | ||
ca475a61 MS |
175 | =head3 join_paths |
176 | ||
177 | my $new_path = join_paths(@paths); | |
178 | ||
179 | Appends @paths together into a single path. Any empty paths are ignored. | |
180 | ||
181 | =cut | |
182 | ||
183 | sub join_paths { | |
184 | my @paths = @_; | |
185 | ||
186 | @paths = grep { defined $_ && length $_ } @paths; | |
187 | ||
188 | return '' unless @paths; | |
189 | return $paths[0] if @paths == 1; | |
190 | ||
191 | my $new_path = shift @paths; | |
192 | $new_path =~ s{/+$}{}; | |
193 | ||
194 | my $last_path = pop @paths; | |
195 | $last_path =~ s{^/+}{}; | |
196 | ||
197 | for my $path (@paths) { | |
198 | $path =~ s{^/+}{}; | |
199 | $path =~ s{/+$}{}; | |
200 | $new_path .= "/$path"; | |
201 | } | |
202 | ||
203 | return $new_path .= "/$last_path"; | |
204 | } | |
205 | ||
d2fd119c MS |
206 | |
207 | =head3 add_path_to_url | |
208 | ||
209 | my $new_url = add_path_to_url($url, $path); | |
210 | ||
211 | Appends $path onto the $url. If $path is empty, $url is returned unchanged. | |
212 | ||
213 | =cut | |
214 | ||
215 | sub add_path_to_url { | |
216 | my($url, $path) = @_; | |
217 | ||
218 | return $url if !defined $path or !length $path; | |
219 | ||
220 | # Strip trailing and leading slashes so we don't | |
221 | # wind up with http://x.com///path | |
222 | $url =~ s{/+$}{}; | |
223 | $path =~ s{^/+}{}; | |
224 | ||
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; | |
228 | ||
229 | return join '/', $url, $path; | |
230 | } | |
231 | ||
c2768fa1 | 232 | 1; |