git-svn: make Git::SVN::RA a separate file
This slices off another 600 or so lines from the frighteningly long git-svn.perl script. The Git::SVN::Ra interface is similar enough to SVN::Ra that it is probably safe to ignore most of its implementation on first reading. (Documenting or moving functions that do not fit that pattern is left as an exercise to the interested reader.) [ew: rebased and fixed conflict against commit c26ddce86d7215b4d9687bd4c6b5dd43a3fabf31 (git-svn: platform auth providers are working only on 1.6.15 or newer)] Signed-off-by: Jonathan Nieder <jrnieder@gmail.com> Signed-off-by: Eric Wong <normalperson@yhbt.net>
Jonathan Nieder committed
Jun 9, 2012 at 17:28 UTC
9f7ad1479d9ba88f175db57fba1ab704fc7b53d5
3 files changed
+660
-611
git-svn.perl
+1
-611
@@ -67,7 +67,6 @@ sub _req_svn {
67
}
68
}
69
my $can_compress = eval { require Compress::Zlib; 1};
70
-push @Git::SVN::Ra::ISA, 'SVN::Ra';
70
use Carp qw/croak/;
71
use Digest::MD5;
72
use IO::File qw//;
@@ -80,6 +79,7 @@ use IPC::Open3;
79
use Git;
80
use Git::SVN::Editor qw//;
81
use Git::SVN::Fetcher qw//;
82
+use Git::SVN::Ra qw//;
83
use Git::SVN::Prompt qw//;
84
use Memoize; # core since 5.8.0, Jul 2002
85
@@ -4326,616 +4326,6 @@ sub remove_username {
4326
$_[0] =~ s{^([^:]*://)[^@]+@}{$1};
4327
}
4328
4329
-package Git::SVN::Ra;
4330
-use vars qw/@ISA $config_dir $_ignore_refs_regex $_log_window_size/;
4331
-use strict;
4332
-use warnings;
4333
-my ($ra_invalid, $can_do_switch, %ignored_err, $RA);
4334
-
4335
-BEGIN {
4336
- # enforce temporary pool usage for some simple functions
4337
- no strict 'refs';
4338
- for my $f (qw/rev_proplist get_latest_revnum get_uuid get_repos_root
4339
- get_file/) {
4340
- my $SUPER = "SUPER::$f";
4341
- *$f = sub {
4342
- my $self = shift;
4343
- my $pool = SVN::Pool->new;
4344
- my @ret = $self->$SUPER(@_,$pool);
4345
- $pool->clear;
4346
- wantarray ? @ret : $ret[0];
4347
- };
4348
- }
4349
-}
4350
-
4351
-sub _auth_providers () {
4352
- my @rv = (
4353
- SVN::Client::get_simple_provider(),
4354
- SVN::Client::get_ssl_server_trust_file_provider(),
4355
- SVN::Client::get_simple_prompt_provider(
4356
- \&Git::SVN::Prompt::simple, 2),
4357
- SVN::Client::get_ssl_client_cert_file_provider(),
4358
- SVN::Client::get_ssl_client_cert_prompt_provider(
4359
- \&Git::SVN::Prompt::ssl_client_cert, 2),
4360
- SVN::Client::get_ssl_client_cert_pw_file_provider(),
4361
- SVN::Client::get_ssl_client_cert_pw_prompt_provider(
4362
- \&Git::SVN::Prompt::ssl_client_cert_pw, 2),
4363
- SVN::Client::get_username_provider(),
4364
- SVN::Client::get_ssl_server_trust_prompt_provider(
4365
- \&Git::SVN::Prompt::ssl_server_trust),
4366
- SVN::Client::get_username_prompt_provider(
4367
- \&Git::SVN::Prompt::username, 2)
4368
- );
4369
-
4370
- # earlier 1.6.x versions would segfault, and <= 1.5.x didn't have
4371
- # this function
4372
- if (::compare_svn_version('1.6.15') >= 0) {
4373
- my $config = SVN::Core::config_get_config($config_dir);
4374
- my ($p, @a);
4375
- # config_get_config returns all config files from
4376
- # ~/.subversion, auth_get_platform_specific_client_providers
4377
- # just wants the config "file".
4378
- @a = ($config->{'config'}, undef);
4379
- $p = SVN::Core::auth_get_platform_specific_client_providers(@a);
4380
- # Insert the return value from
4381
- # auth_get_platform_specific_providers
4382
- unshift @rv, @$p;
4383
- }
4384
- \@rv;
4385
-}
4386
-
4387
-sub escape_uri_only {
4388
- my ($uri) = @_;
4389
- my @tmp;
4390
- foreach (split m{/}, $uri) {
4391
- s/([^~\w.%+-]|%(?![a-fA-F0-9]{2}))/sprintf("%%%02X",ord($1))/eg;
4392
- push @tmp, $_;
4393
- }
4394
- join('/', @tmp);
4395
-}
4396
-
4397
-sub escape_url {
4398
- my ($url) = @_;
4399
- if ($url =~ m#^(https?)://([^/]+)(.*)$#) {
4400
- my ($scheme, $domain, $uri) = ($1, $2, escape_uri_only($3));
4401
- $url = "$scheme://$domain$uri";
4402
- }
4403
- $url;
4404
-}
4405
-
4406
-sub new {
4407
- my ($class, $url) = @_;
4408
- $url =~ s!/+$!!;
4409
- return $RA if ($RA && $RA->{url} eq $url);
4410
-
4411
- ::_req_svn();
4412
-
4413
- SVN::_Core::svn_config_ensure($config_dir, undef);
4414
- my ($baton, $callbacks) = SVN::Core::auth_open_helper(_auth_providers);
4415
- my $config = SVN::Core::config_get_config($config_dir);
4416
- $RA = undef;
4417
- my $dont_store_passwords = 1;
4418
- my $conf_t = ${$config}{'config'};
4419
- {
4420
- no warnings 'once';
4421
- # The usage of $SVN::_Core::SVN_CONFIG_* variables
4422
- # produces warnings that variables are used only once.
4423
- # I had not found the better way to shut them up, so
4424
- # the warnings of type 'once' are disabled in this block.
4425
- if (SVN::_Core::svn_config_get_bool($conf_t,
4426
- $SVN::_Core::SVN_CONFIG_SECTION_AUTH,
4427
- $SVN::_Core::SVN_CONFIG_OPTION_STORE_PASSWORDS,
4428
- 1) == 0) {
4429
- SVN::_Core::svn_auth_set_parameter($baton,
4430
- $SVN::_Core::SVN_AUTH_PARAM_DONT_STORE_PASSWORDS,
4431
- bless (\$dont_store_passwords, "_p_void"));
4432
- }
4433
- if (SVN::_Core::svn_config_get_bool($conf_t,
4434
- $SVN::_Core::SVN_CONFIG_SECTION_AUTH,
4435
- $SVN::_Core::SVN_CONFIG_OPTION_STORE_AUTH_CREDS,
4436
- 1) == 0) {
4437
- $Git::SVN::Prompt::_no_auth_cache = 1;
4438
- }
4439
- } # no warnings 'once'
4440
- my $self = SVN::Ra->new(url => escape_url($url), auth => $baton,
4441
- config => $config,
4442
- pool => SVN::Pool->new,
4443
- auth_provider_callbacks => $callbacks);
4444
- $self->{url} = $url;
4445
- $self->{svn_path} = $url;
4446
- $self->{repos_root} = $self->get_repos_root;
4447
- $self->{svn_path} =~ s#^\Q$self->{repos_root}\E(/|$)##;
4448
- $self->{cache} = { check_path => { r => 0, data => {} },
4449
- get_dir => { r => 0, data => {} } };
4450
- $RA = bless $self, $class;
4451
-}
4452
-
4453
-sub check_path {
4454
- my ($self, $path, $r) = @_;
4455
- my $cache = $self->{cache}->{check_path};
4456
- if ($r == $cache->{r} && exists $cache->{data}->{$path}) {
4457
- return $cache->{data}->{$path};
4458
- }
4459
- my $pool = SVN::Pool->new;
4460
- my $t = $self->SUPER::check_path($path, $r, $pool);
4461
- $pool->clear;
4462
- if ($r != $cache->{r}) {
4463
- %{$cache->{data}} = ();
4464
- $cache->{r} = $r;
4465
- }
4466
- $cache->{data}->{$path} = $t;
4467
-}
4468
-
4469
-sub get_dir {
4470
- my ($self, $dir, $r) = @_;
4471
- my $cache = $self->{cache}->{get_dir};
4472
- if ($r == $cache->{r}) {
4473
- if (my $x = $cache->{data}->{$dir}) {
4474
- return wantarray ? @$x : $x->[0];
4475
- }
4476
- }
4477
- my $pool = SVN::Pool->new;
4478
- my ($d, undef, $props) = $self->SUPER::get_dir($dir, $r, $pool);
4479
- my %dirents = map { $_ => { kind => $d->{$_}->kind } } keys %$d;
4480
- $pool->clear;
4481
- if ($r != $cache->{r}) {
4482
- %{$cache->{data}} = ();
4483
- $cache->{r} = $r;
4484
- }
4485
- $cache->{data}->{$dir} = [ \%dirents, $r, $props ];
4486
- wantarray ? (\%dirents, $r, $props) : \%dirents;
4487
-}
4488
-
4489
-sub DESTROY {
4490
- # do not call the real DESTROY since we store ourselves in $RA
4491
-}
4492
-
4493
-# get_log(paths, start, end, limit,
4494
-# discover_changed_paths, strict_node_history, receiver)
4495
-sub get_log {
4496
- my ($self, @args) = @_;
4497
- my $pool = SVN::Pool->new;
4498
-
4499
- # svn_log_changed_path_t objects passed to get_log are likely to be
4500
- # overwritten even if only the refs are copied to an external variable,
4501
- # so we should dup the structures in their entirety. Using an
4502
- # externally passed pool (instead of our temporary and quickly cleared
4503
- # pool in Git::SVN::Ra) does not help matters at all...
4504
- my $receiver = pop @args;
4505
- my $prefix = "/".$self->{svn_path};
4506
- $prefix =~ s#/+($)##;
4507
- my $prefix_regex = qr#^\Q$prefix\E#;
4508
- push(@args, sub {
4509
- my ($paths) = $_[0];
4510
- return &$receiver(@_) unless $paths;
4511
- $_[0] = ();
4512
- foreach my $p (keys %$paths) {
4513
- my $i = $paths->{$p};
4514
- # Make path relative to our url, not repos_root
4515
- $p =~ s/$prefix_regex//;
4516
- my %s = map { $_ => $i->$_; }
4517
- qw/copyfrom_path copyfrom_rev action/;
4518
- if ($s{'copyfrom_path'}) {
4519
- $s{'copyfrom_path'} =~ s/$prefix_regex//;
4520
- }
4521
- $_[0]{$p} = \%s;
4522
- }
4523
- &$receiver(@_);
4524
- });
4525
-
4526
-
4527
- # the limit parameter was not supported in SVN 1.1.x, so we
4528
- # drop it. Therefore, the receiver callback passed to it
4529
- # is made aware of this limitation by being wrapped if
4530
- # the limit passed to is being wrapped.
4531
- if (::compare_svn_version('1.2.0') <= 0) {
4532
- my $limit = splice(@args, 3, 1);
4533
- if ($limit > 0) {
4534
- my $receiver = pop @args;
4535
- push(@args, sub { &$receiver(@_) if (--$limit >= 0) });
4536
- }
4537
- }
4538
- my $ret = $self->SUPER::get_log(@args, $pool);
4539
- $pool->clear;
4540
- $ret;
4541
-}
4542
-
4543
-sub trees_match {
4544
- my ($self, $url1, $rev1, $url2, $rev2) = @_;
4545
- my $ctx = SVN::Client->new(auth => _auth_providers);
4546
- my $out = IO::File->new_tmpfile;
4547
-
4548
- # older SVN (1.1.x) doesn't take $pool as the last parameter for
4549
- # $ctx->diff(), so we'll create a default one
4550
- my $pool = SVN::Pool->new_default_sub;
4551
-
4552
- $ra_invalid = 1; # this will open a new SVN::Ra connection to $url1
4553
- $ctx->diff([], $url1, $rev1, $url2, $rev2, 1, 1, 0, $out, $out);
4554
- $out->flush;
4555
- my $ret = (($out->stat)[7] == 0);
4556
- close $out or croak $!;
4557
-
4558
- $ret;
4559
-}
4560
-
4561
-sub get_commit_editor {
4562
- my ($self, $log, $cb, $pool) = @_;
4563
-
4564
- my @lock = (::compare_svn_version('1.2.0') >= 0) ? (undef, 0) : ();
4565
- $self->SUPER::get_commit_editor($log, $cb, @lock, $pool);
4566
-}
4567
-
4568
-sub gs_do_update {
4569
- my ($self, $rev_a, $rev_b, $gs, $editor) = @_;
4570
- my $new = ($rev_a == $rev_b);
4571
- my $path = $gs->{path};
4572
-
4573
- if ($new && -e $gs->{index}) {
4574
- unlink $gs->{index} or die
4575
- "Couldn't unlink index: $gs->{index}: $!\n";
4576
- }
4577
- my $pool = SVN::Pool->new;
4578
- $editor->set_path_strip($path);
4579
- my (@pc) = split m#/#, $path;
4580
- my $reporter = $self->do_update($rev_b, (@pc ? shift @pc : ''),
4581
- 1, $editor, $pool);
4582
- my @lock = (::compare_svn_version('1.2.0') >= 0) ? (undef) : ();
4583
-
4584
- # Since we can't rely on svn_ra_reparent being available, we'll
4585
- # just have to do some magic with set_path to make it so
4586
- # we only want a partial path.
4587
- my $sp = '';
4588
- my $final = join('/', @pc);
4589
- while (@pc) {
4590
- $reporter->set_path($sp, $rev_b, 0, @lock, $pool);
4591
- $sp .= '/' if length $sp;
4592
- $sp .= shift @pc;
4593
- }
4594
- die "BUG: '$sp' != '$final'\n" if ($sp ne $final);
4595
-
4596
- $reporter->set_path($sp, $rev_a, $new, @lock, $pool);
4597
-
4598
- $reporter->finish_report($pool);
4599
- $pool->clear;
4600
- $editor->{git_commit_ok};
4601
-}
4602
-
4603
-# this requires SVN 1.4.3 or later (do_switch didn't work before 1.4.3, and
4604
-# svn_ra_reparent didn't work before 1.4)
4605
-sub gs_do_switch {
4606
- my ($self, $rev_a, $rev_b, $gs, $url_b, $editor) = @_;
4607
- my $path = $gs->{path};
4608
- my $pool = SVN::Pool->new;
4609
-
4610
- my $full_url = $self->{url};
4611
- my $old_url = $full_url;
4612
- $full_url .= '/' . $path if length $path;
4613
- my ($ra, $reparented);
4614
-
4615
- if ($old_url =~ m#^svn(\+ssh)?://# ||
4616
- ($full_url =~ m#^https?://# &&
4617
- escape_url($full_url) ne $full_url)) {
4618
- $_[0] = undef;
4619
- $self = undef;
4620
- $RA = undef;
4621
- $ra = Git::SVN::Ra->new($full_url);
4622
- $ra_invalid = 1;
4623
- } elsif ($old_url ne $full_url) {
4624
- SVN::_Ra::svn_ra_reparent($self->{session}, $full_url, $pool);
4625
- $self->{url} = $full_url;
4626
- $reparented = 1;
4627
- }
4628
-
4629
- $ra ||= $self;
4630
- $url_b = escape_url($url_b);
4631
- my $reporter = $ra->do_switch($rev_b, '', 1, $url_b, $editor, $pool);
4632
- my @lock = (::compare_svn_version('1.2.0') >= 0) ? (undef) : ();
4633
- $reporter->set_path('', $rev_a, 0, @lock, $pool);
4634
- $reporter->finish_report($pool);
4635
-
4636
- if ($reparented) {
4637
- SVN::_Ra::svn_ra_reparent($self->{session}, $old_url, $pool);
4638
- $self->{url} = $old_url;
4639
- }
4640
-
4641
- $pool->clear;
4642
- $editor->{git_commit_ok};
4643
-}
4644
-
4645
-sub longest_common_path {
4646
- my ($gsv, $globs) = @_;
4647
- my %common;
4648
- my $common_max = scalar @$gsv;
4649
-
4650
- foreach my $gs (@$gsv) {
4651
- my @tmp = split m#/#, $gs->{path};
4652
- my $p = '';
4653
- foreach (@tmp) {
4654
- $p .= length($p) ? "/$_" : $_;
4655
- $common{$p} ||= 0;
4656
- $common{$p}++;
4657
- }
4658
- }
4659
- $globs ||= [];
4660
- $common_max += scalar @$globs;
4661
- foreach my $glob (@$globs) {
4662
- my @tmp = split m#/#, $glob->{path}->{left};
4663
- my $p = '';
4664
- foreach (@tmp) {
4665
- $p .= length($p) ? "/$_" : $_;
4666
- $common{$p} ||= 0;
4667
- $common{$p}++;
4668
- }
4669
- }
4670
-
4671
- my $longest_path = '';
4672
- foreach (sort {length $b <=> length $a} keys %common) {
4673
- if ($common{$_} == $common_max) {
4674
- $longest_path = $_;
4675
- last;
4676
- }
4677
- }
4678
- $longest_path;
4679
-}
4680
-
4681
-sub gs_fetch_loop_common {
4682
- my ($self, $base, $head, $gsv, $globs) = @_;
4683
- return if ($base > $head);
4684
- my $inc = $_log_window_size;
4685
- my ($min, $max) = ($base, $head < $base + $inc ? $head : $base + $inc);
4686
- my $longest_path = longest_common_path($gsv, $globs);
4687
- my $ra_url = $self->{url};
4688
- my $find_trailing_edge;
4689
- while (1) {
4690
- my %revs;
4691
- my $err;
4692
- my $err_handler = $SVN::Error::handler;
4693
- $SVN::Error::handler = sub {
4694
- ($err) = @_;
4695
- skip_unknown_revs($err);
4696
- };
4697
- sub _cb {
4698
- my ($paths, $r, $author, $date, $log) = @_;
4699
- [ $paths,
4700
- { author => $author, date => $date, log => $log } ];
4701
- }
4702
- $self->get_log([$longest_path], $min, $max, 0, 1, 1,
4703
- sub { $revs{$_[1]} = _cb(@_) });
4704
- if ($err) {
4705
- print "Checked through r$max\r";
4706
- } else {
4707
- $find_trailing_edge = 1;
4708
- }
4709
- if ($err and $find_trailing_edge) {
4710
- print STDERR "Path '$longest_path' ",
4711
- "was probably deleted:\n",
4712
- $err->expanded_message,
4713
- "\nWill attempt to follow ",
4714
- "revisions r$min .. r$max ",
4715
- "committed before the deletion\n";
4716
- my $hi = $max;
4717
- while (--$hi >= $min) {
4718
- my $ok;
4719
- $self->get_log([$longest_path], $min, $hi,
4720
- 0, 1, 1, sub {
4721
- $ok = $_[1];
4722
- $revs{$_[1]} = _cb(@_) });
4723
- if ($ok) {
4724
- print STDERR "r$min .. r$ok OK\n";
4725
- last;
4726
- }
4727
- }
4728
- $find_trailing_edge = 0;
4729
- }
4730
- $SVN::Error::handler = $err_handler;
4731
-
4732
- my %exists = map { $_->{path} => $_ } @$gsv;
4733
- foreach my $r (sort {$a <=> $b} keys %revs) {
4734
- my ($paths, $logged) = @{$revs{$r}};
4735
-
4736
- foreach my $gs ($self->match_globs(\%exists, $paths,
4737
- $globs, $r)) {
4738
- if ($gs->rev_map_max >= $r) {
4739
- next;
4740
- }
4741
- next unless $gs->match_paths($paths, $r);
4742
- $gs->{logged_rev_props} = $logged;
4743
- if (my $last_commit = $gs->last_commit) {
4744
- $gs->assert_index_clean($last_commit);
4745
- }
4746
- my $log_entry = $gs->do_fetch($paths, $r);
4747
- if ($log_entry) {
4748
- $gs->do_git_commit($log_entry);
4749
- }
4750
- $INDEX_FILES{$gs->{index}} = 1;
4751
- }
4752
- foreach my $g (@$globs) {
4753
- my $k = "svn-remote.$g->{remote}." .
4754
- "$g->{t}-maxRev";
4755
- Git::SVN::tmp_config($k, $r);
4756
- }
4757
- if ($ra_invalid) {
4758
- $_[0] = undef;
4759
- $self = undef;
4760
- $RA = undef;
4761
- $self = Git::SVN::Ra->new($ra_url);
4762
- $ra_invalid = undef;
4763
- }
4764
- }
4765
- # pre-fill the .rev_db since it'll eventually get filled in
4766
- # with '0' x40 if something new gets committed
4767
- foreach my $gs (@$gsv) {
4768
- next if $gs->rev_map_max >= $max;
4769
- next if defined $gs->rev_map_get($max);
4770
- $gs->rev_map_set($max, 0 x40);
4771
- }
4772
- foreach my $g (@$globs) {
4773
- my $k = "svn-remote.$g->{remote}.$g->{t}-maxRev";
4774
- Git::SVN::tmp_config($k, $max);
4775
- }
4776
- last if $max >= $head;
4777
- $min = $max + 1;
4778
- $max += $inc;
4779
- $max = $head if ($max > $head);
4780
- }
4781
- Git::SVN::gc();
4782
-}
4783
-
4784
-sub get_dir_globbed {
4785
- my ($self, $left, $depth, $r) = @_;
4786
-
4787
- my @x = eval { $self->get_dir($left, $r) };
4788
- return unless scalar @x == 3;
4789
- my $dirents = $x[0];
4790
- my @finalents;
4791
- foreach my $de (keys %$dirents) {
4792
- next if $dirents->{$de}->{kind} != $SVN::Node::dir;
4793
- if ($depth > 1) {
4794
- my @args = ("$left/$de", $depth - 1, $r);
4795
- foreach my $dir ($self->get_dir_globbed(@args)) {
4796
- push @finalents, "$de/$dir";
4797
- }
4798
- } else {
4799
- push @finalents, $de;
4800
- }
4801
- }
4802
- @finalents;
4803
-}
4804
-
4805
-# return value: 0 -- don't ignore, 1 -- ignore
4806
-sub is_ref_ignored {
4807
- my ($g, $p) = @_;
4808
- my $refname = $g->{ref}->full_path($p);
4809
- return 1 if defined($g->{ignore_refs_regex}) &&
4810
- $refname =~ m!$g->{ignore_refs_regex}!;
4811
- return 0 unless defined($_ignore_refs_regex);
4812
- return 1 if $refname =~ m!$_ignore_refs_regex!o;
4813
- return 0;
4814
-}
4815
-
4816
-sub match_globs {
4817
- my ($self, $exists, $paths, $globs, $r) = @_;
4818
-
4819
- sub get_dir_check {
4820
- my ($self, $exists, $g, $r) = @_;
4821
-
4822
- my @dirs = $self->get_dir_globbed($g->{path}->{left},
4823
- $g->{path}->{depth},
4824
- $r);
4825
-
4826
- foreach my $de (@dirs) {
4827
- my $p = $g->{path}->full_path($de);
4828
- next if $exists->{$p};
4829
- next if (length $g->{path}->{right} &&
4830
- ($self->check_path($p, $r) !=
4831
- $SVN::Node::dir));
4832
- next unless $p =~ /$g->{path}->{regex}/;
4833
- $exists->{$p} = Git::SVN->init($self->{url}, $p, undef,
4834
- $g->{ref}->full_path($de), 1);
4835
- }
4836
- }
4837
- foreach my $g (@$globs) {
4838
- if (my $path = $paths->{"/$g->{path}->{left}"}) {
4839
- if ($path->{action} =~ /^[AR]$/) {
4840
- get_dir_check($self, $exists, $g, $r);
4841
- }
4842
- }
4843
- foreach (keys %$paths) {
4844
- if (/$g->{path}->{left_regex}/ &&
4845
- !/$g->{path}->{regex}/) {
4846
- next if $paths->{$_}->{action} !~ /^[AR]$/;
4847
- get_dir_check($self, $exists, $g, $r);
4848
- }
4849
- next unless /$g->{path}->{regex}/;
4850
- my $p = $1;
4851
- my $pathname = $g->{path}->full_path($p);
4852
- next if is_ref_ignored($g, $p);
4853
- next if $exists->{$pathname};
4854
- next if ($self->check_path($pathname, $r) !=
4855
- $SVN::Node::dir);
4856
- $exists->{$pathname} = Git::SVN->init(
4857
- $self->{url}, $pathname, undef,
4858
- $g->{ref}->full_path($p), 1);
4859
- }
4860
- my $c = '';
4861
- foreach (split m#/#, $g->{path}->{left}) {
4862
- $c .= "/$_";
4863
- next unless ($paths->{$c} &&
4864
- ($paths->{$c}->{action} =~ /^[AR]$/));
4865
- get_dir_check($self, $exists, $g, $r);
4866
- }
4867
- }
4868
- values %$exists;
4869
-}
4870
-
4871
-sub minimize_url {
4872
- my ($self) = @_;
4873
- return $self->{url} if ($self->{url} eq $self->{repos_root});
4874
- my $url = $self->{repos_root};
4875
- my @components = split(m!/!, $self->{svn_path});
4876
- my $c = '';
4877
- do {
4878
- $url .= "/$c" if length $c;
4879
- eval {
4880
- my $ra = (ref $self)->new($url);
4881
- my $latest = $ra->get_latest_revnum;
4882
- $ra->get_log("", $latest, 0, 1, 0, 1, sub {});
4883
- };
4884
- } while ($@ && ($c = shift @components));
4885
- $url;
4886
-}
4887
-
4888
-sub can_do_switch {
4889
- my $self = shift;
4890
- unless (defined $can_do_switch) {
4891
- my $pool = SVN::Pool->new;
4892
- my $rep = eval {
4893
- $self->do_switch(1, '', 0, $self->{url},
4894
- SVN::Delta::Editor->new, $pool);
4895
- };
4896
- if ($@) {
4897
- $can_do_switch = 0;
4898
- } else {
4899
- $rep->abort_report($pool);
4900
- $can_do_switch = 1;
4901
- }
4902
- $pool->clear;
4903
- }
4904
- $can_do_switch;
4905
-}
4906
-
4907
-sub skip_unknown_revs {
4908
- my ($err) = @_;
4909
- my $errno = $err->apr_err();
4910
- # Maybe the branch we're tracking didn't
4911
- # exist when the repo started, so it's
4912
- # not an error if it doesn't, just continue
4913
- #
4914
- # Wonderfully consistent library, eh?
4915
- # 160013 - svn:// and file://
4916
- # 175002 - http(s)://
4917
- # 175007 - http(s):// (this repo required authorization, too...)
4918
- # More codes may be discovered later...
4919
- if ($errno == 175007 || $errno == 175002 || $errno == 160013) {
4920
- my $err_key = $err->expanded_message;
4921
- # revision numbers change every time, filter them out
4922
- $err_key =~ s/\d+/\0/g;
4923
- $err_key = "$errno\0$err_key";
4924
- unless ($ignored_err{$err_key}) {
4925
- warn "W: Ignoring error from SVN, path probably ",
4926
- "does not exist: ($errno): ",
4927
- $err->expanded_message,"\n";
4928
- warn "W: Do not be alarmed at the above message ",
4929
- "git-svn is just searching aggressively for ",
4930
- "old history.\n",
4931
- "This may take a while on large repositories\n";
4932
- $ignored_err{$err_key} = 1;
4933
- }
4934
- return;
4935
- }
4936
- die "Error from SVN, ($errno): ", $err->expanded_message,"\n";
4937
-}
4938
-
4329
package Git::SVN::Log;
4330
use strict;
4331
use warnings;
perl/Git/SVN/Ra.pm
new
+658
@@ -0,0 +1,658 @@
1
+package Git::SVN::Ra;
2
+use vars qw/@ISA $config_dir $_ignore_refs_regex $_log_window_size/;
3
+use strict;
4
+use warnings;
5
+use SVN::Client;
6
+use SVN::Ra;
7
+BEGIN {
8
+ @ISA = qw(SVN::Ra);
9
+}
10
+
11
+my ($ra_invalid, $can_do_switch, %ignored_err, $RA);
12
+
13
+BEGIN {
14
+ # enforce temporary pool usage for some simple functions
15
+ no strict 'refs';
16
+ for my $f (qw/rev_proplist get_latest_revnum get_uuid get_repos_root
17
+ get_file/) {
18
+ my $SUPER = "SUPER::$f";
19
+ *$f = sub {
20
+ my $self = shift;
21
+ my $pool = SVN::Pool->new;
22
+ my @ret = $self->$SUPER(@_,$pool);
23
+ $pool->clear;
24
+ wantarray ? @ret : $ret[0];
25
+ };
26
+ }
27
+}
28
+
29
+sub _auth_providers () {
30
+ my @rv = (
31
+ SVN::Client::get_simple_provider(),
32
+ SVN::Client::get_ssl_server_trust_file_provider(),
33
+ SVN::Client::get_simple_prompt_provider(
34
+ \&Git::SVN::Prompt::simple, 2),
35
+ SVN::Client::get_ssl_client_cert_file_provider(),
36
+ SVN::Client::get_ssl_client_cert_prompt_provider(
37
+ \&Git::SVN::Prompt::ssl_client_cert, 2),
38
+ SVN::Client::get_ssl_client_cert_pw_file_provider(),
39
+ SVN::Client::get_ssl_client_cert_pw_prompt_provider(
40
+ \&Git::SVN::Prompt::ssl_client_cert_pw, 2),
41
+ SVN::Client::get_username_provider(),
42
+ SVN::Client::get_ssl_server_trust_prompt_provider(
43
+ \&Git::SVN::Prompt::ssl_server_trust),
44
+ SVN::Client::get_username_prompt_provider(
45
+ \&Git::SVN::Prompt::username, 2)
46
+ );
47
+
48
+ # earlier 1.6.x versions would segfault, and <= 1.5.x didn't have
49
+ # this function
50
+ if (::compare_svn_version('1.6.15') >= 0) {
51
+ my $config = SVN::Core::config_get_config($config_dir);
52
+ my ($p, @a);
53
+ # config_get_config returns all config files from
54
+ # ~/.subversion, auth_get_platform_specific_client_providers
55
+ # just wants the config "file".
56
+ @a = ($config->{'config'}, undef);
57
+ $p = SVN::Core::auth_get_platform_specific_client_providers(@a);
58
+ # Insert the return value from
59
+ # auth_get_platform_specific_providers
60
+ unshift @rv, @$p;
61
+ }
62
+ \@rv;
63
+}
64
+
65
+sub escape_uri_only {
66
+ my ($uri) = @_;
67
+ my @tmp;
68
+ foreach (split m{/}, $uri) {
69
+ s/([^~\w.%+-]|%(?![a-fA-F0-9]{2}))/sprintf("%%%02X",ord($1))/eg;
70
+ push @tmp, $_;
71
+ }
72
+ join('/', @tmp);
73
+}
74
+
75
+sub escape_url {
76
+ my ($url) = @_;
77
+ if ($url =~ m#^(https?)://([^/]+)(.*)$#) {
78
+ my ($scheme, $domain, $uri) = ($1, $2, escape_uri_only($3));
79
+ $url = "$scheme://$domain$uri";
80
+ }
81
+ $url;
82
+}
83
+
84
+sub new {
85
+ my ($class, $url) = @_;
86
+ $url =~ s!/+$!!;
87
+ return $RA if ($RA && $RA->{url} eq $url);
88
+
89
+ ::_req_svn();
90
+
91
+ SVN::_Core::svn_config_ensure($config_dir, undef);
92
+ my ($baton, $callbacks) = SVN::Core::auth_open_helper(_auth_providers);
93
+ my $config = SVN::Core::config_get_config($config_dir);
94
+ $RA = undef;
95
+ my $dont_store_passwords = 1;
96
+ my $conf_t = ${$config}{'config'};
97
+ {
98
+ no warnings 'once';
99
+ # The usage of $SVN::_Core::SVN_CONFIG_* variables
100
+ # produces warnings that variables are used only once.
101
+ # I had not found the better way to shut them up, so
102
+ # the warnings of type 'once' are disabled in this block.
103
+ if (SVN::_Core::svn_config_get_bool($conf_t,
104
+ $SVN::_Core::SVN_CONFIG_SECTION_AUTH,
105
+ $SVN::_Core::SVN_CONFIG_OPTION_STORE_PASSWORDS,
106
+ 1) == 0) {
107
+ SVN::_Core::svn_auth_set_parameter($baton,
108
+ $SVN::_Core::SVN_AUTH_PARAM_DONT_STORE_PASSWORDS,
109
+ bless (\$dont_store_passwords, "_p_void"));
110
+ }
111
+ if (SVN::_Core::svn_config_get_bool($conf_t,
112
+ $SVN::_Core::SVN_CONFIG_SECTION_AUTH,
113
+ $SVN::_Core::SVN_CONFIG_OPTION_STORE_AUTH_CREDS,
114
+ 1) == 0) {
115
+ $Git::SVN::Prompt::_no_auth_cache = 1;
116
+ }
117
+ } # no warnings 'once'
118
+ my $self = SVN::Ra->new(url => escape_url($url), auth => $baton,
119
+ config => $config,
120
+ pool => SVN::Pool->new,
121
+ auth_provider_callbacks => $callbacks);
122
+ $self->{url} = $url;
123
+ $self->{svn_path} = $url;
124
+ $self->{repos_root} = $self->get_repos_root;
125
+ $self->{svn_path} =~ s#^\Q$self->{repos_root}\E(/|$)##;
126
+ $self->{cache} = { check_path => { r => 0, data => {} },
127
+ get_dir => { r => 0, data => {} } };
128
+ $RA = bless $self, $class;
129
+}
130
+
131
+sub check_path {
132
+ my ($self, $path, $r) = @_;
133
+ my $cache = $self->{cache}->{check_path};
134
+ if ($r == $cache->{r} && exists $cache->{data}->{$path}) {
135
+ return $cache->{data}->{$path};
136
+ }
137
+ my $pool = SVN::Pool->new;
138
+ my $t = $self->SUPER::check_path($path, $r, $pool);
139
+ $pool->clear;
140
+ if ($r != $cache->{r}) {
141
+ %{$cache->{data}} = ();
142
+ $cache->{r} = $r;
143
+ }
144
+ $cache->{data}->{$path} = $t;
145
+}
146
+
147
+sub get_dir {
148
+ my ($self, $dir, $r) = @_;
149
+ my $cache = $self->{cache}->{get_dir};
150
+ if ($r == $cache->{r}) {
151
+ if (my $x = $cache->{data}->{$dir}) {
152
+ return wantarray ? @$x : $x->[0];
153
+ }
154
+ }
155
+ my $pool = SVN::Pool->new;
156
+ my ($d, undef, $props) = $self->SUPER::get_dir($dir, $r, $pool);
157
+ my %dirents = map { $_ => { kind => $d->{$_}->kind } } keys %$d;
158
+ $pool->clear;
159
+ if ($r != $cache->{r}) {
160
+ %{$cache->{data}} = ();
161
+ $cache->{r} = $r;
162
+ }
163
+ $cache->{data}->{$dir} = [ \%dirents, $r, $props ];
164
+ wantarray ? (\%dirents, $r, $props) : \%dirents;
165
+}
166
+
167
+sub DESTROY {
168
+ # do not call the real DESTROY since we store ourselves in $RA
169
+}
170
+
171
+# get_log(paths, start, end, limit,
172
+# discover_changed_paths, strict_node_history, receiver)
173
+sub get_log {
174
+ my ($self, @args) = @_;
175
+ my $pool = SVN::Pool->new;
176
+
177
+ # svn_log_changed_path_t objects passed to get_log are likely to be
178
+ # overwritten even if only the refs are copied to an external variable,
179
+ # so we should dup the structures in their entirety. Using an
180
+ # externally passed pool (instead of our temporary and quickly cleared
181
+ # pool in Git::SVN::Ra) does not help matters at all...
182
+ my $receiver = pop @args;
183
+ my $prefix = "/".$self->{svn_path};
184
+ $prefix =~ s#/+($)##;
185
+ my $prefix_regex = qr#^\Q$prefix\E#;
186
+ push(@args, sub {
187
+ my ($paths) = $_[0];
188
+ return &$receiver(@_) unless $paths;
189
+ $_[0] = ();
190
+ foreach my $p (keys %$paths) {
191
+ my $i = $paths->{$p};
192
+ # Make path relative to our url, not repos_root
193
+ $p =~ s/$prefix_regex//;
194
+ my %s = map { $_ => $i->$_; }
195
+ qw/copyfrom_path copyfrom_rev action/;
196
+ if ($s{'copyfrom_path'}) {
197
+ $s{'copyfrom_path'} =~ s/$prefix_regex//;
198
+ }
199
+ $_[0]{$p} = \%s;
200
+ }
201
+ &$receiver(@_);
202
+ });
203
+
204
+
205
+ # the limit parameter was not supported in SVN 1.1.x, so we
206
+ # drop it. Therefore, the receiver callback passed to it
207
+ # is made aware of this limitation by being wrapped if
208
+ # the limit passed to is being wrapped.
209
+ if (::compare_svn_version('1.2.0') <= 0) {
210
+ my $limit = splice(@args, 3, 1);
211
+ if ($limit > 0) {
212
+ my $receiver = pop @args;
213
+ push(@args, sub { &$receiver(@_) if (--$limit >= 0) });
214
+ }
215
+ }
216
+ my $ret = $self->SUPER::get_log(@args, $pool);
217
+ $pool->clear;
218
+ $ret;
219
+}
220
+
221
+sub trees_match {
222
+ my ($self, $url1, $rev1, $url2, $rev2) = @_;
223
+ my $ctx = SVN::Client->new(auth => _auth_providers);
224
+ my $out = IO::File->new_tmpfile;
225
+
226
+ # older SVN (1.1.x) doesn't take $pool as the last parameter for
227
+ # $ctx->diff(), so we'll create a default one
228
+ my $pool = SVN::Pool->new_default_sub;
229
+
230
+ $ra_invalid = 1; # this will open a new SVN::Ra connection to $url1
231
+ $ctx->diff([], $url1, $rev1, $url2, $rev2, 1, 1, 0, $out, $out);
232
+ $out->flush;
233
+ my $ret = (($out->stat)[7] == 0);
234
+ close $out or croak $!;
235
+
236
+ $ret;
237
+}
238
+
239
+sub get_commit_editor {
240
+ my ($self, $log, $cb, $pool) = @_;
241
+
242
+ my @lock = (::compare_svn_version('1.2.0') >= 0) ? (undef, 0) : ();
243
+ $self->SUPER::get_commit_editor($log, $cb, @lock, $pool);
244
+}
245
+
246
+sub gs_do_update {
247
+ my ($self, $rev_a, $rev_b, $gs, $editor) = @_;
248
+ my $new = ($rev_a == $rev_b);
249
+ my $path = $gs->{path};
250
+
251
+ if ($new && -e $gs->{index}) {
252
+ unlink $gs->{index} or die
253
+ "Couldn't unlink index: $gs->{index}: $!\n";
254
+ }
255
+ my $pool = SVN::Pool->new;
256
+ $editor->set_path_strip($path);
257
+ my (@pc) = split m#/#, $path;
258
+ my $reporter = $self->do_update($rev_b, (@pc ? shift @pc : ''),
259
+ 1, $editor, $pool);
260
+ my @lock = (::compare_svn_version('1.2.0') >= 0) ? (undef) : ();
261
+
262
+ # Since we can't rely on svn_ra_reparent being available, we'll
263
+ # just have to do some magic with set_path to make it so
264
+ # we only want a partial path.
265
+ my $sp = '';
266
+ my $final = join('/', @pc);
267
+ while (@pc) {
268
+ $reporter->set_path($sp, $rev_b, 0, @lock, $pool);
269
+ $sp .= '/' if length $sp;
270
+ $sp .= shift @pc;
271
+ }
272
+ die "BUG: '$sp' != '$final'\n" if ($sp ne $final);
273
+
274
+ $reporter->set_path($sp, $rev_a, $new, @lock, $pool);
275
+
276
+ $reporter->finish_report($pool);
277
+ $pool->clear;
278
+ $editor->{git_commit_ok};
279
+}
280
+
281
+# this requires SVN 1.4.3 or later (do_switch didn't work before 1.4.3, and
282
+# svn_ra_reparent didn't work before 1.4)
283
+sub gs_do_switch {
284
+ my ($self, $rev_a, $rev_b, $gs, $url_b, $editor) = @_;
285
+ my $path = $gs->{path};
286
+ my $pool = SVN::Pool->new;
287
+
288
+ my $full_url = $self->{url};
289
+ my $old_url = $full_url;
290
+ $full_url .= '/' . $path if length $path;
291
+ my ($ra, $reparented);
292
+
293
+ if ($old_url =~ m#^svn(\+ssh)?://# ||
294
+ ($full_url =~ m#^https?://# &&
295
+ escape_url($full_url) ne $full_url)) {
296
+ $_[0] = undef;
297
+ $self = undef;
298
+ $RA = undef;
299
+ $ra = Git::SVN::Ra->new($full_url);
300
+ $ra_invalid = 1;
301
+ } elsif ($old_url ne $full_url) {
302
+ SVN::_Ra::svn_ra_reparent($self->{session}, $full_url, $pool);
303
+ $self->{url} = $full_url;
304
+ $reparented = 1;
305
+ }
306
+
307
+ $ra ||= $self;
308
+ $url_b = escape_url($url_b);
309
+ my $reporter = $ra->do_switch($rev_b, '', 1, $url_b, $editor, $pool);
310
+ my @lock = (::compare_svn_version('1.2.0') >= 0) ? (undef) : ();
311
+ $reporter->set_path('', $rev_a, 0, @lock, $pool);
312
+ $reporter->finish_report($pool);
313
+
314
+ if ($reparented) {
315
+ SVN::_Ra::svn_ra_reparent($self->{session}, $old_url, $pool);
316
+ $self->{url} = $old_url;
317
+ }
318
+
319
+ $pool->clear;
320
+ $editor->{git_commit_ok};
321
+}
322
+
323
+sub longest_common_path {
324
+ my ($gsv, $globs) = @_;
325
+ my %common;
326
+ my $common_max = scalar @$gsv;
327
+
328
+ foreach my $gs (@$gsv) {
329
+ my @tmp = split m#/#, $gs->{path};
330
+ my $p = '';
331
+ foreach (@tmp) {
332
+ $p .= length($p) ? "/$_" : $_;
333
+ $common{$p} ||= 0;
334
+ $common{$p}++;
335
+ }
336
+ }
337
+ $globs ||= [];
338
+ $common_max += scalar @$globs;
339
+ foreach my $glob (@$globs) {
340
+ my @tmp = split m#/#, $glob->{path}->{left};
341
+ my $p = '';
342
+ foreach (@tmp) {
343
+ $p .= length($p) ? "/$_" : $_;
344
+ $common{$p} ||= 0;
345
+ $common{$p}++;
346
+ }
347
+ }
348
+
349
+ my $longest_path = '';
350
+ foreach (sort {length $b <=> length $a} keys %common) {
351
+ if ($common{$_} == $common_max) {
352
+ $longest_path = $_;
353
+ last;
354
+ }
355
+ }
356
+ $longest_path;
357
+}
358
+
359
+sub gs_fetch_loop_common {
360
+ my ($self, $base, $head, $gsv, $globs) = @_;
361
+ return if ($base > $head);
362
+ my $inc = $_log_window_size;
363
+ my ($min, $max) = ($base, $head < $base + $inc ? $head : $base + $inc);
364
+ my $longest_path = longest_common_path($gsv, $globs);
365
+ my $ra_url = $self->{url};
366
+ my $find_trailing_edge;
367
+ while (1) {
368
+ my %revs;
369
+ my $err;
370
+ my $err_handler = $SVN::Error::handler;
371
+ $SVN::Error::handler = sub {
372
+ ($err) = @_;
373
+ skip_unknown_revs($err);
374
+ };
375
+ sub _cb {
376
+ my ($paths, $r, $author, $date, $log) = @_;
377
+ [ $paths,
378
+ { author => $author, date => $date, log => $log } ];
379
+ }
380
+ $self->get_log([$longest_path], $min, $max, 0, 1, 1,
381
+ sub { $revs{$_[1]} = _cb(@_) });
382
+ if ($err) {
383
+ print "Checked through r$max\r";
384
+ } else {
385
+ $find_trailing_edge = 1;
386
+ }
387
+ if ($err and $find_trailing_edge) {
388
+ print STDERR "Path '$longest_path' ",
389
+ "was probably deleted:\n",
390
+ $err->expanded_message,
391
+ "\nWill attempt to follow ",
392
+ "revisions r$min .. r$max ",
393
+ "committed before the deletion\n";
394
+ my $hi = $max;
395
+ while (--$hi >= $min) {
396
+ my $ok;
397
+ $self->get_log([$longest_path], $min, $hi,
398
+ 0, 1, 1, sub {
399
+ $ok = $_[1];
400
+ $revs{$_[1]} = _cb(@_) });
401
+ if ($ok) {
402
+ print STDERR "r$min .. r$ok OK\n";
403
+ last;
404
+ }
405
+ }
406
+ $find_trailing_edge = 0;
407
+ }
408
+ $SVN::Error::handler = $err_handler;
409
+
410
+ my %exists = map { $_->{path} => $_ } @$gsv;
411
+ foreach my $r (sort {$a <=> $b} keys %revs) {
412
+ my ($paths, $logged) = @{$revs{$r}};
413
+
414
+ foreach my $gs ($self->match_globs(\%exists, $paths,
415
+ $globs, $r)) {
416
+ if ($gs->rev_map_max >= $r) {
417
+ next;
418
+ }
419
+ next unless $gs->match_paths($paths, $r);
420
+ $gs->{logged_rev_props} = $logged;
421
+ if (my $last_commit = $gs->last_commit) {
422
+ $gs->assert_index_clean($last_commit);
423
+ }
424
+ my $log_entry = $gs->do_fetch($paths, $r);
425
+ if ($log_entry) {
426
+ $gs->do_git_commit($log_entry);
427
+ }
428
+ $Git::SVN::INDEX_FILES{$gs->{index}} = 1;
429
+ }
430
+ foreach my $g (@$globs) {
431
+ my $k = "svn-remote.$g->{remote}." .
432
+ "$g->{t}-maxRev";
433
+ Git::SVN::tmp_config($k, $r);
434
+ }
435
+ if ($ra_invalid) {
436
+ $_[0] = undef;
437
+ $self = undef;
438
+ $RA = undef;
439
+ $self = Git::SVN::Ra->new($ra_url);
440
+ $ra_invalid = undef;
441
+ }
442
+ }
443
+ # pre-fill the .rev_db since it'll eventually get filled in
444
+ # with '0' x40 if something new gets committed
445
+ foreach my $gs (@$gsv) {
446
+ next if $gs->rev_map_max >= $max;
447
+ next if defined $gs->rev_map_get($max);
448
+ $gs->rev_map_set($max, 0 x40);
449
+ }
450
+ foreach my $g (@$globs) {
451
+ my $k = "svn-remote.$g->{remote}.$g->{t}-maxRev";
452
+ Git::SVN::tmp_config($k, $max);
453
+ }
454
+ last if $max >= $head;
455
+ $min = $max + 1;
456
+ $max += $inc;
457
+ $max = $head if ($max > $head);
458
+ }
459
+ Git::SVN::gc();
460
+}
461
+
462
+sub get_dir_globbed {
463
+ my ($self, $left, $depth, $r) = @_;
464
+
465
+ my @x = eval { $self->get_dir($left, $r) };
466
+ return unless scalar @x == 3;
467
+ my $dirents = $x[0];
468
+ my @finalents;
469
+ foreach my $de (keys %$dirents) {
470
+ next if $dirents->{$de}->{kind} != $SVN::Node::dir;
471
+ if ($depth > 1) {
472
+ my @args = ("$left/$de", $depth - 1, $r);
473
+ foreach my $dir ($self->get_dir_globbed(@args)) {
474
+ push @finalents, "$de/$dir";
475
+ }
476
+ } else {
477
+ push @finalents, $de;
478
+ }
479
+ }
480
+ @finalents;
481
+}
482
+
483
+# return value: 0 -- don't ignore, 1 -- ignore
484
+sub is_ref_ignored {
485
+ my ($g, $p) = @_;
486
+ my $refname = $g->{ref}->full_path($p);
487
+ return 1 if defined($g->{ignore_refs_regex}) &&
488
+ $refname =~ m!$g->{ignore_refs_regex}!;
489
+ return 0 unless defined($_ignore_refs_regex);
490
+ return 1 if $refname =~ m!$_ignore_refs_regex!o;
491
+ return 0;
492
+}
493
+
494
+sub match_globs {
495
+ my ($self, $exists, $paths, $globs, $r) = @_;
496
+
497
+ sub get_dir_check {
498
+ my ($self, $exists, $g, $r) = @_;
499
+
500
+ my @dirs = $self->get_dir_globbed($g->{path}->{left},
501
+ $g->{path}->{depth},
502
+ $r);
503
+
504
+ foreach my $de (@dirs) {
505
+ my $p = $g->{path}->full_path($de);
506
+ next if $exists->{$p};
507
+ next if (length $g->{path}->{right} &&
508
+ ($self->check_path($p, $r) !=
509
+ $SVN::Node::dir));
510
+ next unless $p =~ /$g->{path}->{regex}/;
511
+ $exists->{$p} = Git::SVN->init($self->{url}, $p, undef,
512
+ $g->{ref}->full_path($de), 1);
513
+ }
514
+ }
515
+ foreach my $g (@$globs) {
516
+ if (my $path = $paths->{"/$g->{path}->{left}"}) {
517
+ if ($path->{action} =~ /^[AR]$/) {
518
+ get_dir_check($self, $exists, $g, $r);
519
+ }
520
+ }
521
+ foreach (keys %$paths) {
522
+ if (/$g->{path}->{left_regex}/ &&
523
+ !/$g->{path}->{regex}/) {
524
+ next if $paths->{$_}->{action} !~ /^[AR]$/;
525
+ get_dir_check($self, $exists, $g, $r);
526
+ }
527
+ next unless /$g->{path}->{regex}/;
528
+ my $p = $1;
529
+ my $pathname = $g->{path}->full_path($p);
530
+ next if is_ref_ignored($g, $p);
531
+ next if $exists->{$pathname};
532
+ next if ($self->check_path($pathname, $r) !=
533
+ $SVN::Node::dir);
534
+ $exists->{$pathname} = Git::SVN->init(
535
+ $self->{url}, $pathname, undef,
536
+ $g->{ref}->full_path($p), 1);
537
+ }
538
+ my $c = '';
539
+ foreach (split m#/#, $g->{path}->{left}) {
540
+ $c .= "/$_";
541
+ next unless ($paths->{$c} &&
542
+ ($paths->{$c}->{action} =~ /^[AR]$/));
543
+ get_dir_check($self, $exists, $g, $r);
544
+ }
545
+ }
546
+ values %$exists;
547
+}
548
+
549
+sub minimize_url {
550
+ my ($self) = @_;
551
+ return $self->{url} if ($self->{url} eq $self->{repos_root});
552
+ my $url = $self->{repos_root};
553
+ my @components = split(m!/!, $self->{svn_path});
554
+ my $c = '';
555
+ do {
556
+ $url .= "/$c" if length $c;
557
+ eval {
558
+ my $ra = (ref $self)->new($url);
559
+ my $latest = $ra->get_latest_revnum;
560
+ $ra->get_log("", $latest, 0, 1, 0, 1, sub {});
561
+ };
562
+ } while ($@ && ($c = shift @components));
563
+ $url;
564
+}
565
+
566
+sub can_do_switch {
567
+ my $self = shift;
568
+ unless (defined $can_do_switch) {
569
+ my $pool = SVN::Pool->new;
570
+ my $rep = eval {
571
+ $self->do_switch(1, '', 0, $self->{url},
572
+ SVN::Delta::Editor->new, $pool);
573
+ };
574
+ if ($@) {
575
+ $can_do_switch = 0;
576
+ } else {
577
+ $rep->abort_report($pool);
578
+ $can_do_switch = 1;
579
+ }
580
+ $pool->clear;
581
+ }
582
+ $can_do_switch;
583
+}
584
+
585
+sub skip_unknown_revs {
586
+ my ($err) = @_;
587
+ my $errno = $err->apr_err();
588
+ # Maybe the branch we're tracking didn't
589
+ # exist when the repo started, so it's
590
+ # not an error if it doesn't, just continue
591
+ #
592
+ # Wonderfully consistent library, eh?
593
+ # 160013 - svn:// and file://
594
+ # 175002 - http(s)://
595
+ # 175007 - http(s):// (this repo required authorization, too...)
596
+ # More codes may be discovered later...
597
+ if ($errno == 175007 || $errno == 175002 || $errno == 160013) {
598
+ my $err_key = $err->expanded_message;
599
+ # revision numbers change every time, filter them out
600
+ $err_key =~ s/\d+/\0/g;
601
+ $err_key = "$errno\0$err_key";
602
+ unless ($ignored_err{$err_key}) {
603
+ warn "W: Ignoring error from SVN, path probably ",
604
+ "does not exist: ($errno): ",
605
+ $err->expanded_message,"\n";
606
+ warn "W: Do not be alarmed at the above message ",
607
+ "git-svn is just searching aggressively for ",
608
+ "old history.\n",
609
+ "This may take a while on large repositories\n";
610
+ $ignored_err{$err_key} = 1;
611
+ }
612
+ return;
613
+ }
614
+ die "Error from SVN, ($errno): ", $err->expanded_message,"\n";
615
+}
616
+
617
+1;
618
+__END__
619
+
620
+Git::SVN::Ra - Subversion remote access functions for git-svn
621
+
622
+=head1 SYNOPSIS
623
+
624
+ use Git::SVN::Ra;
625
+
626
+ my $ra = Git::SVN::Ra->new($branchurl);
627
+ my ($dirents, $fetched_revnum, $props) =
628
+ $ra->get_dir('.', $SVN::Core::INVALID_REVNUM);
629
+
630
+=head1 DESCRIPTION
631
+
632
+This is a wrapper around the L<SVN::Ra> module for use by B<git-svn>.
633
+It fills in some default parameters (such as the authentication
634
+scheme), smooths over incompatibilities between libsvn versions, adds
635
+caching, and implements some functions specific to B<git-svn>.
636
+
637
+Do not use it unless you are developing git-svn. The interface will
638
+change as git-svn evolves.
639
+
640
+=head1 DEPENDENCIES
641
+
642
+Subversion perl bindings,
643
+L<Git::SVN>.
644
+
645
+C<Git::SVN::Ra> has not been tested using callers other than
646
+B<git-svn> itself.
647
+
648
+=head1 SEE ALSO
649
+
650
+L<SVN::Ra>.
651
+
652
+=head1 INCOMPATIBILITIES
653
+
654
+None reported.
655
+
656
+=head1 BUGS
657
+
658
+None.
perl/Makefile.PL
+1
@@ -30,6 +30,7 @@ my %pm = (
30
'Git/SVN/Fetcher.pm' => '$(INST_LIBDIR)/Git/SVN/Fetcher.pm',
31
'Git/SVN/Editor.pm' => '$(INST_LIBDIR)/Git/SVN/Editor.pm',
32
'Git/SVN/Prompt.pm' => '$(INST_LIBDIR)/Git/SVN/Prompt.pm',
33
+ 'Git/SVN/Ra.pm' => '$(INST_LIBDIR)/Git/SVN/Ra.pm',
34
);
35
36
# We come with our own bundled Error.pm. It's not in the set of default