perl / Git / SVN / Ra.pmon commit perl: update our ancient copy of Error.pm (e5741c3)
   1package Git::SVN::Ra;
   2use vars qw/@ISA $config_dir $_ignore_refs_regex $_log_window_size/;
   3use strict;
   4use warnings;
   5use Memoize;
   6use Git::SVN::Utils qw(
   7        canonicalize_url
   8        canonicalize_path
   9        add_path_to_url
  10);
  11
  12use SVN::Ra;
  13BEGIN {
  14        @ISA = qw(SVN::Ra);
  15}
  16
  17my ($ra_invalid, $can_do_switch, %ignored_err, $RA);
  18
  19BEGIN {
  20        # enforce temporary pool usage for some simple functions
  21        no strict 'refs';
  22        for my $f (qw/rev_proplist get_latest_revnum get_uuid get_repos_root
  23                      get_file/) {
  24                my $SUPER = "SUPER::$f";
  25                *$f = sub {
  26                        my $self = shift;
  27                        my $pool = SVN::Pool->new;
  28                        my @ret = $self->$SUPER(@_,$pool);
  29                        $pool->clear;
  30                        wantarray ? @ret : $ret[0];
  31                };
  32        }
  33}
  34
  35# serf has a bug that leads to a coredump upon termination if the
  36# remote access object is left around (not fixed yet in serf 1.3.1).
  37# Explicitly free it to work around the issue.
  38END {
  39        $RA = undef;
  40        $ra_invalid = 1;
  41}
  42
  43sub _auth_providers () {
  44        require SVN::Client;
  45        my @rv = (
  46          SVN::Client::get_simple_provider(),
  47          SVN::Client::get_ssl_server_trust_file_provider(),
  48          SVN::Client::get_simple_prompt_provider(
  49            \&Git::SVN::Prompt::simple, 2),
  50          SVN::Client::get_ssl_client_cert_file_provider(),
  51          SVN::Client::get_ssl_client_cert_prompt_provider(
  52            \&Git::SVN::Prompt::ssl_client_cert, 2),
  53          SVN::Client::get_ssl_client_cert_pw_file_provider(),
  54          SVN::Client::get_ssl_client_cert_pw_prompt_provider(
  55            \&Git::SVN::Prompt::ssl_client_cert_pw, 2),
  56          SVN::Client::get_username_provider(),
  57          SVN::Client::get_ssl_server_trust_prompt_provider(
  58            \&Git::SVN::Prompt::ssl_server_trust),
  59          SVN::Client::get_username_prompt_provider(
  60            \&Git::SVN::Prompt::username, 2)
  61        );
  62
  63        # earlier 1.6.x versions would segfault, and <= 1.5.x didn't have
  64        # this function
  65        if (::compare_svn_version('1.6.15') >= 0) {
  66                my $config = SVN::Core::config_get_config($config_dir);
  67                my ($p, @a);
  68                # config_get_config returns all config files from
  69                # ~/.subversion, auth_get_platform_specific_client_providers
  70                # just wants the config "file".
  71                @a = ($config->{'config'}, undef);
  72                $p = SVN::Core::auth_get_platform_specific_client_providers(@a);
  73                # Insert the return value from
  74                # auth_get_platform_specific_providers
  75                unshift @rv, @$p;
  76        }
  77        \@rv;
  78}
  79
  80sub prepare_config_once {
  81        SVN::_Core::svn_config_ensure($config_dir, undef);
  82        my ($baton, $callbacks) = SVN::Core::auth_open_helper(_auth_providers);
  83        my $config = SVN::Core::config_get_config($config_dir);
  84        my $conf_t = $config->{'config'};
  85
  86        no warnings 'once';
  87        # The usage of $SVN::_Core::SVN_CONFIG_* variables
  88        # produces warnings that variables are used only once.
  89        # I had not found the better way to shut them up, so
  90        # the warnings of type 'once' are disabled in this block.
  91        if (SVN::_Core::svn_config_get_bool($conf_t,
  92            $SVN::_Core::SVN_CONFIG_SECTION_AUTH,
  93            $SVN::_Core::SVN_CONFIG_OPTION_STORE_PASSWORDS,
  94            1) == 0) {
  95                my $val = '1';
  96                if (::compare_svn_version('1.9.0') < 0) { # pre-SVN r1553823
  97                        my $dont_store_passwords = 1;
  98                        $val = bless \$dont_store_passwords, "_p_void";
  99                }
 100                SVN::_Core::svn_auth_set_parameter($baton,
 101                    $SVN::_Core::SVN_AUTH_PARAM_DONT_STORE_PASSWORDS,
 102                    $val);
 103        }
 104        if (SVN::_Core::svn_config_get_bool($conf_t,
 105            $SVN::_Core::SVN_CONFIG_SECTION_AUTH,
 106            $SVN::_Core::SVN_CONFIG_OPTION_STORE_AUTH_CREDS,
 107            1) == 0) {
 108                $Git::SVN::Prompt::_no_auth_cache = 1;
 109        }
 110
 111        return ($config, $baton, $callbacks);
 112} # no warnings 'once'
 113
 114INIT {
 115        Memoize::memoize '_auth_providers';
 116        Memoize::memoize 'prepare_config_once';
 117}
 118
 119sub new {
 120        my ($class, $url) = @_;
 121        $url = canonicalize_url($url);
 122        return $RA if ($RA && $RA->url eq $url);
 123
 124        ::_req_svn();
 125
 126        $RA = undef;
 127        my ($config, $baton, $callbacks) = prepare_config_once();
 128        my $self = SVN::Ra->new(url => $url, auth => $baton,
 129                              config => $config,
 130                              pool => SVN::Pool->new,
 131                              auth_provider_callbacks => $callbacks);
 132        $RA = bless $self, $class;
 133
 134        # Make sure its canonicalized
 135        $self->url($url);
 136        $self->{svn_path} = $url;
 137        $self->{repos_root} = $self->get_repos_root;
 138        $self->{svn_path} =~ s#^\Q$self->{repos_root}\E(/|$)##;
 139        $self->{cache} = { check_path => { r => 0, data => {} },
 140                           get_dir => { r => 0, data => {} } };
 141
 142        return $RA;
 143}
 144
 145sub url {
 146        my $self = shift;
 147
 148        if (@_) {
 149                my $url = shift;
 150                $self->{url} = canonicalize_url($url);
 151                return;
 152        }
 153
 154        return $self->{url};
 155}
 156
 157sub check_path {
 158        my ($self, $path, $r) = @_;
 159        my $cache = $self->{cache}->{check_path};
 160        if ($r == $cache->{r} && exists $cache->{data}->{$path}) {
 161                return $cache->{data}->{$path};
 162        }
 163        my $pool = SVN::Pool->new;
 164        my $t = $self->SUPER::check_path($path, $r, $pool);
 165        $pool->clear;
 166        if ($r != $cache->{r}) {
 167                %{$cache->{data}} = ();
 168                $cache->{r} = $r;
 169        }
 170        $cache->{data}->{$path} = $t;
 171}
 172
 173sub get_dir {
 174        my ($self, $dir, $r) = @_;
 175        my $cache = $self->{cache}->{get_dir};
 176        if ($r == $cache->{r}) {
 177                if (my $x = $cache->{data}->{$dir}) {
 178                        return wantarray ? @$x : $x->[0];
 179                }
 180        }
 181        my $pool = SVN::Pool->new;
 182        my ($d, undef, $props);
 183
 184        if (::compare_svn_version('1.4.0') >= 0) {
 185                # n.b. in addition to being potentially more efficient,
 186                # this works around what appears to be a bug in some
 187                # SVN 1.8 versions
 188                my $kind = 1; # SVN_DIRENT_KIND
 189                ($d, undef, $props) = $self->get_dir2($dir, $r, $kind, $pool);
 190        } else {
 191                ($d, undef, $props) = $self->SUPER::get_dir($dir, $r, $pool);
 192        }
 193        my %dirents = map { $_ => { kind => $d->{$_}->kind } } keys %$d;
 194        $pool->clear;
 195        if ($r != $cache->{r}) {
 196                %{$cache->{data}} = ();
 197                $cache->{r} = $r;
 198        }
 199        $cache->{data}->{$dir} = [ \%dirents, $r, $props ];
 200        wantarray ? (\%dirents, $r, $props) : \%dirents;
 201}
 202
 203# get_log(paths, start, end, limit,
 204#         discover_changed_paths, strict_node_history, receiver)
 205sub get_log {
 206        my ($self, @args) = @_;
 207        my $pool = SVN::Pool->new;
 208
 209        # svn_log_changed_path_t objects passed to get_log are likely to be
 210        # overwritten even if only the refs are copied to an external variable,
 211        # so we should dup the structures in their entirety.  Using an
 212        # externally passed pool (instead of our temporary and quickly cleared
 213        # pool in Git::SVN::Ra) does not help matters at all...
 214        my $receiver = pop @args;
 215        my $prefix = "/".$self->{svn_path};
 216        $prefix =~ s#/+($)##;
 217        my $prefix_regex = qr#^\Q$prefix\E#;
 218        push(@args, sub {
 219                my ($paths) = $_[0];
 220                return &$receiver(@_) unless $paths;
 221                $_[0] = ();
 222                foreach my $p (keys %$paths) {
 223                        my $i = $paths->{$p};
 224                        # Make path relative to our url, not repos_root
 225                        $p =~ s/$prefix_regex//;
 226                        my %s = map { $_ => $i->$_; }
 227                                qw/copyfrom_path copyfrom_rev action/;
 228                        if ($s{'copyfrom_path'}) {
 229                                $s{'copyfrom_path'} =~ s/$prefix_regex//;
 230                                $s{'copyfrom_path'} = canonicalize_path($s{'copyfrom_path'});
 231                        }
 232                        $_[0]{$p} = \%s;
 233                }
 234                &$receiver(@_);
 235        });
 236
 237
 238        # the limit parameter was not supported in SVN 1.1.x, so we
 239        # drop it.  Therefore, the receiver callback passed to it
 240        # is made aware of this limitation by being wrapped if
 241        # the limit passed to is being wrapped.
 242        if (::compare_svn_version('1.2.0') <= 0) {
 243                my $limit = splice(@args, 3, 1);
 244                if ($limit > 0) {
 245                        my $receiver = pop @args;
 246                        push(@args, sub { &$receiver(@_) if (--$limit >= 0) });
 247                }
 248        }
 249        my $ret = $self->SUPER::get_log(@args, $pool);
 250        $pool->clear;
 251        $ret;
 252}
 253
 254# uncommon, only for ancient SVN (<= 1.4.2)
 255sub trees_match {
 256        require IO::File;
 257        require SVN::Client;
 258        my ($self, $url1, $rev1, $url2, $rev2) = @_;
 259        my $ctx = SVN::Client->new(auth => _auth_providers);
 260        my $out = IO::File->new_tmpfile;
 261
 262        # older SVN (1.1.x) doesn't take $pool as the last parameter for
 263        # $ctx->diff(), so we'll create a default one
 264        my $pool = SVN::Pool->new_default_sub;
 265
 266        $ra_invalid = 1; # this will open a new SVN::Ra connection to $url1
 267        $ctx->diff([], $url1, $rev1, $url2, $rev2, 1, 1, 0, $out, $out);
 268        $out->flush;
 269        my $ret = (($out->stat)[7] == 0);
 270        close $out or croak $!;
 271
 272        $ret;
 273}
 274
 275sub get_commit_editor {
 276        my ($self, $log, $cb, $pool) = @_;
 277
 278        my @lock = (::compare_svn_version('1.2.0') >= 0) ? (undef, 0) : ();
 279        $self->SUPER::get_commit_editor($log, $cb, @lock, $pool);
 280}
 281
 282sub gs_do_update {
 283        my ($self, $rev_a, $rev_b, $gs, $editor) = @_;
 284        my $new = ($rev_a == $rev_b);
 285        my $path = $gs->path;
 286
 287        if ($new && -e $gs->{index}) {
 288                unlink $gs->{index} or die
 289                  "Couldn't unlink index: $gs->{index}: $!\n";
 290        }
 291        my $pool = SVN::Pool->new;
 292        $editor->set_path_strip($path);
 293        my (@pc) = split m#/#, $path;
 294        my $reporter = $self->do_update($rev_b, (@pc ? shift @pc : ''),
 295                                        1, $editor, $pool);
 296        my @lock = (::compare_svn_version('1.2.0') >= 0) ? (undef) : ();
 297
 298        # Since we can't rely on svn_ra_reparent being available, we'll
 299        # just have to do some magic with set_path to make it so
 300        # we only want a partial path.
 301        my $sp = '';
 302        my $final = join('/', @pc);
 303        while (@pc) {
 304                $reporter->set_path($sp, $rev_b, 0, @lock, $pool);
 305                $sp .= '/' if length $sp;
 306                $sp .= shift @pc;
 307        }
 308        die "BUG: '$sp' != '$final'\n" if ($sp ne $final);
 309
 310        $reporter->set_path($sp, $rev_a, $new, @lock, $pool);
 311
 312        $reporter->finish_report($pool);
 313        $pool->clear;
 314        $editor->{git_commit_ok};
 315}
 316
 317# this requires SVN 1.4.3 or later (do_switch didn't work before 1.4.3, and
 318# svn_ra_reparent didn't work before 1.4)
 319sub gs_do_switch {
 320        my ($self, $rev_a, $rev_b, $gs, $url_b, $editor) = @_;
 321        my $path = $gs->path;
 322        my $pool = SVN::Pool->new;
 323
 324        my $old_url = $self->url;
 325        my $full_url = add_path_to_url( $self->url, $path );
 326        my ($ra, $reparented);
 327
 328        if ($old_url =~ m#^svn(\+\w+)?://# ||
 329            ($full_url =~ m#^https?://# &&
 330             canonicalize_url($full_url) ne $full_url)) {
 331                $_[0] = undef;
 332                $self = undef;
 333                $RA = undef;
 334                $ra = Git::SVN::Ra->new($full_url);
 335                $ra_invalid = 1;
 336        } elsif ($old_url ne $full_url) {
 337                SVN::_Ra::svn_ra_reparent(
 338                        $self->{session},
 339                        canonicalize_url($full_url),
 340                        $pool
 341                );
 342                $self->url($full_url);
 343                $reparented = 1;
 344        }
 345
 346        $ra ||= $self;
 347        $url_b = canonicalize_url($url_b);
 348        my $reporter = $ra->do_switch($rev_b, '', 1, $url_b, $editor, $pool);
 349        my @lock = (::compare_svn_version('1.2.0') >= 0) ? (undef) : ();
 350        $reporter->set_path('', $rev_a, 0, @lock, $pool);
 351        $reporter->finish_report($pool);
 352
 353        if ($reparented) {
 354                SVN::_Ra::svn_ra_reparent($self->{session}, $old_url, $pool);
 355                $self->url($old_url);
 356        }
 357
 358        $pool->clear;
 359        $editor->{git_commit_ok};
 360}
 361
 362sub longest_common_path {
 363        my ($gsv, $globs) = @_;
 364        my %common;
 365        my $common_max = scalar @$gsv;
 366
 367        foreach my $gs (@$gsv) {
 368                my @tmp = split m#/#, $gs->path;
 369                my $p = '';
 370                foreach (@tmp) {
 371                        $p .= length($p) ? "/$_" : $_;
 372                        $common{$p} ||= 0;
 373                        $common{$p}++;
 374                }
 375        }
 376        $globs ||= [];
 377        $common_max += scalar @$globs;
 378        foreach my $glob (@$globs) {
 379                my @tmp = split m#/#, $glob->{path}->{left};
 380                my $p = '';
 381                foreach (@tmp) {
 382                        $p .= length($p) ? "/$_" : $_;
 383                        $common{$p} ||= 0;
 384                        $common{$p}++;
 385                }
 386        }
 387
 388        my $longest_path = '';
 389        foreach (sort {length $b <=> length $a} keys %common) {
 390                if ($common{$_} == $common_max) {
 391                        $longest_path = $_;
 392                        last;
 393                }
 394        }
 395        $longest_path;
 396}
 397
 398sub gs_fetch_loop_common {
 399        my ($self, $base, $head, $gsv, $globs) = @_;
 400        return if ($base > $head);
 401        # Make sure the cat_blob open2 FileHandle is created before calling
 402        # SVN::Pool::new_default so that it does not incorrectly end up in the pool.
 403        $::_repository->_open_cat_blob_if_needed;
 404        my $gpool = SVN::Pool->new_default;
 405        my $ra_url = $self->url;
 406        my $reload_ra = sub {
 407                $_[0] = undef;
 408                $self = undef;
 409                $RA = undef;
 410                $gpool->clear;
 411                $self = Git::SVN::Ra->new($ra_url);
 412                $ra_invalid = undef;
 413        };
 414        my $inc = $_log_window_size;
 415        my ($min, $max) = ($base, $head < $base + $inc ? $head : $base + $inc);
 416        my $longest_path = longest_common_path($gsv, $globs);
 417        my $find_trailing_edge;
 418        while (1) {
 419                my %revs;
 420                my $err;
 421                my $err_handler = $SVN::Error::handler;
 422                $SVN::Error::handler = sub {
 423                        ($err) = @_;
 424                        skip_unknown_revs($err);
 425                };
 426                sub _cb {
 427                        my ($paths, $r, $author, $date, $log) = @_;
 428                        [ $paths,
 429                          { author => $author, date => $date, log => $log } ];
 430                }
 431                $self->get_log([$longest_path], $min, $max, 0, 1, 1,
 432                               sub { $revs{$_[1]} = _cb(@_) });
 433                if ($err) {
 434                        print "Checked through r$max\r";
 435                } else {
 436                        $find_trailing_edge = 1;
 437                }
 438                if ($err and $find_trailing_edge) {
 439                        print STDERR "Path '$longest_path' ",
 440                                     "was probably deleted:\n",
 441                                     $err->expanded_message,
 442                                     "\nWill attempt to follow ",
 443                                     "revisions r$min .. r$max ",
 444                                     "committed before the deletion\n";
 445                        my $hi = $max;
 446                        while (--$hi >= $min) {
 447                                my $ok;
 448                                $self->get_log([$longest_path], $min, $hi,
 449                                               0, 1, 1, sub {
 450                                               $ok = $_[1];
 451                                               $revs{$_[1]} = _cb(@_) });
 452                                if ($ok) {
 453                                        print STDERR "r$min .. r$ok OK\n";
 454                                        last;
 455                                }
 456                        }
 457                        $find_trailing_edge = 0;
 458                }
 459                $SVN::Error::handler = $err_handler;
 460
 461                my %exists = map { $_->path => $_ } @$gsv;
 462                foreach my $r (sort {$a <=> $b} keys %revs) {
 463                        my ($paths, $logged) = @{delete $revs{$r}};
 464
 465                        foreach my $gs ($self->match_globs(\%exists, $paths,
 466                                                           $globs, $r)) {
 467                                if ($gs->rev_map_max >= $r) {
 468                                        next;
 469                                }
 470                                next unless $gs->match_paths($paths, $r);
 471                                $gs->{logged_rev_props} = $logged;
 472                                if (my $last_commit = $gs->last_commit) {
 473                                        $gs->assert_index_clean($last_commit);
 474                                }
 475                                my $log_entry = $gs->do_fetch($paths, $r);
 476                                if ($log_entry) {
 477                                        $gs->do_git_commit($log_entry);
 478                                }
 479                                $Git::SVN::INDEX_FILES{$gs->{index}} = 1;
 480                        }
 481                        foreach my $g (@$globs) {
 482                                my $k = "svn-remote.$g->{remote}." .
 483                                        "$g->{t}-maxRev";
 484                                Git::SVN::tmp_config($k, $r);
 485                        }
 486                        $reload_ra->() if $ra_invalid;
 487                }
 488                # pre-fill the .rev_db since it'll eventually get filled in
 489                # with '0' x40 if something new gets committed
 490                foreach my $gs (@$gsv) {
 491                        next if $gs->rev_map_max >= $max;
 492                        next if defined $gs->rev_map_get($max);
 493                        $gs->rev_map_set($max, 0 x40);
 494                }
 495                foreach my $g (@$globs) {
 496                        my $k = "svn-remote.$g->{remote}.$g->{t}-maxRev";
 497                        Git::SVN::tmp_config($k, $max);
 498                }
 499                last if $max >= $head;
 500                $min = $max + 1;
 501                $max += $inc;
 502                $max = $head if ($max > $head);
 503
 504                $reload_ra->();
 505        }
 506        Git::SVN::gc();
 507}
 508
 509sub get_dir_globbed {
 510        my ($self, $left, $depth, $r) = @_;
 511
 512        my @x = eval { $self->get_dir($left, $r) };
 513        return unless scalar @x == 3;
 514        my $dirents = $x[0];
 515        my @finalents;
 516        foreach my $de (keys %$dirents) {
 517                next if $dirents->{$de}->{kind} != $SVN::Node::dir;
 518                if ($depth > 1) {
 519                        my @args = ("$left/$de", $depth - 1, $r);
 520                        foreach my $dir ($self->get_dir_globbed(@args)) {
 521                                push @finalents, "$de/$dir";
 522                        }
 523                } else {
 524                        push @finalents, $de;
 525                }
 526        }
 527        @finalents;
 528}
 529
 530# return value: 0 -- don't ignore, 1 -- ignore
 531sub is_ref_ignored {
 532        my ($g, $p) = @_;
 533        my $refname = $g->{ref}->full_path($p);
 534        return 1 if defined($g->{ignore_refs_regex}) &&
 535                    $refname =~ m!$g->{ignore_refs_regex}!;
 536        return 0 unless defined($_ignore_refs_regex);
 537        return 1 if $refname =~ m!$_ignore_refs_regex!o;
 538        return 0;
 539}
 540
 541sub match_globs {
 542        my ($self, $exists, $paths, $globs, $r) = @_;
 543
 544        sub get_dir_check {
 545                my ($self, $exists, $g, $r) = @_;
 546
 547                my @dirs = $self->get_dir_globbed($g->{path}->{left},
 548                                                  $g->{path}->{depth},
 549                                                  $r);
 550
 551                foreach my $de (@dirs) {
 552                        my $p = $g->{path}->full_path($de);
 553                        next if $exists->{$p};
 554                        next if (length $g->{path}->{right} &&
 555                                 ($self->check_path($p, $r) !=
 556                                  $SVN::Node::dir));
 557                        next unless $p =~ /$g->{path}->{regex}/;
 558                        $exists->{$p} = Git::SVN->init($self->url, $p, undef,
 559                                         $g->{ref}->full_path($de), 1);
 560                }
 561        }
 562        foreach my $g (@$globs) {
 563                if (my $path = $paths->{"/$g->{path}->{left}"}) {
 564                        if ($path->{action} =~ /^[AR]$/) {
 565                                get_dir_check($self, $exists, $g, $r);
 566                        }
 567                }
 568                foreach (keys %$paths) {
 569                        if (/$g->{path}->{left_regex}/ &&
 570                            !/$g->{path}->{regex}/) {
 571                                next if $paths->{$_}->{action} !~ /^[AR]$/;
 572                                get_dir_check($self, $exists, $g, $r);
 573                        }
 574                        next unless /$g->{path}->{regex}/;
 575                        my $p = $1;
 576                        my $pathname = $g->{path}->full_path($p);
 577                        next if is_ref_ignored($g, $p);
 578                        next if $exists->{$pathname};
 579                        next if ($self->check_path($pathname, $r) !=
 580                                 $SVN::Node::dir);
 581                        $exists->{$pathname} = Git::SVN->init(
 582                                              $self->url, $pathname, undef,
 583                                              $g->{ref}->full_path($p), 1);
 584                }
 585                my $c = '';
 586                foreach (split m#/#, $g->{path}->{left}) {
 587                        $c .= "/$_";
 588                        next unless ($paths->{$c} &&
 589                                     ($paths->{$c}->{action} =~ /^[AR]$/));
 590                        get_dir_check($self, $exists, $g, $r);
 591                }
 592        }
 593        values %$exists;
 594}
 595
 596sub minimize_url {
 597        my ($self) = @_;
 598        return $self->url if ($self->url eq $self->{repos_root});
 599        my $url = $self->{repos_root};
 600        my @components = split(m!/!, $self->{svn_path});
 601        my $c = '';
 602        do {
 603                $url = add_path_to_url($url, $c);
 604                eval {
 605                        my $ra = (ref $self)->new($url);
 606                        my $latest = $ra->get_latest_revnum;
 607                        $ra->get_log("", $latest, 0, 1, 0, 1, sub {});
 608                };
 609        } while ($@ && defined($c = shift @components));
 610
 611        return canonicalize_url($url);
 612}
 613
 614sub can_do_switch {
 615        my $self = shift;
 616        unless (defined $can_do_switch) {
 617                my $pool = SVN::Pool->new;
 618                my $rep = eval {
 619                        $self->do_switch(1, '', 0, $self->url,
 620                                         SVN::Delta::Editor->new, $pool);
 621                };
 622                if ($@) {
 623                        $can_do_switch = 0;
 624                } else {
 625                        $rep->abort_report($pool);
 626                        $can_do_switch = 1;
 627                }
 628                $pool->clear;
 629        }
 630        $can_do_switch;
 631}
 632
 633sub skip_unknown_revs {
 634        my ($err) = @_;
 635        my $errno = $err->apr_err();
 636        # Maybe the branch we're tracking didn't
 637        # exist when the repo started, so it's
 638        # not an error if it doesn't, just continue
 639        #
 640        # Wonderfully consistent library, eh?
 641        # 160013 - svn:// and file://
 642        # 175002 - http(s)://
 643        # 175007 - http(s):// (this repo required authorization, too...)
 644        #   More codes may be discovered later...
 645        if ($errno == 175007 || $errno == 175002 || $errno == 160013) {
 646                my $err_key = $err->expanded_message;
 647                # revision numbers change every time, filter them out
 648                $err_key =~ s/\d+/\0/g;
 649                $err_key = "$errno\0$err_key";
 650                unless ($ignored_err{$err_key}) {
 651                        warn "W: Ignoring error from SVN, path probably ",
 652                             "does not exist: ($errno): ",
 653                             $err->expanded_message,"\n";
 654                        warn "W: Do not be alarmed at the above message ",
 655                             "git-svn is just searching aggressively for ",
 656                             "old history.\n",
 657                             "This may take a while on large repositories\n";
 658                        $ignored_err{$err_key} = 1;
 659                }
 660                return;
 661        }
 662        die "Error from SVN, ($errno): ", $err->expanded_message,"\n";
 663}
 664
 6651;
 666__END__
 667
 668=head1 NAME
 669
 670Git::SVN::Ra - Subversion remote access functions for git-svn
 671
 672=head1 SYNOPSIS
 673
 674    use Git::SVN::Ra;
 675
 676    my $ra = Git::SVN::Ra->new($branchurl);
 677    my ($dirents, $fetched_revnum, $props) =
 678        $ra->get_dir('.', $SVN::Core::INVALID_REVNUM);
 679
 680=head1 DESCRIPTION
 681
 682This is a wrapper around the L<SVN::Ra> module for use by B<git-svn>.
 683It fills in some default parameters (such as the authentication
 684scheme), smooths over incompatibilities between libsvn versions, adds
 685caching, and implements some functions specific to B<git-svn>.
 686
 687Do not use it unless you are developing git-svn.  The interface will
 688change as git-svn evolves.
 689
 690=head1 DEPENDENCIES
 691
 692Subversion perl bindings,
 693L<Git::SVN>.
 694
 695C<Git::SVN::Ra> has not been tested using callers other than
 696B<git-svn> itself.
 697
 698=head1 SEE ALSO
 699
 700L<SVN::Ra>.
 701
 702=head1 INCOMPATIBILITIES
 703
 704None reported.
 705
 706=head1 BUGS
 707
 708None.