diff options
author | Michael G. Schwern <schwern@pobox.com> | 2012-07-26 16:22:24 -0700 |
---|---|---|
committer | Eric Wong <normalperson@yhbt.net> | 2012-07-27 22:14:53 +0000 |
commit | 29499c0b2741cc2ea13b78a342048bad928dfe2a (patch) | |
tree | 0224e87fdefbc2a48392e994e5e7d430d5f97b6b /perl | |
parent | Prepare Git::SVN for extraction into its own file. (diff) | |
download | tgif-29499c0b2741cc2ea13b78a342048bad928dfe2a.tar.xz |
Extract Git::SVN from git-svn into its own .pm file.
Except for adding the 1; at the end, this is a straight copy & paste.
Tests still pass, but its doubtful Git::SVN will compile on its own
without git-svn being loaded. Next commit will fix that.
Signed-off-by: Junio C Hamano <gitster@pobox.com>
Signed-off-by: Eric Wong <normalperson@yhbt.net>
Diffstat (limited to 'perl')
-rw-r--r-- | perl/Git/SVN.pm | 2319 | ||||
-rw-r--r-- | perl/Makefile | 1 |
2 files changed, 2320 insertions, 0 deletions
diff --git a/perl/Git/SVN.pm b/perl/Git/SVN.pm new file mode 100644 index 0000000000..c71c041986 --- /dev/null +++ b/perl/Git/SVN.pm @@ -0,0 +1,2319 @@ +package Git::SVN; +use strict; +use warnings; +use Fcntl qw/:DEFAULT :seek/; +use constant rev_map_fmt => 'NH40'; +use vars qw/$default_repo_id $default_ref_id $_no_metadata $_follow_parent + $_repack $_repack_flags $_use_svm_props $_head + $_use_svnsync_props $no_reuse_existing $_minimize_url + $_use_log_author $_add_author_from $_localtime/; +use Carp qw/croak/; +use File::Path qw/mkpath/; +use File::Copy qw/copy/; +use IPC::Open3; +use Time::Local; +use Memoize; # core since 5.8.0, Jul 2002 +use Memoize::Storable; +use POSIX qw(:signal_h); + +use Git qw( + command + command_oneline + command_noisy + command_output_pipe + command_close_pipe +); +use Git::SVN::Utils qw(fatal can_compress); + +my $can_use_yaml; +BEGIN { + $can_use_yaml = eval { require Git::SVN::Memoize::YAML; 1}; +} + +my ($_gc_nr, $_gc_period); + +# properties that we do not log: +my %SKIP_PROP; +BEGIN { + %SKIP_PROP = map { $_ => 1 } qw/svn:wc:ra_dav:version-url + svn:special svn:executable + svn:entry:committed-rev + svn:entry:last-author + svn:entry:uuid + svn:entry:committed-date/; + + # some options are read globally, but can be overridden locally + # per [svn-remote "..."] section. Command-line options will *NOT* + # override options set in an [svn-remote "..."] section + no strict 'refs'; + for my $option (qw/follow_parent no_metadata use_svm_props + use_svnsync_props/) { + my $key = $option; + $key =~ tr/_//d; + my $prop = "-$option"; + *$option = sub { + my ($self) = @_; + return $self->{$prop} if exists $self->{$prop}; + my $k = "svn-remote.$self->{repo_id}.$key"; + eval { command_oneline(qw/config --get/, $k) }; + if ($@) { + $self->{$prop} = ${"Git::SVN::_$option"}; + } else { + my $v = command_oneline(qw/config --bool/,$k); + $self->{$prop} = $v eq 'false' ? 0 : 1; + } + return $self->{$prop}; + } + } +} + + +my (%LOCKFILES, %INDEX_FILES); +END { + unlink keys %LOCKFILES if %LOCKFILES; + unlink keys %INDEX_FILES if %INDEX_FILES; +} + +sub resolve_local_globs { + my ($url, $fetch, $glob_spec) = @_; + return unless defined $glob_spec; + my $ref = $glob_spec->{ref}; + my $path = $glob_spec->{path}; + foreach (command(qw#for-each-ref --format=%(refname) refs/#)) { + next unless m#^$ref->{regex}$#; + my $p = $1; + my $pathname = desanitize_refname($path->full_path($p)); + my $refname = desanitize_refname($ref->full_path($p)); + if (my $existing = $fetch->{$pathname}) { + if ($existing ne $refname) { + die "Refspec conflict:\n", + "existing: $existing\n", + " globbed: $refname\n"; + } + my $u = (::cmt_metadata("$refname"))[0]; + $u =~ s!^\Q$url\E(/|$)!! or die + "$refname: '$url' not found in '$u'\n"; + if ($pathname ne $u) { + warn "W: Refspec glob conflict ", + "(ref: $refname):\n", + "expected path: $pathname\n", + " real path: $u\n", + "Continuing ahead with $u\n"; + next; + } + } else { + $fetch->{$pathname} = $refname; + } + } +} + +sub parse_revision_argument { + my ($base, $head) = @_; + if (!defined $::_revision || $::_revision eq 'BASE:HEAD') { + return ($base, $head); + } + return ($1, $2) if ($::_revision =~ /^(\d+):(\d+)$/); + return ($::_revision, $::_revision) if ($::_revision =~ /^\d+$/); + return ($head, $head) if ($::_revision eq 'HEAD'); + return ($base, $1) if ($::_revision =~ /^BASE:(\d+)$/); + return ($1, $head) if ($::_revision =~ /^(\d+):HEAD$/); + die "revision argument: $::_revision not understood by git-svn\n"; +} + +sub fetch_all { + my ($repo_id, $remotes) = @_; + if (ref $repo_id) { + my $gs = $repo_id; + $repo_id = undef; + $repo_id = $gs->{repo_id}; + } + $remotes ||= read_all_remotes(); + my $remote = $remotes->{$repo_id} or + die "[svn-remote \"$repo_id\"] unknown\n"; + my $fetch = $remote->{fetch}; + my $url = $remote->{url} or die "svn-remote.$repo_id.url not defined\n"; + my (@gs, @globs); + my $ra = Git::SVN::Ra->new($url); + my $uuid = $ra->get_uuid; + my $head = $ra->get_latest_revnum; + + # ignore errors, $head revision may not even exist anymore + eval { $ra->get_log("", $head, 0, 1, 0, 1, sub { $head = $_[1] }) }; + warn "W: $@\n" if $@; + + my $base = defined $fetch ? $head : 0; + + # read the max revs for wildcard expansion (branches/*, tags/*) + foreach my $t (qw/branches tags/) { + defined $remote->{$t} or next; + push @globs, @{$remote->{$t}}; + + my $max_rev = eval { tmp_config(qw/--int --get/, + "svn-remote.$repo_id.${t}-maxRev") }; + if (defined $max_rev && ($max_rev < $base)) { + $base = $max_rev; + } elsif (!defined $max_rev) { + $base = 0; + } + } + + if ($fetch) { + foreach my $p (sort keys %$fetch) { + my $gs = Git::SVN->new($fetch->{$p}, $repo_id, $p); + my $lr = $gs->rev_map_max; + if (defined $lr) { + $base = $lr if ($lr < $base); + } + push @gs, $gs; + } + } + + ($base, $head) = parse_revision_argument($base, $head); + $ra->gs_fetch_loop_common($base, $head, \@gs, \@globs); +} + +sub read_all_remotes { + my $r = {}; + my $use_svm_props = eval { command_oneline(qw/config --bool + svn.useSvmProps/) }; + $use_svm_props = $use_svm_props eq 'true' if $use_svm_props; + my $svn_refspec = qr{\s*(.*?)\s*:\s*(.+?)\s*}; + foreach (grep { s/^svn-remote\.// } command(qw/config -l/)) { + if (m!^(.+)\.fetch=$svn_refspec$!) { + my ($remote, $local_ref, $remote_ref) = ($1, $2, $3); + die("svn-remote.$remote: remote ref '$remote_ref' " + . "must start with 'refs/'\n") + unless $remote_ref =~ m{^refs/}; + $local_ref = uri_decode($local_ref); + $r->{$remote}->{fetch}->{$local_ref} = $remote_ref; + $r->{$remote}->{svm} = {} if $use_svm_props; + } elsif (m!^(.+)\.usesvmprops=\s*(.*)\s*$!) { + $r->{$1}->{svm} = {}; + } elsif (m!^(.+)\.url=\s*(.*)\s*$!) { + $r->{$1}->{url} = $2; + } elsif (m!^(.+)\.pushurl=\s*(.*)\s*$!) { + $r->{$1}->{pushurl} = $2; + } elsif (m!^(.+)\.ignore-refs=\s*(.*)\s*$!) { + $r->{$1}->{ignore_refs_regex} = $2; + } elsif (m!^(.+)\.(branches|tags)=$svn_refspec$!) { + my ($remote, $t, $local_ref, $remote_ref) = + ($1, $2, $3, $4); + die("svn-remote.$remote: remote ref '$remote_ref' ($t) " + . "must start with 'refs/'\n") + unless $remote_ref =~ m{^refs/}; + $local_ref = uri_decode($local_ref); + my $rs = { + t => $t, + remote => $remote, + path => Git::SVN::GlobSpec->new($local_ref, 1), + ref => Git::SVN::GlobSpec->new($remote_ref, 0) }; + if (length($rs->{ref}->{right}) != 0) { + die "The '*' glob character must be the last ", + "character of '$remote_ref'\n"; + } + push @{ $r->{$remote}->{$t} }, $rs; + } + } + + map { + if (defined $r->{$_}->{svm}) { + my $svm; + eval { + my $section = "svn-remote.$_"; + $svm = { + source => tmp_config('--get', + "$section.svm-source"), + replace => tmp_config('--get', + "$section.svm-replace"), + } + }; + $r->{$_}->{svm} = $svm; + } + } keys %$r; + + foreach my $remote (keys %$r) { + foreach ( grep { defined $_ } + map { $r->{$remote}->{$_} } qw(branches tags) ) { + foreach my $rs ( @$_ ) { + $rs->{ignore_refs_regex} = + $r->{$remote}->{ignore_refs_regex}; + } + } + } + + $r; +} + +sub init_vars { + $_gc_nr = $_gc_period = 1000; + if (defined $_repack || defined $_repack_flags) { + warn "Repack options are obsolete; they have no effect.\n"; + } +} + +sub verify_remotes_sanity { + return unless -d $ENV{GIT_DIR}; + my %seen; + foreach (command(qw/config -l/)) { + if (m!^svn-remote\.(?:.+)\.fetch=.*:refs/remotes/(\S+)\s*$!) { + if ($seen{$1}) { + die "Remote ref refs/remote/$1 is tracked by", + "\n \"$_\"\nand\n \"$seen{$1}\"\n", + "Please resolve this ambiguity in ", + "your git configuration file before ", + "continuing\n"; + } + $seen{$1} = $_; + } + } +} + +sub find_existing_remote { + my ($url, $remotes) = @_; + return undef if $no_reuse_existing; + my $existing; + foreach my $repo_id (keys %$remotes) { + my $u = $remotes->{$repo_id}->{url} or next; + next if $u ne $url; + $existing = $repo_id; + last; + } + $existing; +} + +sub init_remote_config { + my ($self, $url, $no_write) = @_; + $url =~ s!/+$!!; # strip trailing slash + my $r = read_all_remotes(); + my $existing = find_existing_remote($url, $r); + if ($existing) { + unless ($no_write) { + print STDERR "Using existing ", + "[svn-remote \"$existing\"]\n"; + } + $self->{repo_id} = $existing; + } elsif ($_minimize_url) { + my $min_url = Git::SVN::Ra->new($url)->minimize_url; + $existing = find_existing_remote($min_url, $r); + if ($existing) { + unless ($no_write) { + print STDERR "Using existing ", + "[svn-remote \"$existing\"]\n"; + } + $self->{repo_id} = $existing; + } + if ($min_url ne $url) { + unless ($no_write) { + print STDERR "Using higher level of URL: ", + "$url => $min_url\n"; + } + my $old_path = $self->{path}; + $self->{path} = $url; + $self->{path} =~ s!^\Q$min_url\E(/|$)!!; + if (length $old_path) { + $self->{path} .= "/$old_path"; + } + $url = $min_url; + } + } + my $orig_url; + if (!$existing) { + # verify that we aren't overwriting anything: + $orig_url = eval { + command_oneline('config', '--get', + "svn-remote.$self->{repo_id}.url") + }; + if ($orig_url && ($orig_url ne $url)) { + die "svn-remote.$self->{repo_id}.url already set: ", + "$orig_url\nwanted to set to: $url\n"; + } + } + my ($xrepo_id, $xpath) = find_ref($self->refname); + if (!$no_write && defined $xpath) { + die "svn-remote.$xrepo_id.fetch already set to track ", + "$xpath:", $self->refname, "\n"; + } + unless ($no_write) { + command_noisy('config', + "svn-remote.$self->{repo_id}.url", $url); + $self->{path} =~ s{^/}{}; + $self->{path} =~ s{%([0-9A-F]{2})}{chr hex($1)}ieg; + command_noisy('config', '--add', + "svn-remote.$self->{repo_id}.fetch", + "$self->{path}:".$self->refname); + } + $self->{url} = $url; +} + +sub find_by_url { # repos_root and, path are optional + my ($class, $full_url, $repos_root, $path) = @_; + + return undef unless defined $full_url; + remove_username($full_url); + remove_username($repos_root) if defined $repos_root; + my $remotes = read_all_remotes(); + if (defined $full_url && defined $repos_root && !defined $path) { + $path = $full_url; + $path =~ s#^\Q$repos_root\E(?:/|$)##; + } + foreach my $repo_id (keys %$remotes) { + my $u = $remotes->{$repo_id}->{url} or next; + remove_username($u); + next if defined $repos_root && $repos_root ne $u; + + my $fetch = $remotes->{$repo_id}->{fetch} || {}; + foreach my $t (qw/branches tags/) { + foreach my $globspec (@{$remotes->{$repo_id}->{$t}}) { + resolve_local_globs($u, $fetch, $globspec); + } + } + my $p = $path; + my $rwr = rewrite_root({repo_id => $repo_id}); + my $svm = $remotes->{$repo_id}->{svm} + if defined $remotes->{$repo_id}->{svm}; + unless (defined $p) { + $p = $full_url; + my $z = $u; + my $prefix = ''; + if ($rwr) { + $z = $rwr; + remove_username($z); + } elsif (defined $svm) { + $z = $svm->{source}; + $prefix = $svm->{replace}; + $prefix =~ s#^\Q$u\E(?:/|$)##; + $prefix =~ s#/$##; + } + $p =~ s#^\Q$z\E(?:/|$)#$prefix# or next; + } + foreach my $f (keys %$fetch) { + next if $f ne $p; + return Git::SVN->new($fetch->{$f}, $repo_id, $f); + } + } + undef; +} + +sub init { + my ($class, $url, $path, $repo_id, $ref_id, $no_write) = @_; + my $self = _new($class, $repo_id, $ref_id, $path); + if (defined $url) { + $self->init_remote_config($url, $no_write); + } + $self; +} + +sub find_ref { + my ($ref_id) = @_; + foreach (command(qw/config -l/)) { + next unless m!^svn-remote\.(.+)\.fetch= + \s*(.*?)\s*:\s*(.+?)\s*$!x; + my ($repo_id, $path, $ref) = ($1, $2, $3); + if ($ref eq $ref_id) { + $path = '' if ($path =~ m#^\./?#); + return ($repo_id, $path); + } + } + (undef, undef, undef); +} + +sub new { + my ($class, $ref_id, $repo_id, $path) = @_; + if (defined $ref_id && !defined $repo_id && !defined $path) { + ($repo_id, $path) = find_ref($ref_id); + if (!defined $repo_id) { + die "Could not find a \"svn-remote.*.fetch\" key ", + "in the repository configuration matching: ", + "$ref_id\n"; + } + } + my $self = _new($class, $repo_id, $ref_id, $path); + if (!defined $self->{path} || !length $self->{path}) { + my $fetch = command_oneline('config', '--get', + "svn-remote.$repo_id.fetch", + ":$ref_id\$") or + die "Failed to read \"svn-remote.$repo_id.fetch\" ", + "\":$ref_id\$\" in config\n"; + ($self->{path}, undef) = split(/\s*:\s*/, $fetch); + } + $self->{path} =~ s{/+}{/}g; + $self->{path} =~ s{\A/}{}; + $self->{path} =~ s{/\z}{}; + $self->{url} = command_oneline('config', '--get', + "svn-remote.$repo_id.url") or + die "Failed to read \"svn-remote.$repo_id.url\" in config\n"; + $self->{pushurl} = eval { command_oneline('config', '--get', + "svn-remote.$repo_id.pushurl") }; + $self->rebuild; + $self; +} + +sub refname { + my ($refname) = $_[0]->{ref_id} ; + + # It cannot end with a slash /, we'll throw up on this because + # SVN can't have directories with a slash in their name, either: + if ($refname =~ m{/$}) { + die "ref: '$refname' ends with a trailing slash, this is ", + "not permitted by git nor Subversion\n"; + } + + # It cannot have ASCII control character space, tilde ~, caret ^, + # colon :, question-mark ?, asterisk *, space, or open bracket [ + # anywhere. + # + # Additionally, % must be escaped because it is used for escaping + # and we want our escaped refname to be reversible + $refname =~ s{([ \%~\^:\?\*\[\t])}{uc sprintf('%%%02x',ord($1))}eg; + + # no slash-separated component can begin with a dot . + # /.* becomes /%2E* + $refname =~ s{/\.}{/%2E}g; + + # It cannot have two consecutive dots .. anywhere + # .. becomes %2E%2E + $refname =~ s{\.\.}{%2E%2E}g; + + # trailing dots and .lock are not allowed + # .$ becomes %2E and .lock becomes %2Elock + $refname =~ s{\.(?=$|lock$)}{%2E}; + + # the sequence @{ is used to access the reflog + # @{ becomes %40{ + $refname =~ s{\@\{}{%40\{}g; + + return $refname; +} + +sub desanitize_refname { + my ($refname) = @_; + $refname =~ s{%(?:([0-9A-F]{2}))}{chr hex($1)}eg; + return $refname; +} + +sub svm_uuid { + my ($self) = @_; + return $self->{svm}->{uuid} if $self->svm; + $self->ra; + unless ($self->{svm}) { + die "SVM UUID not cached, and reading remotely failed\n"; + } + $self->{svm}->{uuid}; +} + +sub svm { + my ($self) = @_; + return $self->{svm} if $self->{svm}; + my $svm; + # see if we have it in our config, first: + eval { + my $section = "svn-remote.$self->{repo_id}"; + $svm = { + source => tmp_config('--get', "$section.svm-source"), + uuid => tmp_config('--get', "$section.svm-uuid"), + replace => tmp_config('--get', "$section.svm-replace"), + } + }; + if ($svm && $svm->{source} && $svm->{uuid} && $svm->{replace}) { + $self->{svm} = $svm; + } + $self->{svm}; +} + +sub _set_svm_vars { + my ($self, $ra) = @_; + return $ra if $self->svm; + + my @err = ( "useSvmProps set, but failed to read SVM properties\n", + "(svm:source, svm:uuid) ", + "from the following URLs:\n" ); + sub read_svm_props { + my ($self, $ra, $path, $r) = @_; + my $props = ($ra->get_dir($path, $r))[2]; + my $src = $props->{'svm:source'}; + my $uuid = $props->{'svm:uuid'}; + return undef if (!$src || !$uuid); + + chomp($src, $uuid); + + $uuid =~ m{^[0-9a-f\-]{30,}$}i + or die "doesn't look right - svm:uuid is '$uuid'\n"; + + # the '!' is used to mark the repos_root!/relative/path + $src =~ s{/?!/?}{/}; + $src =~ s{/+$}{}; # no trailing slashes please + # username is of no interest + $src =~ s{(^[a-z\+]*://)[^/@]*@}{$1}; + + my $replace = $ra->{url}; + $replace .= "/$path" if length $path; + + my $section = "svn-remote.$self->{repo_id}"; + tmp_config("$section.svm-source", $src); + tmp_config("$section.svm-replace", $replace); + tmp_config("$section.svm-uuid", $uuid); + $self->{svm} = { + source => $src, + uuid => $uuid, + replace => $replace + }; + } + + my $r = $ra->get_latest_revnum; + my $path = $self->{path}; + my %tried; + while (length $path) { + unless ($tried{"$self->{url}/$path"}) { + return $ra if $self->read_svm_props($ra, $path, $r); + $tried{"$self->{url}/$path"} = 1; + } + $path =~ s#/?[^/]+$##; + } + die "Path: '$path' should be ''\n" if $path ne ''; + return $ra if $self->read_svm_props($ra, $path, $r); + $tried{"$self->{url}/$path"} = 1; + + if ($ra->{repos_root} eq $self->{url}) { + die @err, (map { " $_\n" } keys %tried), "\n"; + } + + # nope, make sure we're connected to the repository root: + my $ok; + my @tried_b; + $path = $ra->{svn_path}; + $ra = Git::SVN::Ra->new($ra->{repos_root}); + while (length $path) { + unless ($tried{"$ra->{url}/$path"}) { + $ok = $self->read_svm_props($ra, $path, $r); + last if $ok; + $tried{"$ra->{url}/$path"} = 1; + } + $path =~ s#/?[^/]+$##; + } + die "Path: '$path' should be ''\n" if $path ne ''; + $ok ||= $self->read_svm_props($ra, $path, $r); + $tried{"$ra->{url}/$path"} = 1; + if (!$ok) { + die @err, (map { " $_\n" } keys %tried), "\n"; + } + Git::SVN::Ra->new($self->{url}); +} + +sub svnsync { + my ($self) = @_; + return $self->{svnsync} if $self->{svnsync}; + + if ($self->no_metadata) { + die "Can't have both 'noMetadata' and ", + "'useSvnsyncProps' options set!\n"; + } + if ($self->rewrite_root) { + die "Can't have both 'useSvnsyncProps' and 'rewriteRoot' ", + "options set!\n"; + } + if ($self->rewrite_uuid) { + die "Can't have both 'useSvnsyncProps' and 'rewriteUUID' ", + "options set!\n"; + } + + my $svnsync; + # see if we have it in our config, first: + eval { + my $section = "svn-remote.$self->{repo_id}"; + + my $url = tmp_config('--get', "$section.svnsync-url"); + ($url) = ($url =~ m{^([a-z\+]+://\S+)$}) or + die "doesn't look right - svn:sync-from-url is '$url'\n"; + + my $uuid = tmp_config('--get', "$section.svnsync-uuid"); + ($uuid) = ($uuid =~ m{^([0-9a-f\-]{30,})$}i) or + die "doesn't look right - svn:sync-from-uuid is '$uuid'\n"; + + $svnsync = { url => $url, uuid => $uuid } + }; + if ($svnsync && $svnsync->{url} && $svnsync->{uuid}) { + return $self->{svnsync} = $svnsync; + } + + my $err = "useSvnsyncProps set, but failed to read " . + "svnsync property: svn:sync-from-"; + my $rp = $self->ra->rev_proplist(0); + + my $url = $rp->{'svn:sync-from-url'} or die $err . "url\n"; + ($url) = ($url =~ m{^([a-z\+]+://\S+)$}) or + die "doesn't look right - svn:sync-from-url is '$url'\n"; + + my $uuid = $rp->{'svn:sync-from-uuid'} or die $err . "uuid\n"; + ($uuid) = ($uuid =~ m{^([0-9a-f\-]{30,})$}i) or + die "doesn't look right - svn:sync-from-uuid is '$uuid'\n"; + + my $section = "svn-remote.$self->{repo_id}"; + tmp_config('--add', "$section.svnsync-uuid", $uuid); + tmp_config('--add', "$section.svnsync-url", $url); + return $self->{svnsync} = { url => $url, uuid => $uuid }; +} + +# this allows us to memoize our SVN::Ra UUID locally and avoid a +# remote lookup (useful for 'git svn log'). +sub ra_uuid { + my ($self) = @_; + unless ($self->{ra_uuid}) { + my $key = "svn-remote.$self->{repo_id}.uuid"; + my $uuid = eval { tmp_config('--get', $key) }; + if (!$@ && $uuid && $uuid =~ /^([a-f\d\-]{30,})$/i) { + $self->{ra_uuid} = $uuid; + } else { + die "ra_uuid called without URL\n" unless $self->{url}; + $self->{ra_uuid} = $self->ra->get_uuid; + tmp_config('--add', $key, $self->{ra_uuid}); + } + } + $self->{ra_uuid}; +} + +sub _set_repos_root { + my ($self, $repos_root) = @_; + my $k = "svn-remote.$self->{repo_id}.reposRoot"; + $repos_root ||= $self->ra->{repos_root}; + tmp_config($k, $repos_root); + $repos_root; +} + +sub repos_root { + my ($self) = @_; + my $k = "svn-remote.$self->{repo_id}.reposRoot"; + eval { tmp_config('--get', $k) } || $self->_set_repos_root; +} + +sub ra { + my ($self) = shift; + my $ra = Git::SVN::Ra->new($self->{url}); + $self->_set_repos_root($ra->{repos_root}); + if ($self->use_svm_props && !$self->{svm}) { + if ($self->no_metadata) { + die "Can't have both 'noMetadata' and ", + "'useSvmProps' options set!\n"; + } elsif ($self->use_svnsync_props) { + die "Can't have both 'useSvnsyncProps' and ", + "'useSvmProps' options set!\n"; + } + $ra = $self->_set_svm_vars($ra); + $self->{-want_revprops} = 1; + } + $ra; +} + +# prop_walk(PATH, REV, SUB) +# ------------------------- +# Recursively traverse PATH at revision REV and invoke SUB for each +# directory that contains a SVN property. SUB will be invoked as +# follows: &SUB(gs, path, props); where `gs' is this instance of +# Git::SVN, `path' the path to the directory where the properties +# `props' were found. The `path' will be relative to point of checkout, +# that is, if url://repo/trunk is the current Git branch, and that +# directory contains a sub-directory `d', SUB will be invoked with `/d/' +# as `path' (note the trailing `/'). +sub prop_walk { + my ($self, $path, $rev, $sub) = @_; + + $path =~ s#^/##; + my ($dirent, undef, $props) = $self->ra->get_dir($path, $rev); + $path =~ s#^/*#/#g; + my $p = $path; + # Strip the irrelevant part of the path. + $p =~ s#^/+\Q$self->{path}\E(/|$)#/#; + # Ensure the path is terminated by a `/'. + $p =~ s#/*$#/#; + + # The properties contain all the internal SVN stuff nobody + # (usually) cares about. + my $interesting_props = 0; + foreach (keys %{$props}) { + # If it doesn't start with `svn:', it must be a + # user-defined property. + ++$interesting_props and next if $_ !~ /^svn:/; + # FIXME: Fragile, if SVN adds new public properties, + # this needs to be updated. + ++$interesting_props if /^svn:(?:ignore|keywords|executable + |eol-style|mime-type + |externals|needs-lock)$/x; + } + &$sub($self, $p, $props) if $interesting_props; + + foreach (sort keys %$dirent) { + next if $dirent->{$_}->{kind} != $SVN::Node::dir; + $self->prop_walk($self->{path} . $p . $_, $rev, $sub); + } +} + +sub last_rev { ($_[0]->last_rev_commit)[0] } +sub last_commit { ($_[0]->last_rev_commit)[1] } + +# returns the newest SVN revision number and newest commit SHA1 +sub last_rev_commit { + my ($self) = @_; + if (defined $self->{last_rev} && defined $self->{last_commit}) { + return ($self->{last_rev}, $self->{last_commit}); + } + my $c = ::verify_ref($self->refname.'^0'); + if ($c && !$self->use_svm_props && !$self->no_metadata) { + my $rev = (::cmt_metadata($c))[1]; + if (defined $rev) { + ($self->{last_rev}, $self->{last_commit}) = ($rev, $c); + return ($rev, $c); + } + } + my $map_path = $self->map_path; + unless (-e $map_path) { + ($self->{last_rev}, $self->{last_commit}) = (undef, undef); + return (undef, undef); + } + my ($rev, $commit) = $self->rev_map_max(1); + ($self->{last_rev}, $self->{last_commit}) = ($rev, $commit); + return ($rev, $commit); +} + +sub get_fetch_range { + my ($self, $min, $max) = @_; + $max ||= $self->ra->get_latest_revnum; + $min ||= $self->rev_map_max; + (++$min, $max); +} + +sub tmp_config { + my (@args) = @_; + my $old_def_config = "$ENV{GIT_DIR}/svn/config"; + my $config = "$ENV{GIT_DIR}/svn/.metadata"; + if (! -f $config && -f $old_def_config) { + rename $old_def_config, $config or + die "Failed rename $old_def_config => $config: $!\n"; + } + my $old_config = $ENV{GIT_CONFIG}; + $ENV{GIT_CONFIG} = $config; + $@ = undef; + my @ret = eval { + unless (-f $config) { + mkfile($config); + open my $fh, '>', $config or + die "Can't open $config: $!\n"; + print $fh "; This file is used internally by ", + "git-svn\n" or die + "Couldn't write to $config: $!\n"; + print $fh "; You should not have to edit it\n" or + die "Couldn't write to $config: $!\n"; + close $fh or die "Couldn't close $config: $!\n"; + } + command('config', @args); + }; + my $err = $@; + if (defined $old_config) { + $ENV{GIT_CONFIG} = $old_config; + } else { + delete $ENV{GIT_CONFIG}; + } + die $err if $err; + wantarray ? @ret : $ret[0]; +} + +sub tmp_index_do { + my ($self, $sub) = @_; + my $old_index = $ENV{GIT_INDEX_FILE}; + $ENV{GIT_INDEX_FILE} = $self->{index}; + $@ = undef; + my @ret = eval { + my ($dir, $base) = ($self->{index} =~ m#^(.*?)/?([^/]+)$#); + mkpath([$dir]) unless -d $dir; + &$sub; + }; + my $err = $@; + if (defined $old_index) { + $ENV{GIT_INDEX_FILE} = $old_index; + } else { + delete $ENV{GIT_INDEX_FILE}; + } + die $err if $err; + wantarray ? @ret : $ret[0]; +} + +sub assert_index_clean { + my ($self, $treeish) = @_; + + $self->tmp_index_do(sub { + command_noisy('read-tree', $treeish) unless -e $self->{index}; + my $x = command_oneline('write-tree'); + my ($y) = (command(qw/cat-file commit/, $treeish) =~ + /^tree ($::sha1)/mo); + return if $y eq $x; + + warn "Index mismatch: $y != $x\nrereading $treeish\n"; + unlink $self->{index} or die "unlink $self->{index}: $!\n"; + command_noisy('read-tree', $treeish); + $x = command_oneline('write-tree'); + if ($y ne $x) { + fatal "trees ($treeish) $y != $x\n", + "Something is seriously wrong..."; + } + }); +} + +sub get_commit_parents { + my ($self, $log_entry) = @_; + my (%seen, @ret, @tmp); + # legacy support for 'set-tree'; this is only used by set_tree_cb: + if (my $ip = $self->{inject_parents}) { + if (my $commit = delete $ip->{$log_entry->{revision}}) { + push @tmp, $commit; + } + } + if (my $cur = ::verify_ref($self->refname.'^0')) { + push @tmp, $cur; + } + if (my $ipd = $self->{inject_parents_dcommit}) { + if (my $commit = delete $ipd->{$log_entry->{revision}}) { + push @tmp, @$commit; + } + } + push @tmp, $_ foreach (@{$log_entry->{parents}}, @tmp); + while (my $p = shift @tmp) { + next if $seen{$p}; + $seen{$p} = 1; + push @ret, $p; + } + @ret; +} + +sub rewrite_root { + my ($self) = @_; + return $self->{-rewrite_root} if exists $self->{-rewrite_root}; + my $k = "svn-remote.$self->{repo_id}.rewriteRoot"; + my $rwr = eval { command_oneline(qw/config --get/, $k) }; + if ($rwr) { + $rwr =~ s#/+$##; + if ($rwr !~ m#^[a-z\+]+://#) { + die "$rwr is not a valid URL (key: $k)\n"; + } + } + $self->{-rewrite_root} = $rwr; +} + +sub rewrite_uuid { + my ($self) = @_; + return $self->{-rewrite_uuid} if exists $self->{-rewrite_uuid}; + my $k = "svn-remote.$self->{repo_id}.rewriteUUID"; + my $rwid = eval { command_oneline(qw/config --get/, $k) }; + if ($rwid) { + $rwid =~ s#/+$##; + if ($rwid !~ m#^[a-f0-9]{8}-(?:[a-f0-9]{4}-){3}[a-f0-9]{12}$#) { + die "$rwid is not a valid UUID (key: $k)\n"; + } + } + $self->{-rewrite_uuid} = $rwid; +} + +sub metadata_url { + my ($self) = @_; + ($self->rewrite_root || $self->{url}) . + (length $self->{path} ? '/' . $self->{path} : ''); +} + +sub full_url { + my ($self) = @_; + $self->{url} . (length $self->{path} ? '/' . $self->{path} : ''); +} + +sub full_pushurl { + my ($self) = @_; + if ($self->{pushurl}) { + return $self->{pushurl} . (length $self->{path} ? '/' . + $self->{path} : ''); + } else { + return $self->full_url; + } +} + +sub set_commit_header_env { + my ($log_entry) = @_; + my %env; + foreach my $ned (qw/NAME EMAIL DATE/) { + foreach my $ac (qw/AUTHOR COMMITTER/) { + $env{"GIT_${ac}_${ned}"} = $ENV{"GIT_${ac}_${ned}"}; + } + } + + $ENV{GIT_AUTHOR_NAME} = $log_entry->{name}; + $ENV{GIT_AUTHOR_EMAIL} = $log_entry->{email}; + $ENV{GIT_AUTHOR_DATE} = $ENV{GIT_COMMITTER_DATE} = $log_entry->{date}; + + $ENV{GIT_COMMITTER_NAME} = (defined $log_entry->{commit_name}) + ? $log_entry->{commit_name} + : $log_entry->{name}; + $ENV{GIT_COMMITTER_EMAIL} = (defined $log_entry->{commit_email}) + ? $log_entry->{commit_email} + : $log_entry->{email}; + \%env; +} + +sub restore_commit_header_env { + my ($env) = @_; + foreach my $ned (qw/NAME EMAIL DATE/) { + foreach my $ac (qw/AUTHOR COMMITTER/) { + my $k = "GIT_${ac}_${ned}"; + if (defined $env->{$k}) { + $ENV{$k} = $env->{$k}; + } else { + delete $ENV{$k}; + } + } + } +} + +sub gc { + command_noisy('gc', '--auto'); +}; + +sub do_git_commit { + my ($self, $log_entry) = @_; + my $lr = $self->last_rev; + if (defined $lr && $lr >= $log_entry->{revision}) { + die "Last fetched revision of ", $self->refname, + " was r$lr, but we are about to fetch: ", + "r$log_entry->{revision}!\n"; + } + if (my $c = $self->rev_map_get($log_entry->{revision})) { + croak "$log_entry->{revision} = $c already exists! ", + "Why are we refetching it?\n"; + } + my $old_env = set_commit_header_env($log_entry); + my $tree = $log_entry->{tree}; + if (!defined $tree) { + $tree = $self->tmp_index_do(sub { + command_oneline('write-tree') }); + } + die "Tree is not a valid sha1: $tree\n" if $tree !~ /^$::sha1$/o; + + my @exec = ('git', 'commit-tree', $tree); + foreach ($self->get_commit_parents($log_entry)) { + push @exec, '-p', $_; + } + defined(my $pid = open3(my $msg_fh, my $out_fh, '>&STDERR', @exec)) + or croak $!; + binmode $msg_fh; + + # we always get UTF-8 from SVN, but we may want our commits in + # a different encoding. + if (my $enc = Git::config('i18n.commitencoding')) { + require Encode; + Encode::from_to($log_entry->{log}, 'UTF-8', $enc); + } + print $msg_fh $log_entry->{log} or croak $!; + restore_commit_header_env($old_env); + unless ($self->no_metadata) { + print $msg_fh "\ngit-svn-id: $log_entry->{metadata}\n" + or croak $!; + } + $msg_fh->flush == 0 or croak $!; + close $msg_fh or croak $!; + chomp(my $commit = do { local $/; <$out_fh> }); + close $out_fh or croak $!; + waitpid $pid, 0; + croak $? if $?; + if ($commit !~ /^$::sha1$/o) { + die "Failed to commit, invalid sha1: $commit\n"; + } + + $self->rev_map_set($log_entry->{revision}, $commit, 1); + + $self->{last_rev} = $log_entry->{revision}; + $self->{last_commit} = $commit; + print "r$log_entry->{revision}" unless $::_q > 1; + if (defined $log_entry->{svm_revision}) { + print " (\@$log_entry->{svm_revision})" unless $::_q > 1; + $self->rev_map_set($log_entry->{svm_revision}, $commit, + 0, $self->svm_uuid); + } + print " = $commit ($self->{ref_id})\n" unless $::_q > 1; + if (--$_gc_nr == 0) { + $_gc_nr = $_gc_period; + gc(); + } + return $commit; +} + +sub match_paths { + my ($self, $paths, $r) = @_; + return 1 if $self->{path} eq ''; + if (my $path = $paths->{"/$self->{path}"}) { + return ($path->{action} eq 'D') ? 0 : 1; + } + $self->{path_regex} ||= qr/^\/\Q$self->{path}\E\//; + if (grep /$self->{path_regex}/, keys %$paths) { + return 1; + } + my $c = ''; + foreach (split m#/#, $self->{path}) { + $c .= "/$_"; + next unless ($paths->{$c} && + ($paths->{$c}->{action} =~ /^[AR]$/)); + if ($self->ra->check_path($self->{path}, $r) == + $SVN::Node::dir) { + return 1; + } + } + return 0; +} + +sub find_parent_branch { + my ($self, $paths, $rev) = @_; + return undef unless $self->follow_parent; + unless (defined $paths) { + my $err_handler = $SVN::Error::handler; + $SVN::Error::handler = \&Git::SVN::Ra::skip_unknown_revs; + $self->ra->get_log([$self->{path}], $rev, $rev, 0, 1, 1, + sub { $paths = $_[0] }); + $SVN::Error::handler = $err_handler; + } + return undef unless defined $paths; + + # look for a parent from another branch: + my @b_path_components = split m#/#, $self->{path}; + my @a_path_components; + my $i; + while (@b_path_components) { + $i = $paths->{'/'.join('/', @b_path_components)}; + last if $i && defined $i->{copyfrom_path}; + unshift(@a_path_components, pop(@b_path_components)); + } + return undef unless defined $i && defined $i->{copyfrom_path}; + my $branch_from = $i->{copyfrom_path}; + if (@a_path_components) { + print STDERR "branch_from: $branch_from => "; + $branch_from .= '/'.join('/', @a_path_components); + print STDERR $branch_from, "\n"; + } + my $r = $i->{copyfrom_rev}; + my $repos_root = $self->ra->{repos_root}; + my $url = $self->ra->{url}; + my $new_url = $url . $branch_from; |