f0b1b53a3ff98d044db98fd3939cab6862e234c1
   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);
  17
  18
  19=head1 NAME
  20
  21Git::SVN::Utils - utility functions used across Git::SVN
  22
  23=head1 SYNOPSIS
  24
  25    use Git::SVN::Utils qw(functions to import);
  26
  27=head1 DESCRIPTION
  28
  29This module contains functions which are useful across many different
  30parts of Git::SVN.  Mostly it's a place to put utility functions
  31rather than duplicate the code or have classes grabbing at other
  32classes.
  33
  34=head1 FUNCTIONS
  35
  36All functions can be imported only on request.
  37
  38=head3 fatal
  39
  40    fatal(@message);
  41
  42Display a message and exit with a fatal error code.
  43
  44=cut
  45
  46# Note: not certain why this is in use instead of die.  Probably because
  47# the exit code of die is 255?  Doesn't appear to be used consistently.
  48sub fatal (@) { print STDERR "@_\n"; exit 1 }
  49
  50
  51=head3 can_compress
  52
  53    my $can_compress = can_compress;
  54
  55Returns true if Compress::Zlib is available, false otherwise.
  56
  57=cut
  58
  59my $can_compress;
  60sub can_compress {
  61        return $can_compress if defined $can_compress;
  62
  63        return $can_compress = eval { require Compress::Zlib; };
  64}
  65
  66
  67=head3 canonicalize_path
  68
  69    my $canoncalized_path = canonicalize_path($path);
  70
  71Converts $path into a canonical form which is safe to pass to the SVN
  72API as a file path.
  73
  74=cut
  75
  76# Turn foo/../bar into bar
  77sub _collapse_dotdot {
  78        my $path = shift;
  79
  80        1 while $path =~ s{/[^/]+/+\.\.}{};
  81        1 while $path =~ s{[^/]+/+\.\./}{};
  82        1 while $path =~ s{[^/]+/+\.\.}{};
  83
  84        return $path;
  85}
  86
  87
  88sub canonicalize_path {
  89        my $path = shift;
  90        my $rv;
  91
  92        # The 1.7 way to do it
  93        if ( defined &SVN::_Core::svn_dirent_canonicalize ) {
  94                $path = _collapse_dotdot($path);
  95                $rv = SVN::_Core::svn_dirent_canonicalize($path);
  96        }
  97        # The 1.6 way to do it
  98        # This can return undef on subversion-perl-1.4.2-2.el5 (CentOS 5.2)
  99        elsif ( defined &SVN::_Core::svn_path_canonicalize ) {
 100                $path = _collapse_dotdot($path);
 101                $rv = SVN::_Core::svn_path_canonicalize($path);
 102        }
 103
 104        return $rv if defined $rv;
 105
 106        # No SVN API canonicalization is available, or the SVN API
 107        # didn't return a successful result, do it ourselves
 108        return _canonicalize_path_ourselves($path);
 109}
 110
 111
 112sub _canonicalize_path_ourselves {
 113        my ($path) = @_;
 114        my $dot_slash_added = 0;
 115        if (substr($path, 0, 1) ne "/") {
 116                $path = "./" . $path;
 117                $dot_slash_added = 1;
 118        }
 119        $path =~ s#/+#/#g;
 120        $path =~ s#/\.(?:/|$)#/#g;
 121        $path = _collapse_dotdot($path);
 122        $path =~ s#/$##g;
 123        $path =~ s#^\./## if $dot_slash_added;
 124        $path =~ s#^/##;
 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_ourselves {
 154        my ($url) = @_;
 155        $url =~ s#^([^:]+://[^/]*/)(.*)$#$1 . canonicalize_path($2)#e;
 156        return $url;
 157}
 158
 159
 160=head3 join_paths
 161
 162    my $new_path = join_paths(@paths);
 163
 164Appends @paths together into a single path.  Any empty paths are ignored.
 165
 166=cut
 167
 168sub join_paths {
 169        my @paths = @_;
 170
 171        @paths = grep { defined $_ && length $_ } @paths;
 172
 173        return '' unless @paths;
 174        return $paths[0] if @paths == 1;
 175
 176        my $new_path = shift @paths;
 177        $new_path =~ s{/+$}{};
 178
 179        my $last_path = pop @paths;
 180        $last_path =~ s{^/+}{};
 181
 182        for my $path (@paths) {
 183                $path =~ s{^/+}{};
 184                $path =~ s{/+$}{};
 185                $new_path .= "/$path";
 186        }
 187
 188        return $new_path .= "/$last_path";
 189}
 190
 1911;