1#!/usr/bin/env perl
2# Copyright (C) 2006, Eric Wong <normalperson@yhbt.net>
3# License: GPL v2 or later
4use warnings;
5use strict;
6use vars qw/ $AUTHOR $VERSION
7 $SVN_URL $SVN_INFO $SVN_WC $SVN_UUID
8 $GIT_SVN_INDEX $GIT_SVN
9 $GIT_DIR $GIT_SVN_DIR $REVDB/;
10$AUTHOR = 'Eric Wong <normalperson@yhbt.net>';
11$VERSION = '1.1.1-broken';
12use Cwd qw/abs_path/;
14$GIT_DIR = abs_path($ENV{GIT_DIR} || '.git');
15$ENV{GIT_DIR} = $GIT_DIR;
16my $LC_ALL = $ENV{LC_ALL};
18my $TZ = $ENV{TZ};
19# make sure the svn binary gives consistent output between locales and TZs:
20$ENV{TZ} = 'UTC';
21$ENV{LC_ALL} = 'C';
22# If SVN:: library support is added, please make the dependencies
24# optional and preserve the capability to use the command-line client.
25# use eval { require SVN::... } to make it lazy load
26# We don't use any modules not in the standard Perl distribution:
27use Carp qw/croak/;
28use IO::File qw//;
29use File::Basename qw/dirname basename/;
30use File::Path qw/mkpath/;
31use Getopt::Long qw/:config gnu_getopt no_ignore_case auto_abbrev pass_through/;
32use File::Spec qw//;
33use POSIX qw/strftime/;
34use IPC::Open3;
35use Memoize;
36memoize('revisions_eq');
37my ($SVN_PATH, $SVN, $SVN_LOG, $_use_lib);
39$_use_lib = 1 unless $ENV{GIT_SVN_NO_LIB};
40libsvn_load();
41my $_optimize_commits = 1 unless $ENV{GIT_SVN_NO_OPTIMIZE_COMMITS};
42my $sha1 = qr/[a-f\d]{40}/;
43my $sha1_short = qr/[a-f\d]{4,40}/;
44my ($_revision,$_stdin,$_no_ignore_ext,$_no_stop_copy,$_help,$_rmdir,$_edit,
45 $_find_copies_harder, $_l, $_cp_similarity,
46 $_repack, $_repack_nr, $_repack_flags,
47 $_template, $_shared, $_no_default_regex, $_no_graft_copy,
48 $_limit, $_verbose, $_incremental, $_oneline, $_l_fmt, $_show_commit,
49 $_version, $_upgrade, $_authors, $_branch_all_refs, @_opt_m);
50my (@_branch_from, %tree_map, %users, %rusers, %equiv);
51my ($_svn_co_url_revs, $_svn_pg_peg_revs);
52my @repo_path_split_cache;
53my %fc_opts = ( 'no-ignore-externals' => \$_no_ignore_ext,
55 'branch|b=s' => \@_branch_from,
56 'branch-all-refs|B' => \$_branch_all_refs,
57 'authors-file|A=s' => \$_authors,
58 'repack:i' => \$_repack,
59 'repack-flags|repack-args|repack-opts=s' => \$_repack_flags);
60my ($_trunk, $_tags, $_branches);
62my %multi_opts = ( 'trunk|T=s' => \$_trunk,
63 'tags|t=s' => \$_tags,
64 'branches|b=s' => \$_branches );
65my %init_opts = ( 'template=s' => \$_template, 'shared' => \$_shared );
66# yes, 'native' sets "\n". Patches to fix this for non-*nix systems welcome:
68my %EOL = ( CR => "\015", LF => "\012", CRLF => "\015\012", native => "\012" );
69my %cmd = (
71 fetch => [ \&fetch, "Download new revisions from SVN",
72 { 'revision|r=s' => \$_revision, %fc_opts } ],
73 init => [ \&init, "Initialize a repo for tracking" .
74 " (requires URL argument)",
75 \%init_opts ],
76 commit => [ \&commit, "Commit git revisions to SVN",
77 { 'stdin|' => \$_stdin,
78 'edit|e' => \$_edit,
79 'rmdir' => \$_rmdir,
80 'find-copies-harder' => \$_find_copies_harder,
81 'l=i' => \$_l,
82 'copy-similarity|C=i'=> \$_cp_similarity,
83 %fc_opts,
84 } ],
85 'show-ignore' => [ \&show_ignore, "Show svn:ignore listings",
86 { 'revision|r=i' => \$_revision } ],
87 rebuild => [ \&rebuild, "Rebuild git-svn metadata (after git clone)",
88 { 'no-ignore-externals' => \$_no_ignore_ext,
89 'upgrade' => \$_upgrade } ],
90 'graft-branches' => [ \&graft_branches,
91 'Detect merges/branches from already imported history',
92 { 'merge-rx|m' => \@_opt_m,
93 'no-default-regex' => \$_no_default_regex,
94 'no-graft-copy' => \$_no_graft_copy } ],
95 'multi-init' => [ \&multi_init,
96 'Initialize multiple trees (like git-svnimport)',
97 { %multi_opts, %fc_opts } ],
98 'multi-fetch' => [ \&multi_fetch,
99 'Fetch multiple trees (like git-svnimport)',
100 \%fc_opts ],
101 'log' => [ \&show_log, 'Show commit logs',
102 { 'limit=i' => \$_limit,
103 'revision|r=s' => \$_revision,
104 'verbose|v' => \$_verbose,
105 'incremental' => \$_incremental,
106 'oneline' => \$_oneline,
107 'show-commit' => \$_show_commit,
108 'authors-file|A=s' => \$_authors,
109 } ],
110);
111my $cmd;
113for (my $i = 0; $i < @ARGV; $i++) {
114 if (defined $cmd{$ARGV[$i]}) {
115 $cmd = $ARGV[$i];
116 splice @ARGV, $i, 1;
117 last;
118 }
119};
120my %opts = %{$cmd{$cmd}->[2]} if (defined $cmd);
122read_repo_config(\%opts);
124my $rv = GetOptions(%opts, 'help|H|h' => \$_help,
125 'version|V' => \$_version,
126 'id|i=s' => \$GIT_SVN);
127exit 1 if (!$rv && $cmd ne 'log');
128set_default_vals();
130usage(0) if $_help;
131version() if $_version;
132usage(1) unless defined $cmd;
133init_vars();
134load_authors() if $_authors;
135load_all_refs() if $_branch_all_refs;
136svn_compat_check();
137migration_check() unless $cmd =~ /^(?:init|multi-init)$/;
138$cmd{$cmd}->[0]->(@ARGV);
139exit 0;
140####################### primary functions ######################
142sub usage {
143 my $exit = shift || 0;
144 my $fd = $exit ? \*STDERR : \*STDOUT;
145 print $fd <<"";
146git-svn - bidirectional operations between a single Subversion tree and git
147Usage: $0 <command> [options] [arguments]\n
148 print $fd "Available commands:\n" unless $cmd;
150 foreach (sort keys %cmd) {
152 next if $cmd && $cmd ne $_;
153 print $fd ' ',pack('A13',$_),$cmd{$_}->[1],"\n";
154 foreach (keys %{$cmd{$_}->[2]}) {
155 # prints out arguments as they should be passed:
156 my $x = s#[:=]s$## ? '<arg>' : s#[:=]i$## ? '<num>' : '';
157 print $fd ' ' x 17, join(', ', map { length $_ > 1 ?
158 "--$_" : "-$_" }
159 split /\|/,$_)," $x\n";
160 }
161 }
162 print $fd <<"";
163\nGIT_SVN_ID may be set in the environment or via the --id/-i switch to an
164arbitrary identifier if you're tracking multiple SVN branches/repositories in
165one git repository and want to keep them separate. See git-svn(1) for more
166information.
167 exit $exit;
169}
170sub version {
172 print "git-svn version $VERSION\n";
173 exit 0;
174}
175sub rebuild {
177 $SVN_URL = shift or undef;
178 my $newest_rev = 0;
179 if ($_upgrade) {
180 sys('git-update-ref',"refs/remotes/$GIT_SVN","$GIT_SVN-HEAD");
181 } else {
182 check_upgrade_needed();
183 }
184 my $pid = open(my $rev_list,'-|');
186 defined $pid or croak $!;
187 if ($pid == 0) {
188 exec("git-rev-list","refs/remotes/$GIT_SVN") or croak $!;
189 }
190 my $latest;
191 while (<$rev_list>) {
192 chomp;
193 my $c = $_;
194 croak "Non-SHA1: $c\n" unless $c =~ /^$sha1$/o;
195 my @commit = grep(/^git-svn-id: /,`git-cat-file commit $c`);
196 next if (!@commit); # skip merges
197 my ($url, $rev, $uuid) = extract_metadata($commit[$#commit]);
198 if (!$rev || !$uuid) {
199 croak "Unable to extract revision or UUID from ",
200 "$c, $commit[$#commit]\n";
201 }
202 # if we merged or otherwise started elsewhere, this is
204 # how we break out of it
205 next if (defined $SVN_UUID && ($uuid ne $SVN_UUID));
206 next if (defined $SVN_URL && defined $url && ($url ne $SVN_URL));
207 unless (defined $latest) {
209 if (!$SVN_URL && !$url) {
210 croak "SVN repository location required: $url\n";
211 }
212 $SVN_URL ||= $url;
213 $SVN_UUID ||= $uuid;
214 setup_git_svn();
215 $latest = $rev;
216 }
217 revdb_set($REVDB, $rev, $c);
218 print "r$rev = $c\n";
219 $newest_rev = $rev if ($rev > $newest_rev);
220 }
221 close $rev_list or croak $?;
222 goto out if $_use_lib;
224 if (!chdir $SVN_WC) {
225 svn_cmd_checkout($SVN_URL, $latest, $SVN_WC);
226 chdir $SVN_WC or croak $!;
227 }
228 $pid = fork;
230 defined $pid or croak $!;
231 if ($pid == 0) {
232 my @svn_up = qw(svn up);
233 push @svn_up, '--ignore-externals' unless $_no_ignore_ext;
234 sys(@svn_up,"-r$newest_rev");
235 $ENV{GIT_INDEX_FILE} = $GIT_SVN_INDEX;
236 index_changes();
237 exec('git-write-tree') or croak $!;
238 }
239 waitpid $pid, 0;
240 croak $? if $?;
241out:
242 if ($_upgrade) {
243 print STDERR <<"";
244Keeping deprecated refs/head/$GIT_SVN-HEAD for now. Please remove it
245when you have upgraded your tools and habits to use refs/remotes/$GIT_SVN
246 }
248}
249sub init {
251 $SVN_URL = shift or die "SVN repository location required " .
252 "as a command-line argument\n";
253 $SVN_URL =~ s!/+$!!; # strip trailing slash
254 unless (-d $GIT_DIR) {
255 my @init_db = ('git-init-db');
256 push @init_db, "--template=$_template" if defined $_template;
257 push @init_db, "--shared" if defined $_shared;
258 sys(@init_db);
259 }
260 setup_git_svn();
261}
262sub fetch {
264 check_upgrade_needed();
265 $SVN_URL ||= file_to_s("$GIT_SVN_DIR/info/url");
266 my $ret = $_use_lib ? fetch_lib(@_) : fetch_cmd(@_);
267 if ($ret->{commit} && quiet_run(qw(git-rev-parse --verify
268 refs/heads/master^0))) {
269 sys(qw(git-update-ref refs/heads/master),$ret->{commit});
270 }
271 return $ret;
272}
273sub fetch_cmd {
275 my (@parents) = @_;
276 my @log_args = -d $SVN_WC ? ($SVN_WC) : ($SVN_URL);
277 unless ($_revision) {
278 $_revision = -d $SVN_WC ? 'BASE:HEAD' : '0:HEAD';
279 }
280 push @log_args, "-r$_revision";
281 push @log_args, '--stop-on-copy' unless $_no_stop_copy;
282 my $svn_log = svn_log_raw(@log_args);
284 my $base = next_log_entry($svn_log) or croak "No base revision!\n";
286 # don't need last_revision from grab_base_rev() because
287 # user could've specified a different revision to skip (they
288 # didn't want to import certain revisions into git for whatever
289 # reason, so trust $base->{revision} instead.
290 my (undef, $last_commit) = svn_grab_base_rev();
291 unless (-d $SVN_WC) {
292 svn_cmd_checkout($SVN_URL,$base->{revision},$SVN_WC);
293 chdir $SVN_WC or croak $!;
294 read_uuid();
295 $last_commit = git_commit($base, @parents);
296 assert_tree($last_commit);
297 } else {
298 chdir $SVN_WC or croak $!;
299 read_uuid();
300 # looks like a user manually cp'd and svn switch'ed
301 unless ($last_commit) {
302 sys(qw/svn revert -R ./);
303 assert_svn_wc_clean($base->{revision});
304 $last_commit = git_commit($base, @parents);
305 assert_tree($last_commit);
306 }
307 }
308 my @svn_up = qw(svn up);
309 push @svn_up, '--ignore-externals' unless $_no_ignore_ext;
310 my $last = $base;
311 while (my $log_msg = next_log_entry($svn_log)) {
312 if ($last->{revision} >= $log_msg->{revision}) {
313 croak "Out of order: last >= current: ",
314 "$last->{revision} >= $log_msg->{revision}\n";
315 }
316 # Revert is needed for cases like:
317 # https://svn.musicpd.org/Jamming/trunk (r166:167), but
318 # I can't seem to reproduce something like that on a test...
319 sys(qw/svn revert -R ./);
320 assert_svn_wc_clean($last->{revision});
321 sys(@svn_up,"-r$log_msg->{revision}");
322 $last_commit = git_commit($log_msg, $last_commit, @parents);
323 $last = $log_msg;
324 }
325 close $svn_log->{fh};
326 $last->{commit} = $last_commit;
327 return $last;
328}
329sub fetch_lib {
331 my (@parents) = @_;
332 $SVN_URL ||= file_to_s("$GIT_SVN_DIR/info/url");
333 my $repo;
334 ($repo, $SVN_PATH) = repo_path_split($SVN_URL);
335 $SVN_LOG ||= libsvn_connect($repo);
336 $SVN ||= libsvn_connect($repo);
337 my ($last_rev, $last_commit) = svn_grab_base_rev();
338 my ($base, $head) = libsvn_parse_revision($last_rev);
339 if ($base > $head) {
340 return { revision => $last_rev, commit => $last_commit }
341 }
342 my $index = set_index($GIT_SVN_INDEX);
343 # limit ourselves and also fork() since get_log won't release memory
345 # after processing a revision and SVN stuff seems to leak
346 my $inc = 1000;
347 my ($min, $max) = ($base, $head < $base+$inc ? $head : $base+$inc);
348 read_uuid();
349 if (defined $last_commit) {
350 unless (-e $GIT_SVN_INDEX) {
351 sys(qw/git-read-tree/, $last_commit);
352 }
353 chomp (my $x = `git-write-tree`);
354 my ($y) = (`git-cat-file commit $last_commit`
355 =~ /^tree ($sha1)/m);
356 if ($y ne $x) {
357 unlink $GIT_SVN_INDEX or croak $!;
358 sys(qw/git-read-tree/, $last_commit);
359 }
360 chomp ($x = `git-write-tree`);
361 if ($y ne $x) {
362 print STDERR "trees ($last_commit) $y != $x\n",
363 "Something is seriously wrong...\n";
364 }
365 }
366 while (1) {
367 # fork, because using SVN::Pool with get_log() still doesn't
368 # seem to help enough to keep memory usage down.
369 defined(my $pid = fork) or croak $!;
370 if (!$pid) {
371 $SVN::Error::handler = \&libsvn_skip_unknown_revs;
372 # Yes I'm perfectly aware that the fourth argument
374 # below is the limit revisions number. Unfortunately
375 # performance sucks with it enabled, so it's much
376 # faster to fetch revision ranges instead of relying
377 # on the limiter.
378 $SVN_LOG->get_log( '/'.$SVN_PATH, $min, $max, 0, 1, 1,
379 sub {
380 my $log_msg;
381 if ($last_commit) {
382 $log_msg = libsvn_fetch(
383 $last_commit, @_);
384 $last_commit = git_commit(
385 $log_msg,
386 $last_commit,
387 @parents);
388 } else {
389 $log_msg = libsvn_new_tree(@_);
390 $last_commit = git_commit(
391 $log_msg, @parents);
392 }
393 });
394 exit 0;
395 }
396 waitpid $pid, 0;
397 croak $? if $?;
398 ($last_rev, $last_commit) = svn_grab_base_rev();
399 last if ($max >= $head);
400 $min = $max + 1;
401 $max += $inc;
402 $max = $head if ($max > $head);
403 }
404 restore_index($index);
405 return { revision => $last_rev, commit => $last_commit };
406}
407sub commit {
409 my (@commits) = @_;
410 check_upgrade_needed();
411 if ($_stdin || !@commits) {
412 print "Reading from stdin...\n";
413 @commits = ();
414 while (<STDIN>) {
415 if (/\b($sha1_short)\b/o) {
416 unshift @commits, $1;
417 }
418 }
419 }
420 my @revs;
421 foreach my $c (@commits) {
422 chomp(my @tmp = safe_qx('git-rev-parse',$c));
423 if (scalar @tmp == 1) {
424 push @revs, $tmp[0];
425 } elsif (scalar @tmp > 1) {
426 push @revs, reverse (safe_qx('git-rev-list',@tmp));
427 } else {
428 die "Failed to rev-parse $c\n";
429 }
430 }
431 chomp @revs;
432 $_use_lib ? commit_lib(@revs) : commit_cmd(@revs);
433 print "Done committing ",scalar @revs," revisions to SVN\n";
434}
435sub commit_cmd {
437 my (@revs) = @_;
438 chdir $SVN_WC or croak "Unable to chdir $SVN_WC: $!\n";
440 my $info = svn_info('.');
441 my $fetched = fetch();
442 if ($info->{Revision} != $fetched->{revision}) {
443 print STDERR "There are new revisions that were fetched ",
444 "and need to be merged (or acknowledged) ",
445 "before committing.\n";
446 exit 1;
447 }
448 $info = svn_info('.');
449 read_uuid($info);
450 my $last = $fetched;
451 foreach my $c (@revs) {
452 my $mods = svn_checkout_tree($last, $c);
453 if (scalar @$mods == 0) {
454 print "Skipping, no changes detected\n";
455 next;
456 }
457 $last = svn_commit_tree($last, $c);
458 }
459}
460sub commit_lib {
462 my (@revs) = @_;
463 my ($r_last, $cmt_last) = svn_grab_base_rev();
464 defined $r_last or die "Must have an existing revision to commit\n";
465 my $fetched = fetch();
466 if ($r_last != $fetched->{revision}) {
467 print STDERR "There are new revisions that were fetched ",
468 "and need to be merged (or acknowledged) ",
469 "before committing.\n",
470 "last rev: $r_last\n",
471 " current: $fetched->{revision}\n";
472 exit 1;
473 }
474 read_uuid();
475 my @lock = $SVN::Core::VERSION ge '1.2.0' ? (undef, 0) : ();
476 my $commit_msg = "$GIT_SVN_DIR/.svn-commit.tmp.$$";
477 foreach my $c (@revs) {
479 # fork for each commit because there's a memory leak I
480 # can't track down... (it's probably in the SVN code)
481 defined(my $pid = open my $fh, '-|') or croak $!;
482 if (!$pid) {
483 if (defined $LC_ALL) {
484 $ENV{LC_ALL} = $LC_ALL;
485 } else {
486 delete $ENV{LC_ALL};
487 }
488 my $log_msg = get_commit_message($c, $commit_msg);
489 my $ed = SVN::Git::Editor->new(
490 { r => $r_last,
491 ra => $SVN,
492 c => $c,
493 svn_path => $SVN_PATH
494 },
495 $SVN->get_commit_editor(
496 $log_msg->{msg},
497 sub {
498 libsvn_commit_cb(
499 @_, $c,
500 $log_msg->{msg},
501 $r_last,
502 $cmt_last)
503 },
504 @lock)
505 );
506 my $mods = libsvn_checkout_tree($cmt_last, $c, $ed);
507 if (@$mods == 0) {
508 print "No changes\nr$r_last = $cmt_last\n";
509 $ed->abort_edit;
510 } else {
511 $ed->close_edit;
512 }
513 exit 0;
514 }
515 my ($r_new, $cmt_new, $no);
516 while (<$fh>) {
517 print $_;
518 chomp;
519 if (/^r(\d+) = ($sha1)$/o) {
520 ($r_new, $cmt_new) = ($1, $2);
521 } elsif ($_ eq 'No changes') {
522 $no = 1;
523 }
524 }
525 close $fh or croak $?;
526 if (! defined $r_new && ! defined $cmt_new) {
527 unless ($no) {
528 die "Failed to parse revision information\n";
529 }
530 } else {
531 ($r_last, $cmt_last) = ($r_new, $cmt_new);
532 }
533 }
534 unlink $commit_msg;
535}
536sub show_ignore {
538 $SVN_URL ||= file_to_s("$GIT_SVN_DIR/info/url");
539 $_use_lib ? show_ignore_lib() : show_ignore_cmd();
540}
541sub show_ignore_cmd {
543 require File::Find or die $!;
544 if (defined $_revision) {
545 die "-r/--revision option doesn't work unless the Perl SVN ",
546 "libraries are used\n";
547 }
548 chdir $SVN_WC or croak $!;
549 my %ign;
550 File::Find::find({wanted=>sub{if(lstat $_ && -d _ && -d "$_/.svn"){
551 s#^\./##;
552 @{$ign{$_}} = svn_propget_base('svn:ignore', $_);
553 }}, no_chdir=>1},'.');
554 print "\n# /\n";
556 foreach (@{$ign{'.'}}) { print '/',$_ if /\S/ }
557 delete $ign{'.'};
558 foreach my $i (sort keys %ign) {
559 print "\n# ",$i,"\n";
560 foreach (@{$ign{$i}}) { print '/',$i,'/',$_ if /\S/ }
561 }
562}
563sub show_ignore_lib {
565 my $repo;
566 ($repo, $SVN_PATH) = repo_path_split($SVN_URL);
567 $SVN ||= libsvn_connect($repo);
568 my $r = defined $_revision ? $_revision : $SVN->get_latest_revnum;
569 libsvn_traverse_ignore(\*STDOUT, $SVN_PATH, $r);
570}
571sub graft_branches {
573 my $gr_file = "$GIT_DIR/info/grafts";
574 my ($grafts, $comments) = read_grafts($gr_file);
575 my $gr_sha1;
576 if (%$grafts) {
578 # temporarily disable our grafts file to make this idempotent
579 chomp($gr_sha1 = safe_qx(qw/git-hash-object -w/,$gr_file));
580 rename $gr_file, "$gr_file~$gr_sha1" or croak $!;
581 }
582 my $l_map = read_url_paths();
584 my @re = map { qr/$_/is } @_opt_m if @_opt_m;
585 unless ($_no_default_regex) {
586 push @re, ( qr/\b(?:merge|merging|merged)\s+(\S.+)/is,
587 qr/\b(?:from|of)\s+(\S.+)/is );
588 }
589 foreach my $u (keys %$l_map) {
590 if (@re) {
591 foreach my $p (keys %{$l_map->{$u}}) {
592 graft_merge_msg($grafts,$l_map,$u,$p);
593 }
594 }
595 unless ($_no_graft_copy) {
596 if ($_use_lib) {
597 graft_file_copy_lib($grafts,$l_map,$u);
598 } else {
599 graft_file_copy_cmd($grafts,$l_map,$u);
600 }
601 }
602 }
603 write_grafts($grafts, $comments, $gr_file);
605 unlink "$gr_file~$gr_sha1" if $gr_sha1;
606}
607sub multi_init {
609 my $url = shift;
610 $_trunk ||= 'trunk';
611 $_trunk =~ s#/+$##;
612 $url =~ s#/+$## if $url;
613 if ($_trunk !~ m#^[a-z\+]+://#) {
614 $_trunk = '/' . $_trunk if ($_trunk !~ m#^/#);
615 unless ($url) {
616 print STDERR "E: '$_trunk' is not a complete URL ",
617 "and a separate URL is not specified\n";
618 exit 1;
619 }
620 $_trunk = $url . $_trunk;
621 }
622 if ($GIT_SVN eq 'git-svn') {
623 print "GIT_SVN_ID set to 'trunk' for $_trunk\n";
624 $GIT_SVN = $ENV{GIT_SVN_ID} = 'trunk';
625 }
626 init_vars();
627 init($_trunk);
628 complete_url_ls_init($url, $_branches, '--branches/-b', '');
629 complete_url_ls_init($url, $_tags, '--tags/-t', 'tags/');
630}
631sub multi_fetch {
633 # try to do trunk first, since branches/tags
634 # may be descended from it.
635 if (-e "$GIT_DIR/svn/trunk/info/url") {
636 fetch_child_id('trunk', @_);
637 }
638 rec_fetch('', "$GIT_DIR/svn", @_);
639}
640sub show_log {
642 my (@args) = @_;
643 my ($r_min, $r_max);
644 my $r_last = -1; # prevent dupes
645 rload_authors() if $_authors;
646 if (defined $TZ) {
647 $ENV{TZ} = $TZ;
648 } else {
649 delete $ENV{TZ};
650 }
651 if (defined $_revision) {
652 if ($_revision =~ /^(\d+):(\d+)$/) {
653 ($r_min, $r_max) = ($1, $2);
654 } elsif ($_revision =~ /^\d+$/) {
655 $r_min = $r_max = $_revision;
656 } else {
657 print STDERR "-r$_revision is not supported, use ",
658 "standard \'git log\' arguments instead\n";
659 exit 1;
660 }
661 }
662 my $pid = open(my $log,'-|');
664 defined $pid or croak $!;
665 if (!$pid) {
666 exec(git_svn_log_cmd($r_min,$r_max), @args) or croak $!;
667 }
668 setup_pager();
669 my (@k, $c, $d);
670 while (<$log>) {
672 if (/^commit ($sha1_short)/o) {
673 my $cmt = $1;
674 if ($c && cmt_showable($c) && $c->{r} != $r_last) {
675 $r_last = $c->{r};
676 process_commit($c, $r_min, $r_max, \@k) or
677 goto out;
678 }
679 $d = undef;
680 $c = { c => $cmt };
681 } elsif (/^author (.+) (\d+) ([\-\+]?\d+)$/) {
682 get_author_info($c, $1, $2, $3);
683 } elsif (/^(?:tree|parent|committer) /) {
684 # ignore
685 } elsif (/^:\d{6} \d{6} $sha1_short/o) {
686 push @{$c->{raw}}, $_;
687 } elsif (/^diff /) {
688 $d = 1;
689 push @{$c->{diff}}, $_;
690 } elsif ($d) {
691 push @{$c->{diff}}, $_;
692 } elsif (/^ (git-svn-id:.+)$/) {
693 (undef, $c->{r}, undef) = extract_metadata($1);
694 } elsif (s/^ //) {
695 push @{$c->{l}}, $_;
696 }
697 }
698 if ($c && defined $c->{r} && $c->{r} != $r_last) {
699 $r_last = $c->{r};
700 process_commit($c, $r_min, $r_max, \@k);
701 }
702 if (@k) {
703 my $swap = $r_max;
704 $r_max = $r_min;
705 $r_min = $swap;
706 process_commit($_, $r_min, $r_max) foreach reverse @k;
707 }
708out:
709 close $log;
710 print '-' x72,"\n" unless $_incremental || $_oneline;
711}
712########################### utility functions #########################
714sub cmt_showable {
716 my ($c) = @_;
717 return 1 if defined $c->{r};
718 if ($c->{l} && $c->{l}->[-1] eq "...\n" &&
719 $c->{a_raw} =~ /\@([a-f\d\-]+)>$/) {
720 my @msg = safe_qx(qw/git-cat-file commit/, $c->{c});
721 shift @msg while ($msg[0] ne "\n");
722 shift @msg;
723 @{$c->{l}} = grep !/^git-svn-id: /, @msg;
724 (undef, $c->{r}, undef) = extract_metadata(
726 (grep(/^git-svn-id: /, @msg))[-1]);
727 }
728 return defined $c->{r};
729}
730sub git_svn_log_cmd {
732 my ($r_min, $r_max) = @_;
733 my @cmd = (qw/git-log --abbrev-commit --pretty=raw
734 --default/, "refs/remotes/$GIT_SVN");
735 push @cmd, '--summary' if $_verbose;
736 return @cmd unless defined $r_max;
737 if ($r_max == $r_min) {
738 push @cmd, '--max-count=1';
739 if (my $c = revdb_get($REVDB, $r_max)) {
740 push @cmd, $c;
741 }
742 } else {
743 my ($c_min, $c_max);
744 $c_max = revdb_get($REVDB, $r_max);
745 $c_min = revdb_get($REVDB, $r_min);
746 if ($c_min && $c_max) {
747 if ($r_max > $r_max) {
748 push @cmd, "$c_min..$c_max";
749 } else {
750 push @cmd, "$c_max..$c_min";
751 }
752 } elsif ($r_max > $r_min) {
753 push @cmd, $c_max;
754 } else {
755 push @cmd, $c_min;
756 }
757 }
758 return @cmd;
759}
760sub fetch_child_id {
762 my $id = shift;
763 print "Fetching $id\n";
764 my $ref = "$GIT_DIR/refs/remotes/$id";
765 my $ca = file_to_s($ref) if (-r $ref);
766 defined(my $pid = fork) or croak $!;
767 if (!$pid) {
768 $GIT_SVN = $ENV{GIT_SVN_ID} = $id;
769 init_vars();
770 fetch(@_);
771 exit 0;
772 }
773 waitpid $pid, 0;
774 croak $? if $?;
775 return unless $_repack || -r $ref;
776 my $cb = file_to_s($ref);
778 defined($pid = open my $fh, '-|') or croak $!;
780 my $url = file_to_s("$GIT_DIR/svn/$id/info/url");
781 $url = qr/\Q$url\E/;
782 if (!$pid) {
783 exec qw/git-rev-list --pretty=raw/,
784 $ca ? "$ca..$cb" : $cb or croak $!;
785 }
786 while (<$fh>) {
787 if (/^ git-svn-id: $url\@\d+ [a-f0-9\-]+$/) {
788 check_repack();
789 } elsif (/^ git-svn-id: \S+\@\d+ [a-f0-9\-]+$/) {
790 last;
791 }
792 }
793 close $fh;
794}
795sub rec_fetch {
797 my ($pfx, $p, @args) = @_;
798 my @dir;
799 foreach (sort <$p/*>) {
800 if (-r "$_/info/url") {
801 $pfx .= '/' if $pfx && $pfx !~ m!/$!;
802 my $id = $pfx . basename $_;
803 next if $id eq 'trunk';
804 fetch_child_id($id, @args);
805 } elsif (-d $_) {
806 push @dir, $_;
807 }
808 }
809 foreach (@dir) {
810 my $x = $_;
811 $x =~ s!^\Q$GIT_DIR\E/svn/!!;
812 rec_fetch($x, $_);
813 }
814}
815sub complete_url_ls_init {
817 my ($url, $var, $switch, $pfx) = @_;
818 unless ($var) {
819 print STDERR "W: $switch not specified\n";
820 return;
821 }
822 $var =~ s#/+$##;
823 if ($var !~ m#^[a-z\+]+://#) {
824 $var = '/' . $var if ($var !~ m#^/#);
825 unless ($url) {
826 print STDERR "E: '$var' is not a complete URL ",
827 "and a separate URL is not specified\n";
828 exit 1;
829 }
830 $var = $url . $var;
831 }
832 chomp(my @ls = $_use_lib ? libsvn_ls_fullurl($var)
833 : safe_qx(qw/svn ls --non-interactive/, $var));
834 my $old = $GIT_SVN;
835 defined(my $pid = fork) or croak $!;
836 if (!$pid) {
837 foreach my $u (map { "$var/$_" } (grep m!/$!, @ls)) {
838 $u =~ s#/+$##;
839 if ($u !~ m!\Q$var\E/(.+)$!) {
840 print STDERR "W: Unrecognized URL: $u\n";
841 die "This should never happen\n";
842 }
843 my $id = $pfx.$1;
844 print "init $u => $id\n";
845 $GIT_SVN = $ENV{GIT_SVN_ID} = $id;
846 init_vars();
847 init($u);
848 }
849 exit 0;
850 }
851 waitpid $pid, 0;
852 croak $? if $?;
853}
854sub common_prefix {
856 my $paths = shift;
857 my %common;
858 foreach (@$paths) {
859 my @tmp = split m#/#, $_;
860 my $p = '';
861 while (my $x = shift @tmp) {
862 $p .= "/$x";
863 $common{$p} ||= 0;
864 $common{$p}++;
865 }
866 }
867 foreach (sort {length $b <=> length $a} keys %common) {
868 if ($common{$_} == @$paths) {
869 return $_;
870 }
871 }
872 return '';
873}
874# this isn't funky-filename safe, but good enough for now...
876sub graft_file_copy_cmd {
877 my ($grafts, $l_map, $u) = @_;
878 my $paths = $l_map->{$u};
879 my $pfx = common_prefix([keys %$paths]);
880 $SVN_URL ||= $u.$pfx;
881 my $pid = open my $fh, '-|';
882 defined $pid or croak $!;
883 unless ($pid) {
884 my @exec = qw/svn log -v/;
885 push @exec, "-r$_revision" if defined $_revision;
886 exec @exec, $u.$pfx or croak $!;
887 }
888 my ($r, $mp) = (undef, undef);
889 while (<$fh>) {
890 chomp;
891 if (/^\-{72}$/) {
892 $mp = $r = undef;
893 } elsif (/^r(\d+) \| /) {
894 $r = $1 unless defined $r;
895 } elsif (/^Changed paths:/) {
896 $mp = 1;
897 } elsif ($mp && m#^ [AR] /(\S.*?) \(from /(\S+?):(\d+)\)$#) {
898 my ($p1, $p0, $r0) = ($1, $2, $3);
899 my $c = find_graft_path_commit($paths, $p1, $r);
900 next unless $c;
901 find_graft_path_parents($grafts, $paths, $c, $p0, $r0);
902 }
903 }
904}
905sub graft_file_copy_lib {
907 my ($grafts, $l_map, $u) = @_;
908 my $tree_paths = $l_map->{$u};
909 my $pfx = common_prefix([keys %$tree_paths]);
910 my ($repo, $path) = repo_path_split($u.$pfx);
911 $SVN_LOG ||= libsvn_connect($repo);
912 $SVN ||= libsvn_connect($repo);
913 my ($base, $head) = libsvn_parse_revision();
915 my $inc = 1000;
916 my ($min, $max) = ($base, $head < $base+$inc ? $head : $base+$inc);
917 my $eh = $SVN::Error::handler;
918 $SVN::Error::handler = \&libsvn_skip_unknown_revs;
919 while (1) {
920 my $pool = SVN::Pool->new;
921 $SVN_LOG->get_log( "/$path", $min, $max, 0, 1, 1,
922 sub {
923 libsvn_graft_file_copies($grafts, $tree_paths,
924 $path, @_);
925 }, $pool);
926 $pool->clear;
927 last if ($max >= $head);
928 $min = $max + 1;
929 $max += $inc;
930 $max = $head if ($max > $head);
931 }
932 $SVN::Error::handler = $eh;
933}
934sub process_merge_msg_matches {
936 my ($grafts, $l_map, $u, $p, $c, @matches) = @_;
937 my (@strong, @weak);
938 foreach (@matches) {
939 # merging with ourselves is not interesting
940 next if $_ eq $p;
941 if ($l_map->{$u}->{$_}) {
942 push @strong, $_;
943 } else {
944 push @weak, $_;
945 }
946 }
947 foreach my $w (@weak) {
948 last if @strong;
949 # no exact match, use branch name as regexp.
950 my $re = qr/\Q$w\E/i;
951 foreach (keys %{$l_map->{$u}}) {
952 if (/$re/) {
953 push @strong, $_;
954 last;
955 }
956 }
957 last if @strong;
958 $w = basename($w);
959 $re = qr/\Q$w\E/i;
960 foreach (keys %{$l_map->{$u}}) {
961 if (/$re/) {
962 push @strong, $_;
963 last;
964 }
965 }
966 }
967 my ($rev) = ($c->{m} =~ /^git-svn-id:\s(?:\S+?)\@(\d+)
968 \s(?:[a-f\d\-]+)$/xsm);
969 unless (defined $rev) {
970 ($rev) = ($c->{m} =~/^git-svn-id:\s(\d+)
971 \@(?:[a-f\d\-]+)/xsm);
972 return unless defined $rev;
973 }
974 foreach my $m (@strong) {
975 my ($r0, $s0) = find_rev_before($rev, $m);
976 $grafts->{$c->{c}}->{$s0} = 1 if defined $s0;
977 }
978}
979sub graft_merge_msg {
981 my ($grafts, $l_map, $u, $p, @re) = @_;
982 my $x = $l_map->{$u}->{$p};
984 my $rl = rev_list_raw($x);
985 while (my $c = next_rev_list_entry($rl)) {
986 foreach my $re (@re) {
987 my (@br) = ($c->{m} =~ /$re/g);
988 next unless @br;
989 process_merge_msg_matches($grafts,$l_map,$u,$p,$c,@br);
990 }
991 }
992}
993sub read_uuid {
995 return if $SVN_UUID;
996 if ($_use_lib) {
997 my $pool = SVN::Pool->new;
998 $SVN_UUID = $SVN->get_uuid($pool);
999 $pool->clear;
1000 } else {
1001 my $info = shift || svn_info('.');
1002 $SVN_UUID = $info->{'Repository UUID'} or
1003 croak "Repository UUID unreadable\n";
1004 }
1005}
1006sub quiet_run {
1008 my $pid = fork;
1009 defined $pid or croak $!;
1010 if (!$pid) {
1011 open my $null, '>', '/dev/null' or croak $!;
1012 open STDERR, '>&', $null or croak $!;
1013 open STDOUT, '>&', $null or croak $!;
1014 exec @_ or croak $!;
1015 }
1016 waitpid $pid, 0;
1017 return $?;
1018}
1019sub repo_path_split {
1021 my $full_url = shift;
1022 $full_url =~ s#/+$##;
1023 foreach (@repo_path_split_cache) {
1025 if ($full_url =~ s#$_##) {
1026 my $u = $1;
1027 $full_url =~ s#^/+##;
1028 return ($u, $full_url);
1029 }
1030 }
1031 my ($url, $path) = ($full_url =~ m!^([a-z\+]+://[^/]*)(.*)$!i);
1033 $path =~ s#^/+##;
1034 my @paths = split(m#/+#, $path);
1035 if ($_use_lib) {
1037 while (1) {
1038 $SVN = libsvn_connect($url);
1039 last if (defined $SVN &&
1040 defined eval { $SVN->get_latest_revnum });
1041 my $n = shift @paths || last;
1042 $url .= "/$n";
1043 }
1044 } else {
1045 while (quiet_run(qw/svn ls --non-interactive/, $url)) {
1046 my $n = shift @paths || last;
1047 $url .= "/$n";
1048 }
1049 }
1050 push @repo_path_split_cache, qr/^(\Q$url\E)/;
1051 $path = join('/',@paths);
1052 return ($url, $path);
1053}
1054sub setup_git_svn {
1056 defined $SVN_URL or croak "SVN repository location required\n";
1057 unless (-d $GIT_DIR) {
1058 croak "GIT_DIR=$GIT_DIR does not exist!\n";
1059 }
1060 mkpath([$GIT_SVN_DIR]);
1061 mkpath(["$GIT_SVN_DIR/info"]);
1062 open my $fh, '>>',$REVDB or croak $!;
1063 close $fh;
1064 s_to_file($SVN_URL,"$GIT_SVN_DIR/info/url");
1065}
1067sub assert_svn_wc_clean {
1069 return if $_use_lib;
1070 my ($svn_rev) = @_;
1071 croak "$svn_rev is not an integer!\n" unless ($svn_rev =~ /^\d+$/);
1072 my $lcr = svn_info('.')->{'Last Changed Rev'};
1073 if ($svn_rev != $lcr) {
1074 print STDERR "Checking for copy-tree ... ";
1075 my @diff = grep(/^Index: /,(safe_qx(qw(svn diff),
1076 "-r$lcr:$svn_rev")));
1077 if (@diff) {
1078 croak "Nope! Expected r$svn_rev, got r$lcr\n";
1079 } else {
1080 print STDERR "OK!\n";
1081 }
1082 }
1083 my @status = grep(!/^Performing status on external/,(`svn status`));
1084 @status = grep(!/^\s*$/,@status);
1085 if (scalar @status) {
1086 print STDERR "Tree ($SVN_WC) is not clean:\n";
1087 print STDERR $_ foreach @status;
1088 croak;
1089 }
1090}
1091sub get_tree_from_treeish {
1093 my ($treeish) = @_;
1094 croak "Not a sha1: $treeish\n" unless $treeish =~ /^$sha1$/o;
1095 chomp(my $type = `git-cat-file -t $treeish`);
1096 my $expected;
1097 while ($type eq 'tag') {
1098 chomp(($treeish, $type) = `git-cat-file tag $treeish`);
1099 }
1100 if ($type eq 'commit') {
1101 $expected = (grep /^tree /,`git-cat-file commit $treeish`)[0];
1102 ($expected) = ($expected =~ /^tree ($sha1)$/);
1103 die "Unable to get tree from $treeish\n" unless $expected;
1104 } elsif ($type eq 'tree') {
1105 $expected = $treeish;
1106 } else {
1107 die "$treeish is a $type, expected tree, tag or commit\n";
1108 }
1109 return $expected;
1110}
1111sub assert_tree {
1113 return if $_use_lib;
1114 my ($treeish) = @_;
1115 my $expected = get_tree_from_treeish($treeish);
1116 my $tmpindex = $GIT_SVN_INDEX.'.assert-tmp';
1118 if (-e $tmpindex) {
1119 unlink $tmpindex or croak $!;
1120 }
1121 my $old_index = set_index($tmpindex);
1122 index_changes(1);
1123 chomp(my $tree = `git-write-tree`);
1124 restore_index($old_index);
1125 if ($tree ne $expected) {
1126 croak "Tree mismatch, Got: $tree, Expected: $expected\n";
1127 }
1128 unlink $tmpindex;
1129}
1130sub parse_diff_tree {
1132 my $diff_fh = shift;
1133 local $/ = "\0";
1134 my $state = 'meta';
1135 my @mods;
1136 while (<$diff_fh>) {
1137 chomp $_; # this gets rid of the trailing "\0"
1138 if ($state eq 'meta' && /^:(\d{6})\s(\d{6})\s
1139 $sha1\s($sha1)\s([MTCRAD])\d*$/xo) {
1140 push @mods, { mode_a => $1, mode_b => $2,
1141 sha1_b => $3, chg => $4 };
1142 if ($4 =~ /^(?:C|R)$/) {
1143 $state = 'file_a';
1144 } else {
1145 $state = 'file_b';
1146 }
1147 } elsif ($state eq 'file_a') {
1148 my $x = $mods[$#mods] or croak "Empty array\n";
1149 if ($x->{chg} !~ /^(?:C|R)$/) {
1150 croak "Error parsing $_, $x->{chg}\n";
1151 }
1152 $x->{file_a} = $_;
1153 $state = 'file_b';
1154 } elsif ($state eq 'file_b') {
1155 my $x = $mods[$#mods] or croak "Empty array\n";
1156 if (exists $x->{file_a} && $x->{chg} !~ /^(?:C|R)$/) {
1157 croak "Error parsing $_, $x->{chg}\n";
1158 }
1159 if (!exists $x->{file_a} && $x->{chg} =~ /^(?:C|R)$/) {
1160 croak "Error parsing $_, $x->{chg}\n";
1161 }
1162 $x->{file_b} = $_;
1163 $state = 'meta';
1164 } else {
1165 croak "Error parsing $_\n";
1166 }
1167 }
1168 close $diff_fh or croak $?;
1169 return \@mods;
1171}
1172sub svn_check_prop_executable {
1174 my $m = shift;
1175 return if -l $m->{file_b};
1176 if ($m->{mode_b} =~ /755$/) {
1177 chmod((0755 &~ umask),$m->{file_b}) or croak $!;
1178 if ($m->{mode_a} !~ /755$/) {
1179 sys(qw(svn propset svn:executable 1), $m->{file_b});
1180 }
1181 -x $m->{file_b} or croak "$m->{file_b} is not executable!\n";
1182 } elsif ($m->{mode_b} !~ /755$/ && $m->{mode_a} =~ /755$/) {
1183 sys(qw(svn propdel svn:executable), $m->{file_b});
1184 chmod((0644 &~ umask),$m->{file_b}) or croak $!;
1185 -x $m->{file_b} and croak "$m->{file_b} is executable!\n";
1186 }
1187}
1188sub svn_ensure_parent_path {
1190 my $dir_b = dirname(shift);
1191 svn_ensure_parent_path($dir_b) if ($dir_b ne File::Spec->curdir);
1192 mkpath([$dir_b]) unless (-d $dir_b);
1193 sys(qw(svn add -N), $dir_b) unless (-d "$dir_b/.svn");
1194}
1195sub precommit_check {
1197 my $mods = shift;
1198 my (%rm_file, %rmdir_check, %added_check);
1199 my %o = ( D => 0, R => 1, C => 2, A => 3, M => 3, T => 3 );
1201 foreach my $m (sort { $o{$a->{chg}} <=> $o{$b->{chg}} } @$mods) {
1202 if ($m->{chg} eq 'R') {
1203 if (-d $m->{file_b}) {
1204 err_dir_to_file("$m->{file_a} => $m->{file_b}");
1205 }
1206 # dir/$file => dir/file/$file
1207 my $dirname = dirname($m->{file_b});
1208 while ($dirname ne File::Spec->curdir) {
1209 if ($dirname ne $m->{file_a}) {
1210 $dirname = dirname($dirname);
1211 next;
1212 }
1213 err_file_to_dir("$m->{file_a} => $m->{file_b}");
1214 }
1215 # baz/zzz => baz (baz is a file)
1216 $dirname = dirname($m->{file_a});
1217 while ($dirname ne File::Spec->curdir) {
1218 if ($dirname ne $m->{file_b}) {
1219 $dirname = dirname($dirname);
1220 next;
1221 }
1222 err_dir_to_file("$m->{file_a} => $m->{file_b}");
1223 }
1224 }
1225 if ($m->{chg} =~ /^(D|R)$/) {
1226 my $t = $1 eq 'D' ? 'file_b' : 'file_a';
1227 $rm_file{ $m->{$t} } = 1;
1228 my $dirname = dirname( $m->{$t} );
1229 my $basename = basename( $m->{$t} );
1230 $rmdir_check{$dirname}->{$basename} = 1;
1231 } elsif ($m->{chg} =~ /^(?:A|C)$/) {
1232 if (-d $m->{file_b}) {
1233 err_dir_to_file($m->{file_b});
1234 }
1235 my $dirname = dirname( $m->{file_b} );
1236 my $basename = basename( $m->{file_b} );
1237 $added_check{$dirname}->{$basename} = 1;
1238 while ($dirname ne File::Spec->curdir) {
1239 if ($rm_file{$dirname}) {
1240 err_file_to_dir($m->{file_b});
1241 }
1242 $dirname = dirname $dirname;
1243 }
1244 }
1245 }
1246 return (\%rmdir_check, \%added_check);
1247 sub err_dir_to_file {
1249 my $file = shift;
1250 print STDERR "Node change from directory to file ",
1251 "is not supported by Subversion: ",$file,"\n";
1252 exit 1;
1253 }
1254 sub err_file_to_dir {
1255 my $file = shift;
1256 print STDERR "Node change from file to directory ",
1257 "is not supported by Subversion: ",$file,"\n";
1258 exit 1;
1259 }
1260}
1261sub get_diff {
1264 my ($from, $treeish) = @_;
1265 assert_tree($from);
1266 print "diff-tree $from $treeish\n";
1267 my $pid = open my $diff_fh, '-|';
1268 defined $pid or croak $!;
1269 if ($pid == 0) {
1270 my @diff_tree = qw(git-diff-tree -z -r);
1271 if ($_cp_similarity) {
1272 push @diff_tree, "-C$_cp_similarity";
1273 } else {
1274 push @diff_tree, '-C';
1275 }
1276 push @diff_tree, '--find-copies-harder' if $_find_copies_harder;
1277 push @diff_tree, "-l$_l" if defined $_l;
1278 exec(@diff_tree, $from, $treeish) or croak $!;
1279 }
1280 return parse_diff_tree($diff_fh);
1281}
1282sub svn_checkout_tree {
1284 my ($from, $treeish) = @_;
1285 my $mods = get_diff($from->{commit}, $treeish);
1286 return $mods unless (scalar @$mods);
1287 my ($rm, $add) = precommit_check($mods);
1288 my %o = ( D => 1, R => 0, C => -1, A => 3, M => 3, T => 3 );
1290 foreach my $m (sort { $o{$a->{chg}} <=> $o{$b->{chg}} } @$mods) {
1291 if ($m->{chg} eq 'C') {
1292 svn_ensure_parent_path( $m->{file_b} );
1293 sys(qw(svn cp), $m->{file_a}, $m->{file_b});
1294 apply_mod_line_blob($m);
1295 svn_check_prop_executable($m);
1296 } elsif ($m->{chg} eq 'D') {
1297 sys(qw(svn rm --force), $m->{file_b});
1298 } elsif ($m->{chg} eq 'R') {
1299 svn_ensure_parent_path( $m->{file_b} );
1300 sys(qw(svn mv --force), $m->{file_a}, $m->{file_b});
1301 apply_mod_line_blob($m);
1302 svn_check_prop_executable($m);
1303 } elsif ($m->{chg} eq 'M') {
1304 apply_mod_line_blob($m);
1305 svn_check_prop_executable($m);
1306 } elsif ($m->{chg} eq 'T') {
1307 sys(qw(svn rm --force),$m->{file_b});
1308 apply_mod_line_blob($m);
1309 sys(qw(svn add --force), $m->{file_b});
1310 svn_check_prop_executable($m);
1311 } elsif ($m->{chg} eq 'A') {
1312 svn_ensure_parent_path( $m->{file_b} );
1313 apply_mod_line_blob($m);
1314 sys(qw(svn add --force), $m->{file_b});
1315 svn_check_prop_executable($m);
1316 } else {
1317 croak "Invalid chg: $m->{chg}\n";
1318 }
1319 }
1320 assert_tree($treeish);
1322 if ($_rmdir) { # remove empty directories
1323 handle_rmdir($rm, $add);
1324 }
1325 assert_tree($treeish);
1326 return $mods;
1327}
1328sub libsvn_checkout_tree {
1330 my ($from, $treeish, $ed) = @_;
1331 my $mods = get_diff($from, $treeish);
1332 return $mods unless (scalar @$mods);
1333 my %o = ( D => 1, R => 0, C => -1, A => 3, M => 3, T => 3 );
1334 foreach my $m (sort { $o{$a->{chg}} <=> $o{$b->{chg}} } @$mods) {
1335 my $f = $m->{chg};
1336 if (defined $o{$f}) {
1337 $ed->$f($m);
1338 } else {
1339 croak "Invalid change type: $f\n";
1340 }
1341 }
1342 $ed->rmdirs if $_rmdir;
1343 return $mods;
1344}
1345# svn ls doesn't work with respect to the current working tree, but what's
1347# in the repository. There's not even an option for it... *sigh*
1348# (added files don't show up and removed files remain in the ls listing)
1349sub svn_ls_current {
1350 my ($dir, $rm, $add) = @_;
1351 chomp(my @ls = safe_qx('svn','ls',$dir));
1352 my @ret = ();
1353 foreach (@ls) {
1354 s#/$##; # trailing slashes are evil
1355 push @ret, $_ unless $rm->{$dir}->{$_};
1356 }
1357 if (exists $add->{$dir}) {
1358 push @ret, keys %{$add->{$dir}};
1359 }
1360 return \@ret;
1361}
1362sub handle_rmdir {
1364 my ($rm, $add) = @_;
1365 foreach my $dir (sort {length $b <=> length $a} keys %$rm) {
1367 my $ls = svn_ls_current($dir, $rm, $add);
1368 next if (scalar @$ls);
1369 sys(qw(svn rm --force),$dir);
1370 my $dn = dirname $dir;
1372 $rm->{ $dn }->{ basename $dir } = 1;
1373 $ls = svn_ls_current($dn, $rm, $add);
1374 while (scalar @$ls == 0 && $dn ne File::Spec->curdir) {
1375 sys(qw(svn rm --force),$dn);
1376 $dir = basename $dn;
1377 $dn = dirname $dn;
1378 $rm->{ $dn }->{ $dir } = 1;
1379 $ls = svn_ls_current($dn, $rm, $add);
1380 }
1381 }
1382}
1383sub get_commit_message {
1385 my ($commit, $commit_msg) = (@_);
1386 my %log_msg = ( msg => '' );
1387 open my $msg, '>', $commit_msg or croak $!;
1388 print "commit: $commit\n";
1390 chomp(my $type = `git-cat-file -t $commit`);
1391 if ($type eq 'commit') {
1392 my $pid = open my $msg_fh, '-|';
1393 defined $pid or croak $!;
1394 if ($pid == 0) {
1396 exec(qw(git-cat-file commit), $commit) or croak $!;
1397 }
1398 my $in_msg = 0;
1399 while (<$msg_fh>) {
1400 if (!$in_msg) {
1401 $in_msg = 1 if (/^\s*$/);
1402 } elsif (/^git-svn-id: /) {
1403 # skip this, we regenerate the correct one
1404 # on re-fetch anyways
1405 } else {
1406 print $msg $_ or croak $!;
1407 }
1408 }
1409 close $msg_fh or croak $?;
1410 }
1411 close $msg or croak $!;
1412 if ($_edit || ($type eq 'tree')) {
1414 my $editor = $ENV{VISUAL} || $ENV{EDITOR} || 'vi';
1415 system($editor, $commit_msg);
1416 }
1417 # file_to_s removes all trailing newlines, so just use chomp() here:
1419 open $msg, '<', $commit_msg or croak $!;
1420 { local $/; chomp($log_msg{msg} = <$msg>); }
1421 close $msg or croak $!;
1422 return \%log_msg;
1424}
1425sub svn_commit_tree {
1427 my ($last, $commit) = @_;
1428 my $commit_msg = "$GIT_SVN_DIR/.svn-commit.tmp.$$";
1429 my $log_msg = get_commit_message($commit, $commit_msg);
1430 my ($oneline) = ($log_msg->{msg} =~ /([^\n\r]+)/);
1431 print "Committing $commit: $oneline\n";
1432 if (defined $LC_ALL) {
1434 $ENV{LC_ALL} = $LC_ALL;
1435 } else {
1436 delete $ENV{LC_ALL};
1437 }
1438 my @ci_output = safe_qx(qw(svn commit -F),$commit_msg);
1439 $ENV{LC_ALL} = 'C';
1440 unlink $commit_msg;
1441 my ($committed) = ($ci_output[$#ci_output] =~ /(\d+)/);
1442 if (!defined $committed) {
1443 my $out = join("\n",@ci_output);
1444 print STDERR "W: Trouble parsing \`svn commit' output:\n\n",
1445 $out, "\n\nAssuming English locale...";
1446 ($committed) = ($out =~ /^Committed revision \d+\./sm);
1447 defined $committed or die " FAILED!\n",
1448 "Commit output failed to parse committed revision!\n",
1449 print STDERR " OK\n";
1450 }
1451 my @svn_up = qw(svn up);
1453 push @svn_up, '--ignore-externals' unless $_no_ignore_ext;
1454 if ($_optimize_commits && ($committed == ($last->{revision} + 1))) {
1455 push @svn_up, "-r$committed";
1456 sys(@svn_up);
1457 my $info = svn_info('.');
1458 my $date = $info->{'Last Changed Date'} or die "Missing date\n";
1459 if ($info->{'Last Changed Rev'} != $committed) {
1460 croak "$info->{'Last Changed Rev'} != $committed\n"
1461 }
1462 my ($Y,$m,$d,$H,$M,$S,$tz) = ($date =~
1463 /(\d{4})\-(\d\d)\-(\d\d)\s
1464 (\d\d)\:(\d\d)\:(\d\d)\s([\-\+]\d+)/x)
1465 or croak "Failed to parse date: $date\n";
1466 $log_msg->{date} = "$tz $Y-$m-$d $H:$M:$S";
1467 $log_msg->{author} = $info->{'Last Changed Author'};
1468 $log_msg->{revision} = $committed;
1469 $log_msg->{msg} .= "\n";
1470 $log_msg->{parents} = [ $last->{commit} ];
1471 $log_msg->{commit} = git_commit($log_msg, $commit);
1472 return $log_msg;
1473 }
1474 # resync immediately
1475 push @svn_up, "-r$last->{revision}";
1476 sys(@svn_up);
1477 return fetch("$committed=$commit");
1478}
1479sub rev_list_raw {
1481 my (@args) = @_;
1482 my $pid = open my $fh, '-|';
1483 defined $pid or croak $!;
1484 if (!$pid) {
1485 exec(qw/git-rev-list --pretty=raw/, @args) or croak $!;
1486 }
1487 return { fh => $fh, t => { } };
1488}
1489sub next_rev_list_entry {
1491 my $rl = shift;
1492 my $fh = $rl->{fh};
1493 my $x = $rl->{t};
1494 while (<$fh>) {
1495 if (/^commit ($sha1)$/o) {
1496 if ($x->{c}) {
1497 $rl->{t} = { c => $1 };
1498 return $x;
1499 } else {
1500 $x->{c} = $1;
1501 }
1502 } elsif (/^parent ($sha1)$/o) {
1503 $x->{p}->{$1} = 1;
1504 } elsif (s/^ //) {
1505 $x->{m} ||= '';
1506 $x->{m} .= $_;
1507 }
1508 }
1509 return ($x != $rl->{t}) ? $x : undef;
1510}
1511# read the entire log into a temporary file (which is removed ASAP)
1513# and store the file handle + parser state
1514sub svn_log_raw {
1515 my (@log_args) = @_;
1516 my $log_fh = IO::File->new_tmpfile or croak $!;
1517 my $pid = fork;
1518 defined $pid or croak $!;
1519 if (!$pid) {
1520 open STDOUT, '>&', $log_fh or croak $!;
1521 exec (qw(svn log), @log_args) or croak $!
1522 }
1523 waitpid $pid, 0;
1524 croak $? if $?;
1525 seek $log_fh, 0, 0 or croak $!;
1526 return { state => 'sep', fh => $log_fh };
1527}
1528sub next_log_entry {
1530 my $log = shift; # retval of svn_log_raw()
1531 my $ret = undef;
1532 my $fh = $log->{fh};
1533 while (<$fh>) {
1535 chomp;
1536 if (/^\-{72}$/) {
1537 if ($log->{state} eq 'msg') {
1538 if ($ret->{lines}) {
1539 $ret->{msg} .= $_."\n";
1540 unless(--$ret->{lines}) {
1541 $log->{state} = 'sep';
1542 }
1543 } else {
1544 croak "Log parse error at: $_\n",
1545 $ret->{revision},
1546 "\n";
1547 }
1548 next;
1549 }
1550 if ($log->{state} ne 'sep') {
1551 croak "Log parse error at: $_\n",
1552 "state: $log->{state}\n",
1553 $ret->{revision},
1554 "\n";
1555 }
1556 $log->{state} = 'rev';
1557 # if we have an empty log message, put something there:
1559 if ($ret) {
1560 $ret->{msg} ||= "\n";
1561 delete $ret->{lines};
1562 return $ret;
1563 }
1564 next;
1565 }
1566 if ($log->{state} eq 'rev' && s/^r(\d+)\s*\|\s*//) {
1567 my $rev = $1;
1568 my ($author, $date, $lines) = split(/\s*\|\s*/, $_, 3);
1569 ($lines) = ($lines =~ /(\d+)/);
1570 my ($Y,$m,$d,$H,$M,$S,$tz) = ($date =~
1571 /(\d{4})\-(\d\d)\-(\d\d)\s
1572 (\d\d)\:(\d\d)\:(\d\d)\s([\-\+]\d+)/x)
1573 or croak "Failed to parse date: $date\n";
1574 $ret = { revision => $rev,
1575 date => "$tz $Y-$m-$d $H:$M:$S",
1576 author => $author,
1577 lines => $lines,
1578 msg => '' };
1579 if (defined $_authors && ! defined $users{$author}) {
1580 die "Author: $author not defined in ",
1581 "$_authors file\n";
1582 }
1583 $log->{state} = 'msg_start';
1584 next;
1585 }
1586 # skip the first blank line of the message:
1587 if ($log->{state} eq 'msg_start' && /^$/) {
1588 $log->{state} = 'msg';
1589 } elsif ($log->{state} eq 'msg') {
1590 if ($ret->{lines}) {
1591 $ret->{msg} .= $_."\n";
1592 unless (--$ret->{lines}) {
1593 $log->{state} = 'sep';
1594 }
1595 } else {
1596 croak "Log parse error at: $_\n",
1597 $ret->{revision},"\n";
1598 }
1599 }
1600 }
1601 return $ret;
1602}
1603sub svn_info {
1605 my $url = shift || $SVN_URL;
1606 my $pid = open my $info_fh, '-|';
1608 defined $pid or croak $!;
1609 if ($pid == 0) {
1611 exec(qw(svn info),$url) or croak $!;
1612 }
1613 my $ret = {};
1615 # only single-lines seem to exist in svn info output
1616 while (<$info_fh>) {
1617 chomp $_;
1618 if (m#^([^:]+)\s*:\s*(\S.*)$#) {
1619 $ret->{$1} = $2;
1620 push @{$ret->{-order}}, $1;
1621 }
1622 }
1623 close $info_fh or croak $?;
1624 return $ret;
1625}
1626sub sys { system(@_) == 0 or croak $? }
1628sub eol_cp {
1630 my ($from, $to) = @_;
1631 my $es = svn_propget_base('svn:eol-style', $to);
1632 open my $rfd, '<', $from or croak $!;
1633 binmode $rfd or croak $!;
1634 open my $wfd, '>', $to or croak $!;
1635 binmode $wfd or croak $!;
1636 eol_cp_fd($rfd, $wfd, $es);
1637 close $rfd or croak $!;
1638 close $wfd or croak $!;
1639}
1640sub eol_cp_fd {
1642 my ($rfd, $wfd, $es) = @_;
1643 my $eol = defined $es ? $EOL{$es} : undef;
1644 my $buf;
1645 use bytes;
1646 while (1) {
1647 my ($r, $w, $t);
1648 defined($r = sysread($rfd, $buf, 4096)) or croak $!;
1649 return unless $r;
1650 if ($eol) {
1651 if ($buf =~ /\015$/) {
1652 my $c;
1653 defined($r = sysread($rfd,$c,1)) or croak $!;
1654 $buf .= $c if $r > 0;
1655 }
1656 $buf =~ s/(?:\015\012|\015|\012)/$eol/gs;
1657 $r = length($buf);
1658 }
1659 for ($w = 0; $w < $r; $w += $t) {
1660 $t = syswrite($wfd, $buf, $r - $w, $w) or croak $!;
1661 }
1662 }
1663 no bytes;
1664}
1665sub do_update_index {
1667 my ($z_cmd, $cmd, $no_text_base) = @_;
1668 my $z = open my $p, '-|';
1670 defined $z or croak $!;
1671 unless ($z) { exec @$z_cmd or croak $! }
1672 my $pid = open my $ui, '|-';
1674 defined $pid or croak $!;
1675 unless ($pid) {
1676 exec('git-update-index',"--$cmd",'-z','--stdin') or croak $!;
1677 }
1678 local $/ = "\0";
1679 while (my $x = <$p>) {
1680 chomp $x;
1681 if (!$no_text_base && lstat $x && ! -l _ &&
1682 svn_propget_base('svn:keywords', $x)) {
1683 my $mode = -x _ ? 0755 : 0644;
1684 my ($v,$d,$f) = File::Spec->splitpath($x);
1685 my $tb = File::Spec->catfile($d, '.svn', 'tmp',
1686 'text-base',"$f.svn-base");
1687 $tb =~ s#^/##;
1688 unless (-f $tb) {
1689 $tb = File::Spec->catfile($d, '.svn',
1690 'text-base',"$f.svn-base");
1691 $tb =~ s#^/##;
1692 }
1693 unlink $x or croak $!;
1694 eol_cp($tb, $x);
1695 chmod(($mode &~ umask), $x) or croak $!;
1696 }
1697 print $ui $x,"\0";
1698 }
1699 close $ui or croak $?;
1700}
1701sub index_changes {
1703 return if $_use_lib;
1704 if (!-f "$GIT_SVN_DIR/info/exclude") {
1706 open my $fd, '>>', "$GIT_SVN_DIR/info/exclude" or croak $!;
1707 print $fd '.svn',"\n";
1708 close $fd or croak $!;
1709 }
1710 my $no_text_base = shift;
1711 do_update_index([qw/git-diff-files --name-only -z/],
1712 'remove',
1713 $no_text_base);
1714 do_update_index([qw/git-ls-files -z --others/,
1715 "--exclude-from=$GIT_SVN_DIR/info/exclude"],
1716 'add',
1717 $no_text_base);
1718}
1719sub s_to_file {
1721 my ($str, $file, $mode) = @_;
1722 open my $fd,'>',$file or croak $!;
1723 print $fd $str,"\n" or croak $!;
1724 close $fd or croak $!;
1725 chmod ($mode &~ umask, $file) if (defined $mode);
1726}
1727sub file_to_s {
1729 my $file = shift;
1730 open my $fd,'<',$file or croak "$!: file: $file\n";
1731 local $/;
1732 my $ret = <$fd>;
1733 close $fd or croak $!;
1734 $ret =~ s/\s*$//s;
1735 return $ret;
1736}
1737sub assert_revision_unknown {
1739 my $r = shift;
1740 if (my $c = revdb_get($REVDB, $r)) {
1741 croak "$r = $c already exists! Why are we refetching it?";
1742 }
1743}
1744sub trees_eq {
1746 my ($x, $y) = @_;
1747 my @x = safe_qx('git-cat-file','commit',$x);
1748 my @y = safe_qx('git-cat-file','commit',$y);
1749 if (($y[0] ne $x[0]) || $x[0] !~ /^tree $sha1\n$/
1750 || $y[0] !~ /^tree $sha1\n$/) {
1751 print STDERR "Trees not equal: $y[0] != $x[0]\n";
1752 return 0
1753 }
1754 return 1;
1755}
1756sub git_commit {
1758 my ($log_msg, @parents) = @_;
1759 assert_revision_unknown($log_msg->{revision});
1760 map_tree_joins() if (@_branch_from && !%tree_map);
1761 my (@tmp_parents, @exec_parents, %seen_parent);
1763 if (my $lparents = $log_msg->{parents}) {
1764 @tmp_parents = @$lparents
1765 }
1766 # commit parents can be conditionally bound to a particular
1767 # svn revision via: "svn_revno=commit_sha1", filter them out here:
1768 foreach my $p (@parents) {
1769 next unless defined $p;
1770 if ($p =~ /^(\d+)=($sha1_short)$/o) {
1771 if ($1 == $log_msg->{revision}) {
1772 push @tmp_parents, $2;
1773 }
1774 } else {
1775 push @tmp_parents, $p if $p =~ /$sha1_short/o;
1776 }
1777 }
1778 my $tree = $log_msg->{tree};
1779 if (!defined $tree) {
1780 my $index = set_index($GIT_SVN_INDEX);
1781 index_changes();
1782 chomp($tree = `git-write-tree`);
1783 croak $? if $?;
1784 restore_index($index);
1785 }
1786 if (exists $tree_map{$tree}) {
1787 push @tmp_parents, @{$tree_map{$tree}};
1788 }
1789 foreach (@tmp_parents) {
1790 next if $seen_parent{$_};
1791 $seen_parent{$_} = 1;
1792 push @exec_parents, $_;
1793 # MAXPARENT is defined to 16 in commit-tree.c:
1794 last if @exec_parents > 16;
1795 }
1796 defined(my $pid = open my $out_fh, '-|') or croak $!;
1798 if ($pid == 0) {
1799 my $msg_fh = IO::File->new_tmpfile or croak $!;
1800 print $msg_fh $log_msg->{msg}, "\ngit-svn-id: ",
1801 "$SVN_URL\@$log_msg->{revision}",
1802 " $SVN_UUID\n" or croak $!;
1803 $msg_fh->flush == 0 or croak $!;
1804 seek $msg_fh, 0, 0 or croak $!;
1805 set_commit_env($log_msg);
1806 my @exec = ('git-commit-tree',$tree);
1807 push @exec, '-p', $_ foreach @exec_parents;
1808 open STDIN, '<&', $msg_fh or croak $!;
1809 exec @exec or croak $!;
1810 }
1811 chomp(my $commit = do { local $/; <$out_fh> });
1812 close $out_fh or croak $?;
1813 if ($commit !~ /^$sha1$/o) {
1814 croak "Failed to commit, invalid sha1: $commit\n";
1815 }
1816 my @update_ref = ('git-update-ref',"refs/remotes/$GIT_SVN",$commit);
1817 if (my $primary_parent = shift @exec_parents) {
1818 quiet_run(qw/git-rev-parse --verify/,"refs/remotes/$GIT_SVN^0");
1819 push @update_ref, $primary_parent unless $?;
1820 }
1821 sys(@update_ref);
1822 revdb_set($REVDB, $log_msg->{revision}, $commit);
1823 # this output is read via pipe, do not change:
1825 print "r$log_msg->{revision} = $commit\n";
1826 check_repack();
1827 return $commit;
1828}
1829sub check_repack {
1831 if ($_repack && (--$_repack_nr == 0)) {
1832 $_repack_nr = $_repack;
1833 sys("git repack $_repack_flags");
1834 }
1835}
1836sub set_commit_env {
1838 my ($log_msg) = @_;
1839 my $author = $log_msg->{author};
1840 if (!defined $author || length $author == 0) {
1841 $author = '(no author)';
1842 }
1843 my ($name,$email) = defined $users{$author} ? @{$users{$author}}
1844 : ($author,"$author\@$SVN_UUID");
1845 $ENV{GIT_AUTHOR_NAME} = $ENV{GIT_COMMITTER_NAME} = $name;
1846 $ENV{GIT_AUTHOR_EMAIL} = $ENV{GIT_COMMITTER_EMAIL} = $email;
1847 $ENV{GIT_AUTHOR_DATE} = $ENV{GIT_COMMITTER_DATE} = $log_msg->{date};
1848}
1849sub apply_mod_line_blob {
1851 my $m = shift;
1852 if ($m->{mode_b} =~ /^120/) {
1853 blob_to_symlink($m->{sha1_b}, $m->{file_b});
1854 } else {
1855 blob_to_file($m->{sha1_b}, $m->{file_b});
1856 }
1857}
1858sub blob_to_symlink {
1860 my ($blob, $link) = @_;
1861 defined $link or croak "\$link not defined!\n";
1862 croak "Not a sha1: $blob\n" unless $blob =~ /^$sha1$/o;
1863 if (-l $link || -f _) {
1864 unlink $link or croak $!;
1865 }
1866 my $dest = `git-cat-file blob $blob`; # no newline, so no chomp
1868 symlink $dest, $link or croak $!;
1869}
1870sub blob_to_file {
1872 my ($blob, $file) = @_;
1873 defined $file or croak "\$file not defined!\n";
1874 croak "Not a sha1: $blob\n" unless $blob =~ /^$sha1$/o;
1875 if (-l $file || -f _) {
1876 unlink $file or croak $!;
1877 }
1878 open my $blob_fh, '>', $file or croak "$!: $file\n";
1880 my $pid = fork;
1881 defined $pid or croak $!;
1882 if ($pid == 0) {
1884 open STDOUT, '>&', $blob_fh or croak $!;
1885 exec('git-cat-file','blob',$blob) or croak $!;
1886 }
1887 waitpid $pid, 0;
1888 croak $? if $?;
1889 close $blob_fh or croak $!;
1891}
1892sub safe_qx {
1894 my $pid = open my $child, '-|';
1895 defined $pid or croak $!;
1896 if ($pid == 0) {
1897 exec(@_) or croak $!;
1898 }
1899 my @ret = (<$child>);
1900 close $child or croak $?;
1901 die $? if $?; # just in case close didn't error out
1902 return wantarray ? @ret : join('',@ret);
1903}
1904sub svn_compat_check {
1906 my @co_help = safe_qx(qw(svn co -h));
1907 unless (grep /ignore-externals/,@co_help) {
1908 print STDERR "W: Installed svn version does not support ",
1909 "--ignore-externals\n";
1910 $_no_ignore_ext = 1;
1911 }
1912 if (grep /usage: checkout URL\[\@REV\]/,@co_help) {
1913 $_svn_co_url_revs = 1;
1914 }
1915 if (grep /\[TARGET\[\@REV\]\.\.\.\]/, `svn propget -h`) {
1916 $_svn_pg_peg_revs = 1;
1917 }
1918 # I really, really hope nobody hits this...
1920 unless (grep /stop-on-copy/, (safe_qx(qw(svn log -h)))) {
1921 print STDERR <<'';
1922W: The installed svn version does not support the --stop-on-copy flag in
1923 the log command.
1924 Lets hope the directory you're tracking is not a branch or tag
1925 and was never moved within the repository...
1926 $_no_stop_copy = 1;
1928 }
1929}
1930# *sigh*, new versions of svn won't honor -r<rev> without URL@<rev>,
1932# (and they won't honor URL@<rev> without -r<rev>, too!)
1933sub svn_cmd_checkout {
1934 my ($url, $rev, $dir) = @_;
1935 my @cmd = ('svn','co', "-r$rev");
1936 push @cmd, '--ignore-externals' unless $_no_ignore_ext;
1937 $url .= "\@$rev" if $_svn_co_url_revs;
1938 sys(@cmd, $url, $dir);
1939}
1940sub check_upgrade_needed {
1942 if (!-r $REVDB) {
1943 open my $fh, '>>',$REVDB or croak $!;
1944 close $fh;
1945 }
1946 my $old = eval {
1947 my $pid = open my $child, '-|';
1948 defined $pid or croak $!;
1949 if ($pid == 0) {
1950 close STDERR;
1951 exec('git-rev-parse',"$GIT_SVN-HEAD") or croak $!;
1952 }
1953 my @ret = (<$child>);
1954 close $child or croak $?;
1955 die $? if $?; # just in case close didn't error out
1956 return wantarray ? @ret : join('',@ret);
1957 };
1958 return unless $old;
1959 my $head = eval { safe_qx('git-rev-parse',"refs/remotes/$GIT_SVN") };
1960 if ($@ || !$head) {
1961 print STDERR "Please run: $0 rebuild --upgrade\n";
1962 exit 1;
1963 }
1964}
1965# fills %tree_map with a reverse mapping of trees to commits. Useful
1967# for finding parents to commit on.
1968sub map_tree_joins {
1969 my %seen;
1970 foreach my $br (@_branch_from) {
1971 my $pid = open my $pipe, '-|';
1972 defined $pid or croak $!;
1973 if ($pid == 0) {
1974 exec(qw(git-rev-list --topo-order --pretty=raw), $br)
1975 or croak $!;
1976 }
1977 while (<$pipe>) {
1978 if (/^commit ($sha1)$/o) {
1979 my $commit = $1;
1980 # if we've seen a commit,
1982 # we've seen its parents
1983 last if $seen{$commit};
1984 my ($tree) = (<$pipe> =~ /^tree ($sha1)$/o);
1985 unless (defined $tree) {
1986 die "Failed to parse commit $commit\n";
1987 }
1988 push @{$tree_map{$tree}}, $commit;
1989 $seen{$commit} = 1;
1990 }
1991 }
1992 close $pipe; # we could be breaking the pipe early
1993 }
1994}
1995sub load_all_refs {
1997 if (@_branch_from) {
1998 print STDERR '--branch|-b parameters are ignored when ',
1999 "--branch-all-refs|-B is passed\n";
2000 }
2001 # don't worry about rev-list on non-commit objects/tags,
2003 # it shouldn't blow up if a ref is a blob or tree...
2004 chomp(@_branch_from = `git-rev-parse --symbolic --all`);
2005}
2006# '<svn username> = real-name <email address>' mapping based on git-svnimport:
2008sub load_authors {
2009 open my $authors, '<', $_authors or die "Can't open $_authors $!\n";
2010 while (<$authors>) {
2011 chomp;
2012 next unless /^(\S+?)\s*=\s*(.+?)\s*<(.+)>\s*$/;
2013 my ($user, $name, $email) = ($1, $2, $3);
2014 $users{$user} = [$name, $email];
2015 }
2016 close $authors or croak $!;
2017}
2018sub rload_authors {
2020 open my $authors, '<', $_authors or die "Can't open $_authors $!\n";
2021 while (<$authors>) {
2022 chomp;
2023 next unless /^(\S+?)\s*=\s*(.+?)\s*<(.+)>\s*$/;
2024 my ($user, $name, $email) = ($1, $2, $3);
2025 $rusers{"$name <$email>"} = $user;
2026 }
2027 close $authors or croak $!;
2028}
2029sub svn_propget_base {
2031 my ($p, $f) = @_;
2032 $f .= '@BASE' if $_svn_pg_peg_revs;
2033 return safe_qx(qw/svn propget/, $p, $f);
2034}
2035sub git_svn_each {
2037 my $sub = shift;
2038 foreach (`git-rev-parse --symbolic --all`) {
2039 next unless s#^refs/remotes/##;
2040 chomp $_;
2041 next unless -f "$GIT_DIR/svn/$_/info/url";
2042 &$sub($_);
2043 }
2044}
2045sub migrate_revdb {
2047 git_svn_each(sub {
2048 my $id = shift;
2049 defined(my $pid = fork) or croak $!;
2050 if (!$pid) {
2051 $GIT_SVN = $ENV{GIT_SVN_ID} = $id;
2052 init_vars();
2053 exit 0 if -r $REVDB;
2054 print "Upgrading svn => git mapping...\n";
2055 open my $fh, '>>',$REVDB or croak $!;
2056 close $fh;
2057 rebuild();
2058 print "Done upgrading. You may now delete the ",
2059 "deprecated $GIT_SVN_DIR/revs directory\n";
2060 exit 0;
2061 }
2062 waitpid $pid, 0;
2063 croak $? if $?;
2064 });
2065}
2066sub migration_check {
2068 migrate_revdb() unless (-e $REVDB);
2069 return if (-d "$GIT_DIR/svn" || !-d $GIT_DIR);
2070 print "Upgrading repository...\n";
2071 unless (-d "$GIT_DIR/svn") {
2072 mkdir "$GIT_DIR/svn" or croak $!;
2073 }
2074 print "Data from a previous version of git-svn exists, but\n\t",
2075 "$GIT_SVN_DIR\n\t(required for this version ",
2076 "($VERSION) of git-svn) does not.\n";
2077 foreach my $x (`git-rev-parse --symbolic --all`) {
2079 next unless $x =~ s#^refs/remotes/##;
2080 chomp $x;
2081 next unless -f "$GIT_DIR/$x/info/url";
2082 my $u = eval { file_to_s("$GIT_DIR/$x/info/url") };
2083 next unless $u;
2084 my $dn = dirname("$GIT_DIR/svn/$x");
2085 mkpath([$dn]) unless -d $dn;
2086 rename "$GIT_DIR/$x", "$GIT_DIR/svn/$x" or croak "$!: $x";
2087 }
2088 migrate_revdb() if (-d $GIT_SVN_DIR && !-w $REVDB);
2089 print "Done upgrading.\n";
2090}
2091sub find_rev_before {
2093 my ($r, $id, $eq_ok) = @_;
2094 my $f = "$GIT_DIR/svn/$id/.rev_db";
2095 return (undef,undef) unless -r $f;
2096 --$r unless $eq_ok;
2097 while ($r > 0) {
2098 if (my $c = revdb_get($f, $r)) {
2099 return ($r, $c);
2100 }
2101 --$r;
2102 }
2103 return (undef, undef);
2104}
2105sub init_vars {
2107 $GIT_SVN ||= $ENV{GIT_SVN_ID} || 'git-svn';
2108 $GIT_SVN_DIR = "$GIT_DIR/svn/$GIT_SVN";
2109 $REVDB = "$GIT_SVN_DIR/.rev_db";
2110 $GIT_SVN_INDEX = "$GIT_SVN_DIR/index";
2111 $SVN_URL = undef;
2112 $SVN_WC = "$GIT_SVN_DIR/tree";
2113}
2114# convert GetOpt::Long specs for use by git-repo-config
2116sub read_repo_config {
2117 return unless -d $GIT_DIR;
2118 my $opts = shift;
2119 foreach my $o (keys %$opts) {
2120 my $v = $opts->{$o};
2121 my ($key) = ($o =~ /^([a-z\-]+)/);
2122 $key =~ s/-//g;
2123 my $arg = 'git-repo-config';
2124 $arg .= ' --int' if ($o =~ /[:=]i$/);
2125 $arg .= ' --bool' if ($o !~ /[:=][sfi]$/);
2126 if (ref $v eq 'ARRAY') {
2127 chomp(my @tmp = `$arg --get-all svn.$key`);
2128 @$v = @tmp if @tmp;
2129 } else {
2130 chomp(my $tmp = `$arg --get svn.$key`);
2131 if ($tmp && !($arg =~ / --bool / && $tmp eq 'false')) {
2132 $$v = $tmp;
2133 }
2134 }
2135 }
2136}
2137sub set_default_vals {
2139 if (defined $_repack) {
2140 $_repack = 1000 if ($_repack <= 0);
2141 $_repack_nr = $_repack;
2142 $_repack_flags ||= '-d';
2143 }
2144}
2145sub read_grafts {
2147 my $gr_file = shift;
2148 my ($grafts, $comments) = ({}, {});
2149 if (open my $fh, '<', $gr_file) {
2150 my @tmp;
2151 while (<$fh>) {
2152 if (/^($sha1)\s+/) {
2153 my $c = $1;
2154 if (@tmp) {
2155 @{$comments->{$c}} = @tmp;
2156 @tmp = ();
2157 }
2158 foreach my $p (split /\s+/, $_) {
2159 $grafts->{$c}->{$p} = 1;
2160 }
2161 } else {
2162 push @tmp, $_;
2163 }
2164 }
2165 close $fh or croak $!;
2166 @{$comments->{'END'}} = @tmp if @tmp;
2167 }
2168 return ($grafts, $comments);
2169}
2170sub write_grafts {
2172 my ($grafts, $comments, $gr_file) = @_;
2173 open my $fh, '>', $gr_file or croak $!;
2175 foreach my $c (sort keys %$grafts) {
2176 if ($comments->{$c}) {
2177 print $fh $_ foreach @{$comments->{$c}};
2178 }
2179 my $p = $grafts->{$c};
2180 delete $p->{$c}; # commits are not self-reproducing...
2181 my $pid = open my $ch, '-|';
2182 defined $pid or croak $!;
2183 if (!$pid) {
2184 exec(qw/git-cat-file commit/, $c) or croak $!;
2185 }
2186 while (<$ch>) {
2187 if (/^parent ([a-f\d]{40})/) {
2188 $p->{$1} = 1;
2189 } else {
2190 last unless /^\S/i;
2191 }
2192 }
2193 close $ch; # breaking the pipe
2194 print $fh $c, ' ', join(' ', sort keys %$p),"\n";
2195 }
2196 if ($comments->{'END'}) {
2197 print $fh $_ foreach @{$comments->{'END'}};
2198 }
2199 close $fh or croak $!;
2200}
2201sub read_url_paths {
2203 my $l_map = {};
2204 git_svn_each(sub { my $x = shift;
2205 my $url = file_to_s("$GIT_DIR/svn/$x/info/url");
2206 my ($u, $p) = repo_path_split($url);
2207 $l_map->{$u}->{$p} = $x;
2208 });
2209 return $l_map;
2210}
2211sub extract_metadata {
2213 my $id = shift;
2214 my ($url, $rev, $uuid) = ($id =~ /^git-svn-id:\s(\S+?)\@(\d+)
2215 \s([a-f\d\-]+)$/x);
2216 if (!$rev || !$uuid || !$url) {
2217 # some of the original repositories I made had
2218 # indentifiers like this:
2219 ($rev, $uuid) = ($id =~/^git-svn-id:\s(\d+)\@([a-f\d\-]+)/);
2220 }
2221 return ($url, $rev, $uuid);
2222}
2223sub tz_to_s_offset {
2225 my ($tz) = @_;
2226 $tz =~ s/(\d\d)$//;
2227 return ($1 * 60) + ($tz * 3600);
2228}
2229sub setup_pager { # translated to Perl from pager.c
2231 return unless (-t *STDOUT);
2232 my $pager = $ENV{PAGER};
2233 if (!defined $pager) {
2234 $pager = 'less';
2235 } elsif (length $pager == 0 || $pager eq 'cat') {
2236 return;
2237 }
2238 pipe my $rfd, my $wfd or return;
2239 defined(my $pid = fork) or croak $!;
2240 if (!$pid) {
2241 open STDOUT, '>&', $wfd or croak $!;
2242 return;
2243 }
2244 open STDIN, '<&', $rfd or croak $!;
2245 $ENV{LESS} ||= '-S';
2246 exec $pager or croak "Can't run pager: $!\n";;
2247}
2248sub get_author_info {
2250 my ($dest, $author, $t, $tz) = @_;
2251 $author =~ s/(?:^\s*|\s*$)//g;
2252 $dest->{a_raw} = $author;
2253 my $_a;
2254 if ($_authors) {
2255 $_a = $rusers{$author} || undef;
2256 }
2257 if (!$_a) {
2258 ($_a) = ($author =~ /<([^>]+)\@[^>]+>$/);
2259 }
2260 $dest->{t} = $t;
2261 $dest->{tz} = $tz;
2262 $dest->{a} = $_a;
2263 # Date::Parse isn't in the standard Perl distro :(
2264 if ($tz =~ s/^\+//) {
2265 $t += tz_to_s_offset($tz);
2266 } elsif ($tz =~ s/^\-//) {
2267 $t -= tz_to_s_offset($tz);
2268 }
2269 $dest->{t_utc} = $t;
2270}
2271sub process_commit {
2273 my ($c, $r_min, $r_max, $defer) = @_;
2274 if (defined $r_min && defined $r_max) {
2275 if ($r_min == $c->{r} && $r_min == $r_max) {
2276 show_commit($c);
2277 return 0;
2278 }
2279 return 1 if $r_min == $r_max;
2280 if ($r_min < $r_max) {
2281 # we need to reverse the print order
2282 return 0 if (defined $_limit && --$_limit < 0);
2283 push @$defer, $c;
2284 return 1;
2285 }
2286 if ($r_min != $r_max) {
2287 return 1 if ($r_min < $c->{r});
2288 return 1 if ($r_max > $c->{r});
2289 }
2290 }
2291 return 0 if (defined $_limit && --$_limit < 0);
2292 show_commit($c);
2293 return 1;
2294}
2295sub show_commit {
2297 my $c = shift;
2298 if ($_oneline) {
2299 my $x = "\n";
2300 if (my $l = $c->{l}) {
2301 while ($l->[0] =~ /^\s*$/) { shift @$l }
2302 $x = $l->[0];
2303 }
2304 $_l_fmt ||= 'A' . length($c->{r});
2305 print 'r',pack($_l_fmt, $c->{r}),' | ';
2306 print "$c->{c} | " if $_show_commit;
2307 print $x;
2308 } else {
2309 show_commit_normal($c);
2310 }
2311}
2312sub show_commit_normal {
2314 my ($c) = @_;
2315 print '-' x72, "\nr$c->{r} | ";
2316 print "$c->{c} | " if $_show_commit;
2317 print "$c->{a} | ", strftime("%Y-%m-%d %H:%M:%S %z (%a, %d %b %Y)",
2318 localtime($c->{t_utc})), ' | ';
2319 my $nr_line = 0;
2320 if (my $l = $c->{l}) {
2322 while ($l->[$#$l] eq "\n" && $l->[($#$l - 1)] eq "\n") {
2323 pop @$l;
2324 }
2325 $nr_line = scalar @$l;
2326 if (!$nr_line) {
2327 print "1 line\n\n\n";
2328 } else {
2329 if ($nr_line == 1) {
2330 $nr_line = '1 line';
2331 } else {
2332 $nr_line .= ' lines';
2333 }
2334 print $nr_line, "\n\n";
2335 print $_ foreach @$l;
2336 }
2337 } else {
2338 print "1 line\n\n";
2339 }
2341 foreach my $x (qw/raw diff/) {
2342 if ($c->{$x}) {
2343 print "\n";
2344 print $_ foreach @{$c->{$x}}
2345 }
2346 }
2347}
2348sub libsvn_load {
2350 return unless $_use_lib;
2351 $_use_lib = eval {
2352 require SVN::Core;
2353 if ($SVN::Core::VERSION lt '1.2.1') {
2354 die "Need SVN::Core 1.2.1 or better ",
2355 "(got $SVN::Core::VERSION) ",
2356 "Falling back to command-line svn\n";
2357 }
2358 require SVN::Ra;
2359 require SVN::Delta;
2360 push @SVN::Git::Editor::ISA, 'SVN::Delta::Editor';
2361 my $kill_stupid_warnings = $SVN::Node::none.$SVN::Node::file.
2362 $SVN::Node::dir.$SVN::Node::unknown.
2363 $SVN::Node::none.$SVN::Node::file.
2364 $SVN::Node::dir.$SVN::Node::unknown;
2365 1;
2366 };
2367}
2368sub libsvn_connect {
2370 my ($url) = @_;
2371 my $auth = SVN::Core::auth_open([SVN::Client::get_simple_provider(),
2372 SVN::Client::get_ssl_server_trust_file_provider(),
2373 SVN::Client::get_username_provider()]);
2374 my $s = eval { SVN::Ra->new(url => $url, auth => $auth) };
2375 return $s;
2376}
2377sub libsvn_get_file {
2379 my ($gui, $f, $rev) = @_;
2380 my $p = $f;
2381 return unless ($p =~ s#^\Q$SVN_PATH\E/?##);
2382 my ($hash, $pid, $in, $out);
2384 my $pool = SVN::Pool->new;
2385 defined($pid = open3($in, $out, '>&STDERR',
2386 qw/git-hash-object -w --stdin/)) or croak $!;
2387 my ($r, $props) = $SVN->get_file($f, $rev, $in, $pool);
2388 $in->flush == 0 or croak $!;
2389 close $in or croak $!;
2390 $pool->clear;
2391 chomp($hash = do { local $/; <$out> });
2392 close $out or croak $!;
2393 waitpid $pid, 0;
2394 $hash =~ /^$sha1$/o or die "not a sha1: $hash\n";
2395 my $mode = exists $props->{'svn:executable'} ? '100755' : '100644';
2397 if (exists $props->{'svn:special'}) {
2398 $mode = '120000';
2399 my $link = `git-cat-file blob $hash`;
2400 $link =~ s/^link // or die "svn:special file with contents: <",
2401 $link, "> is not understood\n";
2402 defined($pid = open3($in, $out, '>&STDERR',
2403 qw/git-hash-object -w --stdin/)) or croak $!;
2404 print $in $link;
2405 $in->flush == 0 or croak $!;
2406 close $in or croak $!;
2407 chomp($hash = do { local $/; <$out> });
2408 close $out or croak $!;
2409 waitpid $pid, 0;
2410 $hash =~ /^$sha1$/o or die "not a sha1: $hash\n";
2411 }
2412 print $gui $mode,' ',$hash,"\t",$p,"\0" or croak $!;
2413}
2414sub libsvn_log_entry {
2416 my ($rev, $author, $date, $msg, $parents) = @_;
2417 my ($Y,$m,$d,$H,$M,$S) = ($date =~ /^(\d{4})\-(\d\d)\-(\d\d)T
2418 (\d\d)\:(\d\d)\:(\d\d).\d+Z$/x)
2419 or die "Unable to parse date: $date\n";
2420 if (defined $_authors && ! defined $users{$author}) {
2421 die "Author: $author not defined in $_authors file\n";
2422 }
2423 return { revision => $rev, date => "+0000 $Y-$m-$d $H:$M:$S",
2424 author => $author, msg => $msg."\n", parents => $parents || [] }
2425}
2426sub process_rm {
2428 my ($gui, $last_commit, $f) = @_;
2429 $f =~ s#^\Q$SVN_PATH\E/?## or return;
2430 # remove entire directories.
2431 if (safe_qx('git-ls-tree',$last_commit,'--',$f) =~ /^040000 tree/) {
2432 defined(my $pid = open my $ls, '-|') or croak $!;
2433 if (!$pid) {
2434 exec(qw/git-ls-tree -r --name-only -z/,
2435 $last_commit,'--',$f) or croak $!;
2436 }
2437 local $/ = "\0";
2438 while (<$ls>) {
2439 print $gui '0 ',0 x 40,"\t",$_ or croak $!;
2440 }
2441 close $ls or croak $?;
2442 } else {
2443 print $gui '0 ',0 x 40,"\t",$f,"\0" or croak $!;
2444 }
2445}
2446sub libsvn_fetch {
2448 my ($last_commit, $paths, $rev, $author, $date, $msg) = @_;
2449 open my $gui, '| git-update-index -z --index-info' or croak $!;
2450 my @amr;
2451 foreach my $f (keys %$paths) {
2452 my $m = $paths->{$f}->action();
2453 $f =~ s#^/+##;
2454 if ($m =~ /^[DR]$/) {
2455 process_rm($gui, $last_commit, $f);
2456 next if $m eq 'D';
2457 # 'R' can be file replacements, too, right?
2458 }
2459 my $pool = SVN::Pool->new;
2460 my $t = $SVN->check_path($f, $rev, $pool);
2461 if ($t == $SVN::Node::file) {
2462 if ($m =~ /^[AMR]$/) {
2463 push @amr, $f;
2464 } else {
2465 die "Unrecognized action: $m, ($f r$rev)\n";
2466 }
2467 }
2468 $pool->clear;
2469 }
2470 libsvn_get_file($gui, $_, $rev) foreach (@amr);
2471 close $gui or croak $?;
2472 return libsvn_log_entry($rev, $author, $date, $msg, [$last_commit]);
2473}
2474sub svn_grab_base_rev {
2476 defined(my $pid = open my $fh, '-|') or croak $!;
2477 if (!$pid) {
2478 open my $null, '>', '/dev/null' or croak $!;
2479 open STDERR, '>&', $null or croak $!;
2480 exec qw/git-rev-parse --verify/,"refs/remotes/$GIT_SVN^0"
2481 or croak $!;
2482 }
2483 chomp(my $c = do { local $/; <$fh> });
2484 close $fh;
2485 if (defined $c && length $c) {
2486 my ($url, $rev, $uuid) = extract_metadata((grep(/^git-svn-id: /,
2487 safe_qx(qw/git-cat-file commit/, $c)))[-1]);
2488 return ($rev, $c);
2489 }
2490 return (undef, undef);
2491}
2492sub libsvn_parse_revision {
2494 my $base = shift;
2495 my $head = $SVN->get_latest_revnum();
2496 if (!defined $_revision || $_revision eq 'BASE:HEAD') {
2497 return ($base + 1, $head) if (defined $base);
2498 return (0, $head);
2499 }
2500 return ($1, $2) if ($_revision =~ /^(\d+):(\d+)$/);
2501 return ($_revision, $_revision) if ($_revision =~ /^\d+$/);
2502 if ($_revision =~ /^BASE:(\d+)$/) {
2503 return ($base + 1, $1) if (defined $base);
2504 return (0, $head);
2505 }
2506 return ($1, $head) if ($_revision =~ /^(\d+):HEAD$/);
2507 die "revision argument: $_revision not understood by git-svn\n",
2508 "Try using the command-line svn client instead\n";
2509}
2510sub libsvn_traverse {
2512 my ($gui, $pfx, $path, $rev) = @_;
2513 my $cwd = "$pfx/$path";
2514 my $pool = SVN::Pool->new;
2515 $cwd =~ s#^/+##g;
2516 my ($dirent, $r, $props) = $SVN->get_dir($cwd, $rev, $pool);
2517 foreach my $d (keys %$dirent) {
2518 my $t = $dirent->{$d}->kind;
2519 if ($t == $SVN::Node::dir) {
2520 libsvn_traverse($gui, $cwd, $d, $rev);
2521 } elsif ($t == $SVN::Node::file) {
2522 libsvn_get_file($gui, "$cwd/$d", $rev);
2523 }
2524 }
2525 $pool->clear;
2526}
2527sub libsvn_traverse_ignore {
2529 my ($fh, $path, $r) = @_;
2530 $path =~ s#^/+##g;
2531 my $pool = SVN::Pool->new;
2532 my ($dirent, undef, $props) = $SVN->get_dir($path, $r, $pool);
2533 my $p = $path;
2534 $p =~ s#^\Q$SVN_PATH\E/?##;
2535 print $fh length $p ? "\n# $p\n" : "\n# /\n";
2536 if (my $s = $props->{'svn:ignore'}) {
2537 $s =~ s/[\r\n]+/\n/g;
2538 chomp $s;
2539 if (length $p == 0) {
2540 $s =~ s#\n#\n/$p#g;
2541 print $fh "/$s\n";
2542 } else {
2543 $s =~ s#\n#\n/$p/#g;
2544 print $fh "/$p/$s\n";
2545 }
2546 }
2547 foreach (sort keys %$dirent) {
2548 next if $dirent->{$_}->kind != $SVN::Node::dir;
2549 libsvn_traverse_ignore($fh, "$path/$_", $r);
2550 }
2551 $pool->clear;
2552}
2553sub revisions_eq {
2555 my ($path, $r0, $r1) = @_;
2556 return 1 if $r0 == $r1;
2557 my $nr = 0;
2558 if ($_use_lib) {
2559 # should be OK to use Pool here (r1 - r0) should be small
2560 my $pool = SVN::Pool->new;
2561 $SVN->get_log("/$path", $r0, $r1, 0, 1, 1, sub {$nr++},$pool);
2562 $pool->clear;
2563 } else {
2564 my ($url, undef) = repo_path_split($SVN_URL);
2565 my $svn_log = svn_log_raw("$url/$path","-r$r0:$r1");
2566 while (next_log_entry($svn_log)) { $nr++ }
2567 close $svn_log->{fh};
2568 }
2569 return 0 if ($nr > 1);
2570 return 1;
2571}
2572sub libsvn_find_parent_branch {
2574 my ($paths, $rev, $author, $date, $msg) = @_;
2575 my $svn_path = '/'.$SVN_PATH;
2576 # look for a parent from another branch:
2578 my $i = $paths->{$svn_path} or return;
2579 my $branch_from = $i->copyfrom_path or return;
2580 my $r = $i->copyfrom_rev;
2581 print STDERR "Found possible branch point: ",
2582 "$branch_from => $svn_path, $r\n";
2583 $branch_from =~ s#^/##;
2584 my $l_map = read_url_paths();
2585 my $url = $SVN->{url};
2586 defined $l_map->{$url} or return;
2587 my $id = $l_map->{$url}->{$branch_from} or return;
2588 my ($r0, $parent) = find_rev_before($r,$id,1);
2589 return unless (defined $r0 && defined $parent);
2590 if (revisions_eq($branch_from, $r0, $r)) {
2591 unlink $GIT_SVN_INDEX;
2592 print STDERR "Found branch parent: $parent\n";
2593 sys(qw/git-read-tree/, $parent);
2594 return libsvn_fetch($parent, $paths, $rev,
2595 $author, $date, $msg);
2596 }
2597 print STDERR "Nope, branch point not imported or unknown\n";
2598 return undef;
2599}
2600sub libsvn_new_tree {
2602 if (my $log_entry = libsvn_find_parent_branch(@_)) {
2603 return $log_entry;
2604 }
2605 my ($paths, $rev, $author, $date, $msg) = @_;
2606 open my $gui, '| git-update-index -z --index-info' or croak $!;
2607 my $pool = SVN::Pool->new;
2608 libsvn_traverse($gui, '', $SVN_PATH, $rev, $pool);
2609 $pool->clear;
2610 close $gui or croak $?;
2611 return libsvn_log_entry($rev, $author, $date, $msg);
2612}
2613sub find_graft_path_commit {
2615 my ($tree_paths, $p1, $r1) = @_;
2616 foreach my $x (keys %$tree_paths) {
2617 next unless ($p1 =~ /^\Q$x\E/);
2618 my $i = $tree_paths->{$x};
2619 my ($r0, $parent) = find_rev_before($r1,$i,1);
2620 return $parent if (defined $r0 && $r0 == $r1);
2621 print STDERR "r$r1 of $i not imported\n";
2622 next;
2623 }
2624 return undef;
2625}
2626sub find_graft_path_parents {
2628 my ($grafts, $tree_paths, $c, $p0, $r0) = @_;
2629 foreach my $x (keys %$tree_paths) {
2630 next unless ($p0 =~ /^\Q$x\E/);
2631 my $i = $tree_paths->{$x};
2632 my ($r, $parent) = find_rev_before($r0, $i, 1);
2633 if (defined $r && defined $parent && revisions_eq($x,$r,$r0)) {
2634 $grafts->{$c}->{$parent} = 1;
2635 }
2636 }
2637}
2638sub libsvn_graft_file_copies {
2640 my ($grafts, $tree_paths, $path, $paths, $rev) = @_;
2641 foreach (keys %$paths) {
2642 my $i = $paths->{$_};
2643 my ($m, $p0, $r0) = ($i->action, $i->copyfrom_path,
2644 $i->copyfrom_rev);
2645 next unless (defined $p0 && defined $r0);
2646 my $p1 = $_;
2648 $p1 =~ s#^/##;
2649 $p0 =~ s#^/##;
2650 my $c = find_graft_path_commit($tree_paths, $p1, $rev);
2651 next unless $c;
2652 find_graft_path_parents($grafts, $tree_paths, $c, $p0, $r0);
2653 }
2654}
2655sub set_index {
2657 my $old = $ENV{GIT_INDEX_FILE};
2658 $ENV{GIT_INDEX_FILE} = shift;
2659 return $old;
2660}
2661sub restore_index {
2663 my ($old) = @_;
2664 if (defined $old) {
2665 $ENV{GIT_INDEX_FILE} = $old;
2666 } else {
2667 delete $ENV{GIT_INDEX_FILE};
2668 }
2669}
2670sub libsvn_commit_cb {
2672 my ($rev, $date, $committer, $c, $msg, $r_last, $cmt_last) = @_;
2673 if ($_optimize_commits && $rev == ($r_last + 1)) {
2674 my $log = libsvn_log_entry($rev,$committer,$date,$msg);
2675 $log->{tree} = get_tree_from_treeish($c);
2676 my $cmt = git_commit($log, $cmt_last, $c);
2677 my @diff = safe_qx('git-diff-tree', $cmt, $c);
2678 if (@diff) {
2679 print STDERR "Trees differ: $cmt $c\n",
2680 join('',@diff),"\n";
2681 exit 1;
2682 }
2683 } else {
2684 fetch("$rev=$c");
2685 }
2686}
2687sub libsvn_ls_fullurl {
2689 my $fullurl = shift;
2690 my ($repo, $path) = repo_path_split($fullurl);
2691 $SVN ||= libsvn_connect($repo);
2692 my @ret;
2693 my $pool = SVN::Pool->new;
2694 my ($dirent, undef, undef) = $SVN->get_dir($path,
2695 $SVN->get_latest_revnum, $pool);
2696 foreach my $d (keys %$dirent) {
2697 if ($dirent->{$d}->kind == $SVN::Node::dir) {
2698 push @ret, "$d/"; # add '/' for compat with cli svn
2699 }
2700 }
2701 $pool->clear;
2702 return @ret;
2703}
2704sub libsvn_skip_unknown_revs {
2707 my $err = shift;
2708 my $errno = $err->apr_err();
2709 # Maybe the branch we're tracking didn't
2710 # exist when the repo started, so it's
2711 # not an error if it doesn't, just continue
2712 #
2713 # Wonderfully consistent library, eh?
2714 # 160013 - svn:// and file://
2715 # 175002 - http(s)://
2716 # More codes may be discovered later...
2717 if ($errno == 175002 || $errno == 160013) {
2718 return;
2719 }
2720 croak "Error from SVN, ($errno): ", $err->expanded_message,"\n";
2721};
2722# Tie::File seems to be prone to offset errors if revisions get sparse,
2724# it's not that fast, either. Tie::File is also not in Perl 5.6. So
2725# one of my favorite modules is out :< Next up would be one of the DBM
2726# modules, but I'm not sure which is most portable... So I'll just
2727# go with something that's plain-text, but still capable of
2728# being randomly accessed. So here's my ultra-simple fixed-width
2729# database. All records are 40 characters + "\n", so it's easy to seek
2730# to a revision: (41 * rev) is the byte offset.
2731# A record of 40 0s denotes an empty revision.
2732# And yes, it's still pretty fast (faster than Tie::File).
2733sub revdb_set {
2734 my ($file, $rev, $commit) = @_;
2735 length $commit == 40 or croak "arg3 must be a full SHA1 hexsum\n";
2736 open my $fh, '+<', $file or croak $!;
2737 my $offset = $rev * 41;
2738 # assume that append is the common case:
2739 seek $fh, 0, 2 or croak $!;
2740 my $pos = tell $fh;
2741 if ($pos < $offset) {
2742 print $fh (('0' x 40),"\n") x (($offset - $pos) / 41);
2743 }
2744 seek $fh, $offset, 0 or croak $!;
2745 print $fh $commit,"\n";
2746 close $fh or croak $!;
2747}
2748sub revdb_get {
2750 my ($file, $rev) = @_;
2751 my $ret;
2752 my $offset = $rev * 41;
2753 open my $fh, '<', $file or croak $!;
2754 seek $fh, $offset, 0;
2755 if (tell $fh == $offset) {
2756 $ret = readline $fh;
2757 if (defined $ret) {
2758 chomp $ret;
2759 $ret = undef if ($ret =~ /^0{40}$/);
2760 }
2761 }
2762 close $fh or croak $!;
2763 return $ret;
2764}
2765package SVN::Git::Editor;
2767use vars qw/@ISA/;
2768use strict;
2769use warnings;
2770use Carp qw/croak/;
2771use IO::File;
2772sub new {
2774 my $class = shift;
2775 my $git_svn = shift;
2776 my $self = SVN::Delta::Editor->new(@_);
2777 bless $self, $class;
2778 foreach (qw/svn_path c r ra /) {
2779 die "$_ required!\n" unless (defined $git_svn->{$_});
2780 $self->{$_} = $git_svn->{$_};
2781 }
2782 $self->{pool} = SVN::Pool->new;
2783 $self->{bat} = { '' => $self->open_root($self->{r}, $self->{pool}) };
2784 $self->{rm} = { };
2785 require Digest::MD5;
2786 return $self;
2787}
2788sub split_path {
2790 return ($_[0] =~ m#^(.*?)/?([^/]+)$#);
2791}
2792sub repo_path {
2794 (defined $_[1] && length $_[1]) ? "$_[0]->{svn_path}/$_[1]"
2795 : $_[0]->{svn_path}
2796}
2797sub url_path {
2799 my ($self, $path) = @_;
2800 $self->{ra}->{url} . '/' . $self->repo_path($path);
2801}
2802sub rmdirs {
2804 my ($self) = @_;
2805 my $rm = $self->{rm};
2806 delete $rm->{''}; # we never delete the url we're tracking
2807 return unless %$rm;
2808 foreach (keys %$rm) {
2810 my @d = split m#/#, $_;
2811 my $c = shift @d;
2812 $rm->{$c} = 1;
2813 while (@d) {
2814 $c .= '/' . shift @d;
2815 $rm->{$c} = 1;
2816 }
2817 }
2818 delete $rm->{$self->{svn_path}};
2819 delete $rm->{''}; # we never delete the url we're tracking
2820 return unless %$rm;
2821 defined(my $pid = open my $fh,'-|') or croak $!;
2823 if (!$pid) {
2824 exec qw/git-ls-tree --name-only -r -z/, $self->{c} or croak $!;
2825 }
2826 local $/ = "\0";
2827 while (<$fh>) {
2828 chomp;
2829 $_ = $self->{svn_path} . '/' . $_;
2830 my ($dn) = ($_ =~ m#^(.*?)/?(?:[^/]+)$#);
2831 delete $rm->{$dn};
2832 last unless %$rm;
2833 }
2834 my ($r, $p, $bat) = ($self->{r}, $self->{pool}, $self->{bat});
2835 foreach my $d (sort { $b =~ tr#/#/# <=> $a =~ tr#/#/# } keys %$rm) {
2836 $self->close_directory($bat->{$d}, $p);
2837 my ($dn) = ($d =~ m#^(.*?)/?(?:[^/]+)$#);
2838 $self->SUPER::delete_entry($d, $r, $bat->{$dn}, $p);
2839 delete $bat->{$d};
2840 }
2841}
2842sub open_or_add_dir {
2844 my ($self, $full_path, $baton) = @_;
2845 my $p = SVN::Pool->new;
2846 my $t = $self->{ra}->check_path($full_path, $self->{r}, $p);
2847 $p->clear;
2848 if ($t == $SVN::Node::none) {
2849 return $self->add_directory($full_path, $baton,
2850 undef, -1, $self->{pool});
2851 } elsif ($t == $SVN::Node::dir) {
2852 return $self->open_directory($full_path, $baton,
2853 $self->{r}, $self->{pool});
2854 }
2855 print STDERR "$full_path already exists in repository at ",
2856 "r$self->{r} and it is not a directory (",
2857 ($t == $SVN::Node::file ? 'file' : 'unknown'),"/$t)\n";
2858 exit 1;
2859}
2860sub ensure_path {
2862 my ($self, $path) = @_;
2863 my $bat = $self->{bat};
2864 $path = $self->repo_path($path);
2865 return $bat->{''} unless (length $path);
2866 my @p = split m#/+#, $path;
2867 my $c = shift @p;
2868 $bat->{$c} ||= $self->open_or_add_dir($c, $bat->{''});
2869 while (@p) {
2870 my $c0 = $c;
2871 $c .= '/' . shift @p;
2872 $bat->{$c} ||= $self->open_or_add_dir($c, $bat->{$c0});
2873 }
2874 return $bat->{$c};
2875}
2876sub A {
2878 my ($self, $m) = @_;
2879 my ($dir, $file) = split_path($m->{file_b});
2880 my $pbat = $self->ensure_path($dir);
2881 my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
2882 undef, -1);
2883 $self->chg_file($fbat, $m);
2884 $self->close_file($fbat,undef,$self->{pool});
2885}
2886sub C {
2888 my ($self, $m) = @_;
2889 my ($dir, $file) = split_path($m->{file_b});
2890 my $pbat = $self->ensure_path($dir);
2891 my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
2892 $self->url_path($m->{file_a}), $self->{r});
2893 $self->chg_file($fbat, $m);
2894 $self->close_file($fbat,undef,$self->{pool});
2895}
2896sub delete_entry {
2898 my ($self, $path, $pbat) = @_;
2899 my $rpath = $self->repo_path($path);
2900 my ($dir, $file) = split_path($rpath);
2901 $self->{rm}->{$dir} = 1;
2902 $self->SUPER::delete_entry($rpath, $self->{r}, $pbat, $self->{pool});
2903}
2904sub R {
2906 my ($self, $m) = @_;
2907 my ($dir, $file) = split_path($m->{file_b});
2908 my $pbat = $self->ensure_path($dir);
2909 my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
2910 $self->url_path($m->{file_a}), $self->{r});
2911 $self->chg_file($fbat, $m);
2912 $self->close_file($fbat,undef,$self->{pool});
2913 ($dir, $file) = split_path($m->{file_a});
2915 $pbat = $self->ensure_path($dir);
2916 $self->delete_entry($m->{file_a}, $pbat);
2917}
2918sub M {
2920 my ($self, $m) = @_;
2921 my ($dir, $file) = split_path($m->{file_b});
2922 my $pbat = $self->ensure_path($dir);
2923 my $fbat = $self->open_file($self->repo_path($m->{file_b}),
2924 $pbat,$self->{r},$self->{pool});
2925 $self->chg_file($fbat, $m);
2926 $self->close_file($fbat,undef,$self->{pool});
2927}
2928sub T { shift->M(@_) }
2930sub change_file_prop {
2932 my ($self, $fbat, $pname, $pval) = @_;
2933 $self->SUPER::change_file_prop($fbat, $pname, $pval, $self->{pool});
2934}
2935sub chg_file {
2937 my ($self, $fbat, $m) = @_;
2938 if ($m->{mode_b} =~ /755$/ && $m->{mode_a} !~ /755$/) {
2939 $self->change_file_prop($fbat,'svn:executable','*');
2940 } elsif ($m->{mode_b} !~ /755$/ && $m->{mode_a} =~ /755$/) {
2941 $self->change_file_prop($fbat,'svn:executable',undef);
2942 }
2943 my $fh = IO::File->new_tmpfile or croak $!;
2944 if ($m->{mode_b} =~ /^120/) {
2945 print $fh 'link ' or croak $!;
2946 $self->change_file_prop($fbat,'svn:special','*');
2947 } elsif ($m->{mode_a} =~ /^120/ && $m->{mode_b} !~ /^120/) {
2948 $self->change_file_prop($fbat,'svn:special',undef);
2949 }
2950 defined(my $pid = fork) or croak $!;
2951 if (!$pid) {
2952 open STDOUT, '>&', $fh or croak $!;
2953 exec qw/git-cat-file blob/, $m->{sha1_b} or croak $!;
2954 }
2955 waitpid $pid, 0;
2956 croak $? if $?;
2957 $fh->flush == 0 or croak $!;
2958 seek $fh, 0, 0 or croak $!;
2959 my $md5 = Digest::MD5->new;
2961 $md5->addfile($fh) or croak $!;
2962 seek $fh, 0, 0 or croak $!;
2963 my $exp = $md5->hexdigest;
2965 my $atd = $self->apply_textdelta($fbat, undef, $self->{pool});
2966 my $got = SVN::TxDelta::send_stream($fh, @$atd, $self->{pool});
2967 die "Checksum mismatch\nexpected: $exp\ngot: $got\n" if ($got ne $exp);
2968 close $fh or croak $!;
2970}
2971sub D {
2973 my ($self, $m) = @_;
2974 my ($dir, $file) = split_path($m->{file_b});
2975 my $pbat = $self->ensure_path($dir);
2976 $self->delete_entry($m->{file_b}, $pbat);
2977}
2978sub close_edit {
2980 my ($self) = @_;
2981 my ($p,$bat) = ($self->{pool}, $self->{bat});
2982 foreach (sort { $b =~ tr#/#/# <=> $a =~ tr#/#/# } keys %$bat) {
2983 $self->close_directory($bat->{$_}, $p);
2984 }
2985 $self->SUPER::close_edit($p);
2986 $p->clear;
2987}
2988sub abort_edit {
2990 my ($self) = @_;
2991 $self->SUPER::abort_edit($self->{pool});
2992 $self->{pool}->clear;
2993}
2994__END__
2996Data structures:
2998$svn_log hashref (as returned by svn_log_raw)
3000{
3001 fh => file handle of the log file,
3002 state => state of the log file parser (sep/msg/rev/msg_start...)
3003}
3004$log_msg hashref as returned by next_log_entry($svn_log)
3006{
3007 msg => 'whitespace-formatted log entry
3008', # trailing newline is preserved
3009 revision => '8', # integer
3010 date => '2004-02-24T17:01:44.108345Z', # commit date
3011 author => 'committer name'
3012};
3013@mods = array of diff-index line hashes, each element represents one line
3016 of diff-index output
3017diff-index line ($m hash)
3019{
3020 mode_a => first column of diff-index output, no leading ':',
3021 mode_b => second column of diff-index output,
3022 sha1_b => sha1sum of the final blob,
3023 chg => change type [MCRADT],
3024 file_a => original file name of a file (iff chg is 'C' or 'R')
3025 file_b => new/current file name of a file (any chg)
3026}
3027;
3028Notes:
3030 I don't trust the each() function on unless I created %hash myself
3031 because the internal iterator may not have started at base.