1package Git::SVN::Utils;
2
3use strict;
4use warnings $ENV{GIT_PERL_FATAL_WARNINGS} ? qw(FATAL all) : ();
5
6use SVN::Core;
7
8use base qw(Exporter);
9
10our @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
22Git::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
30This module contains functions which are useful across many different
31parts of Git::SVN.  Mostly it's a place to put utility functions
32rather than duplicate the code or have classes grabbing at other
33classes.
34
35=head1 FUNCTIONS
36
37All functions can be imported only on request.
38
39=head3 fatal
40
41    fatal(@message);
42
43Display 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.
49sub fatal (@) { print STDERR "@_\n"; exit 1 }
50
51
52=head3 can_compress
53
54    my $can_compress = can_compress;
55
56Returns true if Compress::Zlib is available, false otherwise.
57
58=cut
59
60my $can_compress;
61sub 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
72Converts $path into a canonical form which is safe to pass to the SVN
73API as a file path.
74
75=cut
76
77# Turn foo/../bar into bar
78sub _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
89sub 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
113sub _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	return $path;
127}
128
129
130=head3 canonicalize_url
131
132    my $canonicalized_url = canonicalize_url($url);
133
134Converts $url into a canonical form which is safe to pass to the SVN
135API as a URL.
136
137=cut
138
139sub canonicalize_url {
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
153sub _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
165sub _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";
170	}
171	$url;
172}
173
174
175=head3 join_paths
176
177    my $new_path = join_paths(@paths);
178
179Appends @paths together into a single path.  Any empty paths are ignored.
180
181=cut
182
183sub 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
206
207=head3 add_path_to_url
208
209    my $new_url = add_path_to_url($url, $path);
210
211Appends $path onto the $url.  If $path is empty, $url is returned unchanged.
212
213=cut
214
215sub 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
2321;
233