1package Git::SVN::Utils; 2 3use strict; 4use warnings; 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;