/bin/git-folder/git-svn
Perl | 6688 lines | 5904 code | 466 blank | 318 comment | 831 complexity | f8dc95a377519c7d7caf1e4d02c3f9b1 MD5 | raw file
Possible License(s): GPL-2.0, LGPL-2.1, BSD-2-Clause
Large files files are truncated, but you can click here to view the full file
- #!/usr/bin/perl
- use lib (split(/:/, $ENV{GITPERLLIB} || "/home/pcheah/local/share/perl/5.12.4"));
- # Copyright (C) 2006, Eric Wong <normalperson@yhbt.net>
- # License: GPL v2 or later
- use 5.008;
- use warnings;
- use strict;
- use vars qw/ $AUTHOR $VERSION
- $sha1 $sha1_short $_revision $_repository
- $_q $_authors $_authors_prog %users/;
- $AUTHOR = 'Eric Wong <normalperson@yhbt.net>';
- $VERSION = '1.7.7.2';
- # From which subdir have we been invoked?
- my $cmd_dir_prefix = eval {
- command_oneline([qw/rev-parse --show-prefix/], STDERR => 0)
- } || '';
- my $git_dir_user_set = 1 if defined $ENV{GIT_DIR};
- $ENV{GIT_DIR} ||= '.git';
- $Git::SVN::default_repo_id = 'svn';
- $Git::SVN::default_ref_id = $ENV{GIT_SVN_ID} || 'git-svn';
- $Git::SVN::Ra::_log_window_size = 100;
- $Git::SVN::_minimize_url = 'unset';
- if (! exists $ENV{SVN_SSH}) {
- if (exists $ENV{GIT_SSH}) {
- $ENV{SVN_SSH} = $ENV{GIT_SSH};
- if ($^O eq 'msys') {
- $ENV{SVN_SSH} =~ s/\\/\\\\/g;
- $ENV{SVN_SSH} =~ s/(.*)/"$1"/;
- }
- }
- }
- $Git::SVN::Log::TZ = $ENV{TZ};
- $ENV{TZ} = 'UTC';
- $| = 1; # unbuffer STDOUT
- sub fatal (@) { print STDERR "@_\n"; exit 1 }
- sub _req_svn {
- require SVN::Core; # use()-ing this causes segfaults for me... *shrug*
- require SVN::Ra;
- require SVN::Delta;
- if ($SVN::Core::VERSION lt '1.1.0') {
- fatal "Need SVN::Core 1.1.0 or better (got $SVN::Core::VERSION)";
- }
- }
- my $can_compress = eval { require Compress::Zlib; 1};
- push @Git::SVN::Ra::ISA, 'SVN::Ra';
- push @SVN::Git::Editor::ISA, 'SVN::Delta::Editor';
- push @SVN::Git::Fetcher::ISA, 'SVN::Delta::Editor';
- use Carp qw/croak/;
- use Digest::MD5;
- use IO::File qw//;
- use File::Basename qw/dirname basename/;
- use File::Path qw/mkpath/;
- use File::Spec;
- use File::Find;
- use Getopt::Long qw/:config gnu_getopt no_ignore_case auto_abbrev/;
- use IPC::Open3;
- use Git;
- use Memoize; # core since 5.8.0, Jul 2002
- BEGIN {
- # import functions from Git into our packages, en masse
- no strict 'refs';
- foreach (qw/command command_oneline command_noisy command_output_pipe
- command_input_pipe command_close_pipe
- command_bidi_pipe command_close_bidi_pipe/) {
- for my $package ( qw(SVN::Git::Editor SVN::Git::Fetcher
- Git::SVN::Migration Git::SVN::Log Git::SVN),
- __PACKAGE__) {
- *{"${package}::$_"} = \&{"Git::$_"};
- }
- }
- Memoize::memoize 'Git::config';
- Memoize::memoize 'Git::config_bool';
- }
- my ($SVN);
- $sha1 = qr/[a-f\d]{40}/;
- $sha1_short = qr/[a-f\d]{4,40}/;
- my ($_stdin, $_help, $_edit,
- $_message, $_file, $_branch_dest,
- $_template, $_shared,
- $_version, $_fetch_all, $_no_rebase, $_fetch_parent,
- $_merge, $_strategy, $_dry_run, $_local,
- $_prefix, $_no_checkout, $_url, $_verbose,
- $_git_format, $_commit_url, $_tag, $_merge_info);
- $Git::SVN::_follow_parent = 1;
- $SVN::Git::Fetcher::_placeholder_filename = ".gitignore";
- $_q ||= 0;
- my %remote_opts = ( 'username=s' => \$Git::SVN::Prompt::_username,
- 'config-dir=s' => \$Git::SVN::Ra::config_dir,
- 'no-auth-cache' => \$Git::SVN::Prompt::_no_auth_cache,
- 'ignore-paths=s' => \$SVN::Git::Fetcher::_ignore_regex );
- my %fc_opts = ( 'follow-parent|follow!' => \$Git::SVN::_follow_parent,
- 'authors-file|A=s' => \$_authors,
- 'authors-prog=s' => \$_authors_prog,
- 'repack:i' => \$Git::SVN::_repack,
- 'noMetadata' => \$Git::SVN::_no_metadata,
- 'useSvmProps' => \$Git::SVN::_use_svm_props,
- 'useSvnsyncProps' => \$Git::SVN::_use_svnsync_props,
- 'log-window-size=i' => \$Git::SVN::Ra::_log_window_size,
- 'no-checkout' => \$_no_checkout,
- 'quiet|q+' => \$_q,
- 'repack-flags|repack-args|repack-opts=s' =>
- \$Git::SVN::_repack_flags,
- 'use-log-author' => \$Git::SVN::_use_log_author,
- 'add-author-from' => \$Git::SVN::_add_author_from,
- 'localtime' => \$Git::SVN::_localtime,
- %remote_opts );
- my ($_trunk, @_tags, @_branches, $_stdlayout);
- my %icv;
- my %init_opts = ( 'template=s' => \$_template, 'shared:s' => \$_shared,
- 'trunk|T=s' => \$_trunk, 'tags|t=s@' => \@_tags,
- 'branches|b=s@' => \@_branches, 'prefix=s' => \$_prefix,
- 'stdlayout|s' => \$_stdlayout,
- 'minimize-url|m!' => \$Git::SVN::_minimize_url,
- 'no-metadata' => sub { $icv{noMetadata} = 1 },
- 'use-svm-props' => sub { $icv{useSvmProps} = 1 },
- 'use-svnsync-props' => sub { $icv{useSvnsyncProps} = 1 },
- 'rewrite-root=s' => sub { $icv{rewriteRoot} = $_[1] },
- 'rewrite-uuid=s' => sub { $icv{rewriteUUID} = $_[1] },
- %remote_opts );
- my %cmt_opts = ( 'edit|e' => \$_edit,
- 'rmdir' => \$SVN::Git::Editor::_rmdir,
- 'find-copies-harder' => \$SVN::Git::Editor::_find_copies_harder,
- 'l=i' => \$SVN::Git::Editor::_rename_limit,
- 'copy-similarity|C=i'=> \$SVN::Git::Editor::_cp_similarity
- );
- my %cmd = (
- fetch => [ \&cmd_fetch, "Download new revisions from SVN",
- { 'revision|r=s' => \$_revision,
- 'fetch-all|all' => \$_fetch_all,
- 'parent|p' => \$_fetch_parent,
- %fc_opts } ],
- clone => [ \&cmd_clone, "Initialize and fetch revisions",
- { 'revision|r=s' => \$_revision,
- 'preserve-empty-dirs' =>
- \$SVN::Git::Fetcher::_preserve_empty_dirs,
- 'placeholder-filename=s' =>
- \$SVN::Git::Fetcher::_placeholder_filename,
- %fc_opts, %init_opts } ],
- init => [ \&cmd_init, "Initialize a repo for tracking" .
- " (requires URL argument)",
- \%init_opts ],
- 'multi-init' => [ \&cmd_multi_init,
- "Deprecated alias for ".
- "'$0 init -T<trunk> -b<branches> -t<tags>'",
- \%init_opts ],
- dcommit => [ \&cmd_dcommit,
- 'Commit several diffs to merge with upstream',
- { 'merge|m|M' => \$_merge,
- 'strategy|s=s' => \$_strategy,
- 'verbose|v' => \$_verbose,
- 'dry-run|n' => \$_dry_run,
- 'fetch-all|all' => \$_fetch_all,
- 'commit-url=s' => \$_commit_url,
- 'revision|r=i' => \$_revision,
- 'no-rebase' => \$_no_rebase,
- 'mergeinfo=s' => \$_merge_info,
- %cmt_opts, %fc_opts } ],
- branch => [ \&cmd_branch,
- 'Create a branch in the SVN repository',
- { 'message|m=s' => \$_message,
- 'destination|d=s' => \$_branch_dest,
- 'dry-run|n' => \$_dry_run,
- 'tag|t' => \$_tag,
- 'username=s' => \$Git::SVN::Prompt::_username,
- 'commit-url=s' => \$_commit_url } ],
- tag => [ sub { $_tag = 1; cmd_branch(@_) },
- 'Create a tag in the SVN repository',
- { 'message|m=s' => \$_message,
- 'destination|d=s' => \$_branch_dest,
- 'dry-run|n' => \$_dry_run,
- 'username=s' => \$Git::SVN::Prompt::_username,
- 'commit-url=s' => \$_commit_url } ],
- 'set-tree' => [ \&cmd_set_tree,
- "Set an SVN repository to a git tree-ish",
- { 'stdin' => \$_stdin, %cmt_opts, %fc_opts, } ],
- 'create-ignore' => [ \&cmd_create_ignore,
- 'Create a .gitignore per svn:ignore',
- { 'revision|r=i' => \$_revision
- } ],
- 'mkdirs' => [ \&cmd_mkdirs ,
- "recreate empty directories after a checkout",
- { 'revision|r=i' => \$_revision } ],
- 'propget' => [ \&cmd_propget,
- 'Print the value of a property on a file or directory',
- { 'revision|r=i' => \$_revision } ],
- 'proplist' => [ \&cmd_proplist,
- 'List all properties of a file or directory',
- { 'revision|r=i' => \$_revision } ],
- 'show-ignore' => [ \&cmd_show_ignore, "Show svn:ignore listings",
- { 'revision|r=i' => \$_revision
- } ],
- 'show-externals' => [ \&cmd_show_externals, "Show svn:externals listings",
- { 'revision|r=i' => \$_revision
- } ],
- 'multi-fetch' => [ \&cmd_multi_fetch,
- "Deprecated alias for $0 fetch --all",
- { 'revision|r=s' => \$_revision, %fc_opts } ],
- 'migrate' => [ sub { },
- # no-op, we automatically run this anyways,
- 'Migrate configuration/metadata/layout from
- previous versions of git-svn',
- { 'minimize' => \$Git::SVN::Migration::_minimize,
- %remote_opts } ],
- 'log' => [ \&Git::SVN::Log::cmd_show_log, 'Show commit logs',
- { 'limit=i' => \$Git::SVN::Log::limit,
- 'revision|r=s' => \$_revision,
- 'verbose|v' => \$Git::SVN::Log::verbose,
- 'incremental' => \$Git::SVN::Log::incremental,
- 'oneline' => \$Git::SVN::Log::oneline,
- 'show-commit' => \$Git::SVN::Log::show_commit,
- 'non-recursive' => \$Git::SVN::Log::non_recursive,
- 'authors-file|A=s' => \$_authors,
- 'color' => \$Git::SVN::Log::color,
- 'pager=s' => \$Git::SVN::Log::pager
- } ],
- 'find-rev' => [ \&cmd_find_rev,
- "Translate between SVN revision numbers and tree-ish",
- {} ],
- 'rebase' => [ \&cmd_rebase, "Fetch and rebase your working directory",
- { 'merge|m|M' => \$_merge,
- 'verbose|v' => \$_verbose,
- 'strategy|s=s' => \$_strategy,
- 'local|l' => \$_local,
- 'fetch-all|all' => \$_fetch_all,
- 'dry-run|n' => \$_dry_run,
- %fc_opts } ],
- 'commit-diff' => [ \&cmd_commit_diff,
- 'Commit a diff between two trees',
- { 'message|m=s' => \$_message,
- 'file|F=s' => \$_file,
- 'revision|r=s' => \$_revision,
- %cmt_opts } ],
- 'info' => [ \&cmd_info,
- "Show info about the latest SVN revision
- on the current branch",
- { 'url' => \$_url, } ],
- 'blame' => [ \&Git::SVN::Log::cmd_blame,
- "Show what revision and author last modified each line of a file",
- { 'git-format' => \$_git_format } ],
- 'reset' => [ \&cmd_reset,
- "Undo fetches back to the specified SVN revision",
- { 'revision|r=s' => \$_revision,
- 'parent|p' => \$_fetch_parent } ],
- 'gc' => [ \&cmd_gc,
- "Compress unhandled.log files in .git/svn and remove " .
- "index files in .git/svn",
- {} ],
- );
- my $cmd;
- for (my $i = 0; $i < @ARGV; $i++) {
- if (defined $cmd{$ARGV[$i]}) {
- $cmd = $ARGV[$i];
- splice @ARGV, $i, 1;
- last;
- } elsif ($ARGV[$i] eq 'help') {
- $cmd = $ARGV[$i+1];
- usage(0);
- }
- };
- # make sure we're always running at the top-level working directory
- unless ($cmd && $cmd =~ /(?:clone|init|multi-init)$/) {
- unless (-d $ENV{GIT_DIR}) {
- if ($git_dir_user_set) {
- die "GIT_DIR=$ENV{GIT_DIR} explicitly set, ",
- "but it is not a directory\n";
- }
- my $git_dir = delete $ENV{GIT_DIR};
- my $cdup = undef;
- git_cmd_try {
- $cdup = command_oneline(qw/rev-parse --show-cdup/);
- $git_dir = '.' unless ($cdup);
- chomp $cdup if ($cdup);
- $cdup = "." unless ($cdup && length $cdup);
- } "Already at toplevel, but $git_dir not found\n";
- chdir $cdup or die "Unable to chdir up to '$cdup'\n";
- unless (-d $git_dir) {
- die "$git_dir still not found after going to ",
- "'$cdup'\n";
- }
- $ENV{GIT_DIR} = $git_dir;
- }
- $_repository = Git->repository(Repository => $ENV{GIT_DIR});
- }
- my %opts = %{$cmd{$cmd}->[2]} if (defined $cmd);
- read_git_config(\%opts);
- if ($cmd && ($cmd eq 'log' || $cmd eq 'blame')) {
- Getopt::Long::Configure('pass_through');
- }
- my $rv = GetOptions(%opts, 'help|H|h' => \$_help, 'version|V' => \$_version,
- 'minimize-connections' => \$Git::SVN::Migration::_minimize,
- 'id|i=s' => \$Git::SVN::default_ref_id,
- 'svn-remote|remote|R=s' => sub {
- $Git::SVN::no_reuse_existing = 1;
- $Git::SVN::default_repo_id = $_[1] });
- exit 1 if (!$rv && $cmd && $cmd ne 'log');
- usage(0) if $_help;
- version() if $_version;
- usage(1) unless defined $cmd;
- load_authors() if $_authors;
- if (defined $_authors_prog) {
- $_authors_prog = "'" . File::Spec->rel2abs($_authors_prog) . "'";
- }
- unless ($cmd =~ /^(?:clone|init|multi-init|commit-diff)$/) {
- Git::SVN::Migration::migration_check();
- }
- Git::SVN::init_vars();
- eval {
- Git::SVN::verify_remotes_sanity();
- $cmd{$cmd}->[0]->(@ARGV);
- };
- fatal $@ if $@;
- post_fetch_checkout();
- exit 0;
- ####################### primary functions ######################
- sub usage {
- my $exit = shift || 0;
- my $fd = $exit ? \*STDERR : \*STDOUT;
- print $fd <<"";
- git-svn - bidirectional operations between a single Subversion tree and git
- Usage: git svn <command> [options] [arguments]\n
- print $fd "Available commands:\n" unless $cmd;
- foreach (sort keys %cmd) {
- next if $cmd && $cmd ne $_;
- next if /^multi-/; # don't show deprecated commands
- print $fd ' ',pack('A17',$_),$cmd{$_}->[1],"\n";
- foreach (sort keys %{$cmd{$_}->[2]}) {
- # mixed-case options are for .git/config only
- next if /[A-Z]/ && /^[a-z]+$/i;
- # prints out arguments as they should be passed:
- my $x = s#[:=]s$## ? '<arg>' : s#[:=]i$## ? '<num>' : '';
- print $fd ' ' x 21, join(', ', map { length $_ > 1 ?
- "--$_" : "-$_" }
- split /\|/,$_)," $x\n";
- }
- }
- print $fd <<"";
- \nGIT_SVN_ID may be set in the environment or via the --id/-i switch to an
- arbitrary identifier if you're tracking multiple SVN branches/repositories in
- one git repository and want to keep them separate. See git-svn(1) for more
- information.
- exit $exit;
- }
- sub version {
- ::_req_svn();
- print "git-svn version $VERSION (svn $SVN::Core::VERSION)\n";
- exit 0;
- }
- sub do_git_init_db {
- unless (-d $ENV{GIT_DIR}) {
- my @init_db = ('init');
- push @init_db, "--template=$_template" if defined $_template;
- if (defined $_shared) {
- if ($_shared =~ /[a-z]/) {
- push @init_db, "--shared=$_shared";
- } else {
- push @init_db, "--shared";
- }
- }
- command_noisy(@init_db);
- $_repository = Git->repository(Repository => ".git");
- }
- my $set;
- my $pfx = "svn-remote.$Git::SVN::default_repo_id";
- foreach my $i (keys %icv) {
- die "'$set' and '$i' cannot both be set\n" if $set;
- next unless defined $icv{$i};
- command_noisy('config', "$pfx.$i", $icv{$i});
- $set = $i;
- }
- my $ignore_regex = \$SVN::Git::Fetcher::_ignore_regex;
- command_noisy('config', "$pfx.ignore-paths", $$ignore_regex)
- if defined $$ignore_regex;
- if (defined $SVN::Git::Fetcher::_preserve_empty_dirs) {
- my $fname = \$SVN::Git::Fetcher::_placeholder_filename;
- command_noisy('config', "$pfx.preserve-empty-dirs", 'true');
- command_noisy('config', "$pfx.placeholder-filename", $$fname);
- }
- }
- sub init_subdir {
- my $repo_path = shift or return;
- mkpath([$repo_path]) unless -d $repo_path;
- chdir $repo_path or die "Couldn't chdir to $repo_path: $!\n";
- $ENV{GIT_DIR} = '.git';
- $_repository = Git->repository(Repository => $ENV{GIT_DIR});
- }
- sub cmd_clone {
- my ($url, $path) = @_;
- if (!defined $path &&
- (defined $_trunk || @_branches || @_tags ||
- defined $_stdlayout) &&
- $url !~ m#^[a-z\+]+://#) {
- $path = $url;
- }
- $path = basename($url) if !defined $path || !length $path;
- my $authors_absolute = $_authors ? File::Spec->rel2abs($_authors) : "";
- cmd_init($url, $path);
- command_oneline('config', 'svn.authorsfile', $authors_absolute)
- if $_authors;
- Git::SVN::fetch_all($Git::SVN::default_repo_id);
- }
- sub cmd_init {
- if (defined $_stdlayout) {
- $_trunk = 'trunk' if (!defined $_trunk);
- @_tags = 'tags' if (! @_tags);
- @_branches = 'branches' if (! @_branches);
- }
- if (defined $_trunk || @_branches || @_tags) {
- return cmd_multi_init(@_);
- }
- my $url = shift or die "SVN repository location required ",
- "as a command-line argument\n";
- $url = canonicalize_url($url);
- init_subdir(@_);
- do_git_init_db();
- if ($Git::SVN::_minimize_url eq 'unset') {
- $Git::SVN::_minimize_url = 0;
- }
- Git::SVN->init($url);
- }
- sub cmd_fetch {
- if (grep /^\d+=./, @_) {
- die "'<rev>=<commit>' fetch arguments are ",
- "no longer supported.\n";
- }
- my ($remote) = @_;
- if (@_ > 1) {
- die "Usage: $0 fetch [--all] [--parent] [svn-remote]\n";
- }
- $Git::SVN::no_reuse_existing = undef;
- if ($_fetch_parent) {
- my ($url, $rev, $uuid, $gs) = working_head_info('HEAD');
- unless ($gs) {
- die "Unable to determine upstream SVN information from ",
- "working tree history\n";
- }
- # just fetch, don't checkout.
- $_no_checkout = 'true';
- $_fetch_all ? $gs->fetch_all : $gs->fetch;
- } elsif ($_fetch_all) {
- cmd_multi_fetch();
- } else {
- $remote ||= $Git::SVN::default_repo_id;
- Git::SVN::fetch_all($remote, Git::SVN::read_all_remotes());
- }
- }
- sub cmd_set_tree {
- my (@commits) = @_;
- if ($_stdin || !@commits) {
- print "Reading from stdin...\n";
- @commits = ();
- while (<STDIN>) {
- if (/\b($sha1_short)\b/o) {
- unshift @commits, $1;
- }
- }
- }
- my @revs;
- foreach my $c (@commits) {
- my @tmp = command('rev-parse',$c);
- if (scalar @tmp == 1) {
- push @revs, $tmp[0];
- } elsif (scalar @tmp > 1) {
- push @revs, reverse(command('rev-list',@tmp));
- } else {
- fatal "Failed to rev-parse $c";
- }
- }
- my $gs = Git::SVN->new;
- my ($r_last, $cmt_last) = $gs->last_rev_commit;
- $gs->fetch;
- if (defined $gs->{last_rev} && $r_last != $gs->{last_rev}) {
- fatal "There are new revisions that were fetched ",
- "and need to be merged (or acknowledged) ",
- "before committing.\nlast rev: $r_last\n",
- " current: $gs->{last_rev}";
- }
- $gs->set_tree($_) foreach @revs;
- print "Done committing ",scalar @revs," revisions to SVN\n";
- unlink $gs->{index};
- }
- sub split_merge_info_range {
- my ($range) = @_;
- if ($range =~ /(\d+)-(\d+)/) {
- return (int($1), int($2));
- } else {
- return (int($range), int($range));
- }
- }
- sub combine_ranges {
- my ($in) = @_;
- my @fnums = ();
- my @arr = split(/,/, $in);
- for my $element (@arr) {
- my ($start, $end) = split_merge_info_range($element);
- push @fnums, $start;
- }
- my @sorted = @arr [ sort {
- $fnums[$a] <=> $fnums[$b]
- } 0..$#arr ];
- my @return = ();
- my $last = -1;
- my $first = -1;
- for my $element (@sorted) {
- my ($start, $end) = split_merge_info_range($element);
- if ($last == -1) {
- $first = $start;
- $last = $end;
- next;
- }
- if ($start <= $last+1) {
- if ($end > $last) {
- $last = $end;
- }
- next;
- }
- if ($first == $last) {
- push @return, "$first";
- } else {
- push @return, "$first-$last";
- }
- $first = $start;
- $last = $end;
- }
- if ($first != -1) {
- if ($first == $last) {
- push @return, "$first";
- } else {
- push @return, "$first-$last";
- }
- }
- return join(',', @return);
- }
- sub merge_revs_into_hash {
- my ($hash, $minfo) = @_;
- my @lines = split(' ', $minfo);
- for my $line (@lines) {
- my ($branchpath, $revs) = split(/:/, $line);
- if (exists($hash->{$branchpath})) {
- # Merge the two revision sets
- my $combined = "$hash->{$branchpath},$revs";
- $hash->{$branchpath} = combine_ranges($combined);
- } else {
- # Just do range combining for consolidation
- $hash->{$branchpath} = combine_ranges($revs);
- }
- }
- }
- sub merge_merge_info {
- my ($mergeinfo_one, $mergeinfo_two) = @_;
- my %result_hash = ();
- merge_revs_into_hash(\%result_hash, $mergeinfo_one);
- merge_revs_into_hash(\%result_hash, $mergeinfo_two);
- my $result = '';
- # Sort below is for consistency's sake
- for my $branchname (sort keys(%result_hash)) {
- my $revlist = $result_hash{$branchname};
- $result .= "$branchname:$revlist\n"
- }
- return $result;
- }
- sub populate_merge_info {
- my ($d, $gs, $uuid, $linear_refs, $rewritten_parent) = @_;
- my %parentshash;
- read_commit_parents(\%parentshash, $d);
- my @parents = @{$parentshash{$d}};
- if ($#parents > 0) {
- # Merge commit
- my $all_parents_ok = 1;
- my $aggregate_mergeinfo = '';
- my $rooturl = $gs->repos_root;
- if (defined($rewritten_parent)) {
- # Replace first parent with newly-rewritten version
- shift @parents;
- unshift @parents, $rewritten_parent;
- }
- foreach my $parent (@parents) {
- my ($branchurl, $svnrev, $paruuid) =
- cmt_metadata($parent);
- unless (defined($svnrev)) {
- # Should have been caught be preflight check
- fatal "merge commit $d has ancestor $parent, but that change "
- ."does not have git-svn metadata!";
- }
- unless ($branchurl =~ /^$rooturl(.*)/) {
- fatal "commit $parent git-svn metadata changed mid-run!";
- }
- my $branchpath = $1;
- my $ra = Git::SVN::Ra->new($branchurl);
- my (undef, undef, $props) =
- $ra->get_dir(canonicalize_path("."), $svnrev);
- my $par_mergeinfo = $props->{'svn:mergeinfo'};
- unless (defined $par_mergeinfo) {
- $par_mergeinfo = '';
- }
- # Merge previous mergeinfo values
- $aggregate_mergeinfo =
- merge_merge_info($aggregate_mergeinfo,
- $par_mergeinfo, 0);
- next if $parent eq $parents[0]; # Skip first parent
- # Add new changes being placed in tree by merge
- my @cmd = (qw/rev-list --reverse/,
- $parent, qw/--not/);
- foreach my $par (@parents) {
- unless ($par eq $parent) {
- push @cmd, $par;
- }
- }
- my @revsin = ();
- my ($revlist, $ctx) = command_output_pipe(@cmd);
- while (<$revlist>) {
- my $irev = $_;
- chomp $irev;
- my (undef, $csvnrev, undef) =
- cmt_metadata($irev);
- unless (defined $csvnrev) {
- # A child is missing SVN annotations...
- # this might be OK, or might not be.
- warn "W:child $irev is merged into revision "
- ."$d but does not have git-svn metadata. "
- ."This means git-svn cannot determine the "
- ."svn revision numbers to place into the "
- ."svn:mergeinfo property. You must ensure "
- ."a branch is entirely committed to "
- ."SVN before merging it in order for "
- ."svn:mergeinfo population to function "
- ."properly";
- }
- push @revsin, $csvnrev;
- }
- command_close_pipe($revlist, $ctx);
- last unless $all_parents_ok;
- # We now have a list of all SVN revnos which are
- # merged by this particular parent. Integrate them.
- next if $#revsin == -1;
- my $newmergeinfo = "$branchpath:" . join(',', @revsin);
- $aggregate_mergeinfo =
- merge_merge_info($aggregate_mergeinfo,
- $newmergeinfo, 1);
- }
- if ($all_parents_ok and $aggregate_mergeinfo) {
- return $aggregate_mergeinfo;
- }
- }
- return undef;
- }
- sub cmd_dcommit {
- my $head = shift;
- command_noisy(qw/update-index --refresh/);
- git_cmd_try { command_oneline(qw/diff-index --quiet HEAD/) }
- 'Cannot dcommit with a dirty index. Commit your changes first, '
- . "or stash them with `git stash'.\n";
- $head ||= 'HEAD';
- my $old_head;
- if ($head ne 'HEAD') {
- $old_head = eval {
- command_oneline([qw/symbolic-ref -q HEAD/])
- };
- if ($old_head) {
- $old_head =~ s{^refs/heads/}{};
- } else {
- $old_head = eval { command_oneline(qw/rev-parse HEAD/) };
- }
- command(['checkout', $head], STDERR => 0);
- }
- my @refs;
- my ($url, $rev, $uuid, $gs) = working_head_info('HEAD', \@refs);
- unless ($gs) {
- die "Unable to determine upstream SVN information from ",
- "$head history.\nPerhaps the repository is empty.";
- }
- if (defined $_commit_url) {
- $url = $_commit_url;
- } else {
- $url = eval { command_oneline('config', '--get',
- "svn-remote.$gs->{repo_id}.commiturl") };
- if (!$url) {
- $url = $gs->full_pushurl
- }
- }
- my $last_rev = $_revision if defined $_revision;
- if ($url) {
- print "Committing to $url ...\n";
- }
- my ($linear_refs, $parents) = linearize_history($gs, \@refs);
- if ($_no_rebase && scalar(@$linear_refs) > 1) {
- warn "Attempting to commit more than one change while ",
- "--no-rebase is enabled.\n",
- "If these changes depend on each other, re-running ",
- "without --no-rebase may be required."
- }
- my $expect_url = $url;
- my $push_merge_info = eval {
- command_oneline(qw/config --get svn.pushmergeinfo/)
- };
- if (not defined($push_merge_info)
- or $push_merge_info eq "false"
- or $push_merge_info eq "no"
- or $push_merge_info eq "never") {
- $push_merge_info = 0;
- }
- unless (defined($_merge_info) || ! $push_merge_info) {
- # Preflight check of changes to ensure no issues with mergeinfo
- # This includes check for uncommitted-to-SVN parents
- # (other than the first parent, which we will handle),
- # information from different SVN repos, and paths
- # which are not underneath this repository root.
- my $rooturl = $gs->repos_root;
- foreach my $d (@$linear_refs) {
- my %parentshash;
- read_commit_parents(\%parentshash, $d);
- my @realparents = @{$parentshash{$d}};
- if ($#realparents > 0) {
- # Merge commit
- shift @realparents; # Remove/ignore first parent
- foreach my $parent (@realparents) {
- my ($branchurl, $svnrev, $paruuid) = cmt_metadata($parent);
- unless (defined $paruuid) {
- # A parent is missing SVN annotations...
- # abort the whole operation.
- fatal "$parent is merged into revision $d, "
- ."but does not have git-svn metadata. "
- ."Either dcommit the branch or use a "
- ."local cherry-pick, FF merge, or rebase "
- ."instead of an explicit merge commit.";
- }
- unless ($paruuid eq $uuid) {
- # Parent has SVN metadata from different repository
- fatal "merge parent $parent for change $d has "
- ."git-svn uuid $paruuid, while current change "
- ."has uuid $uuid!";
- }
- unless ($branchurl =~ /^$rooturl(.*)/) {
- # This branch is very strange indeed.
- fatal "merge parent $parent for $d is on branch "
- ."$branchurl, which is not under the "
- ."git-svn root $rooturl!";
- }
- }
- }
- }
- }
- my $rewritten_parent;
- Git::SVN::remove_username($expect_url);
- if (defined($_merge_info)) {
- $_merge_info =~ tr{ }{\n};
- }
- while (1) {
- my $d = shift @$linear_refs or last;
- unless (defined $last_rev) {
- (undef, $last_rev, undef) = cmt_metadata("$d~1");
- unless (defined $last_rev) {
- fatal "Unable to extract revision information ",
- "from commit $d~1";
- }
- }
- if ($_dry_run) {
- print "diff-tree $d~1 $d\n";
- } else {
- my $cmt_rev;
- unless (defined($_merge_info) || ! $push_merge_info) {
- $_merge_info = populate_merge_info($d, $gs,
- $uuid,
- $linear_refs,
- $rewritten_parent);
- }
- my %ed_opts = ( r => $last_rev,
- log => get_commit_entry($d)->{log},
- ra => Git::SVN::Ra->new($url),
- config => SVN::Core::config_get_config(
- $Git::SVN::Ra::config_dir
- ),
- tree_a => "$d~1",
- tree_b => $d,
- editor_cb => sub {
- print "Committed r$_[0]\n";
- $cmt_rev = $_[0];
- },
- mergeinfo => $_merge_info,
- svn_path => '');
- if (!SVN::Git::Editor->new(\%ed_opts)->apply_diff) {
- print "No changes\n$d~1 == $d\n";
- } elsif ($parents->{$d} && @{$parents->{$d}}) {
- $gs->{inject_parents_dcommit}->{$cmt_rev} =
- $parents->{$d};
- }
- $_fetch_all ? $gs->fetch_all : $gs->fetch;
- $last_rev = $cmt_rev;
- next if $_no_rebase;
- # we always want to rebase against the current HEAD,
- # not any head that was passed to us
- my @diff = command('diff-tree', $d,
- $gs->refname, '--');
- my @finish;
- if (@diff) {
- @finish = rebase_cmd();
- print STDERR "W: $d and ", $gs->refname,
- " differ, using @finish:\n",
- join("\n", @diff), "\n";
- } else {
- print "No changes between current HEAD and ",
- $gs->refname,
- "\nResetting to the latest ",
- $gs->refname, "\n";
- @finish = qw/reset --mixed/;
- }
- command_noisy(@finish, $gs->refname);
- $rewritten_parent = command_oneline(qw/rev-parse HEAD/);
- if (@diff) {
- @refs = ();
- my ($url_, $rev_, $uuid_, $gs_) =
- working_head_info('HEAD', \@refs);
- my ($linear_refs_, $parents_) =
- linearize_history($gs_, \@refs);
- if (scalar(@$linear_refs) !=
- scalar(@$linear_refs_)) {
- fatal "# of revisions changed ",
- "\nbefore:\n",
- join("\n", @$linear_refs),
- "\n\nafter:\n",
- join("\n", @$linear_refs_), "\n",
- 'If you are attempting to commit ',
- "merges, try running:\n\t",
- 'git rebase --interactive',
- '--preserve-merges ',
- $gs->refname,
- "\nBefore dcommitting";
- }
- if ($url_ ne $expect_url) {
- if ($url_ eq $gs->metadata_url) {
- print
- "Accepting rewritten URL:",
- " $url_\n";
- } else {
- fatal
- "URL mismatch after rebase:",
- " $url_ != $expect_url";
- }
- }
- if ($uuid_ ne $uuid) {
- fatal "uuid mismatch after rebase: ",
- "$uuid_ != $uuid";
- }
- # remap parents
- my (%p, @l, $i);
- for ($i = 0; $i < scalar @$linear_refs; $i++) {
- my $new = $linear_refs_->[$i] or next;
- $p{$new} =
- $parents->{$linear_refs->[$i]};
- push @l, $new;
- }
- $parents = \%p;
- $linear_refs = \@l;
- }
- }
- }
- if ($old_head) {
- my $new_head = command_oneline(qw/rev-parse HEAD/);
- my $new_is_symbolic = eval {
- command_oneline(qw/symbolic-ref -q HEAD/);
- };
- if ($new_is_symbolic) {
- print "dcommitted the branch ", $head, "\n";
- } else {
- print "dcommitted on a detached HEAD because you gave ",
- "a revision argument.\n",
- "The rewritten commit is: ", $new_head, "\n";
- }
- command(['checkout', $old_head], STDERR => 0);
- }
- unlink $gs->{index};
- }
- sub cmd_branch {
- my ($branch_name, $head) = @_;
- unless (defined $branch_name && length $branch_name) {
- die(($_tag ? "tag" : "branch") . " name required\n");
- }
- $head ||= 'HEAD';
- my (undef, $rev, undef, $gs) = working_head_info($head);
- my $src = $gs->full_pushurl;
- my $remote = Git::SVN::read_all_remotes()->{$gs->{repo_id}};
- my $allglobs = $remote->{ $_tag ? 'tags' : 'branches' };
- my $glob;
- if ($#{$allglobs} == 0) {
- $glob = $allglobs->[0];
- } else {
- unless(defined $_branch_dest) {
- die "Multiple ",
- $_tag ? "tag" : "branch",
- " paths defined for Subversion repository.\n",
- "You must specify where you want to create the ",
- $_tag ? "tag" : "branch",
- " with the --destination argument.\n";
- }
- foreach my $g (@{$allglobs}) {
- # SVN::Git::Editor could probably be moved to Git.pm..
- my $re = SVN::Git::Editor::glob2pat($g->{path}->{left});
- if ($_branch_dest =~ /$re/) {
- $glob = $g;
- last;
- }
- }
- unless (defined $glob) {
- my $dest_re = qr/\b\Q$_branch_dest\E\b/;
- foreach my $g (@{$allglobs}) {
- $g->{path}->{left} =~ /$dest_re/ or next;
- if (defined $glob) {
- die "Ambiguous destination: ",
- $_branch_dest, "\nmatches both '",
- $glob->{path}->{left}, "' and '",
- $g->{path}->{left}, "'\n";
- }
- $glob = $g;
- }
- unless (defined $glob) {
- die "Unknown ",
- $_tag ? "tag" : "branch",
- " destination $_branch_dest\n";
- }
- }
- }
- my ($lft, $rgt) = @{ $glob->{path} }{qw/left right/};
- my $url;
- if (defined $_commit_url) {
- $url = $_commit_url;
- } else {
- $url = eval { command_oneline('config', '--get',
- "svn-remote.$gs->{repo_id}.commiturl") };
- if (!$url) {
- $url = $remote->{pushurl} || $remote->{url};
- }
- }
- my $dst = join '/', $url, $lft, $branch_name, ($rgt || ());
- if ($dst =~ /^https:/ && $src =~ /^http:/) {
- $src=~s/^http:/https:/;
- }
- ::_req_svn();
- my $ctx = SVN::Client->new(
- auth => Git::SVN::Ra::_auth_providers(),
- log_msg => sub {
- ${ $_[0] } = defined $_message
- ? $_message
- : 'Create ' . ($_tag ? 'tag ' : 'branch ' )
- . $branch_name;
- },
- );
- eval {
- $ctx->ls($dst, 'HEAD', 0);
- } and die "branch ${branch_name} already exists\n";
- print "Copying ${src} at r${rev} to ${dst}...\n";
- $ctx->copy($src, $rev, $dst)
- unless $_dry_run;
- $gs->fetch_all;
- }
- sub cmd_find_rev {
- my $revision_or_hash = shift or die "SVN or git revision required ",
- "as a command-line argument\n";
- my $result;
- if ($revision_or_hash =~ /^r\d+$/) {
- my $head = shift;
- $head ||= 'HEAD';
- my @refs;
- my (undef, undef, $uuid, $gs) = working_head_info($head, \@refs);
- unless ($gs) {
- die "Unable to determine upstream SVN information from ",
- "$head history\n";
- }
- my $desired_revision = substr($revision_or_hash, 1);
- $result = $gs->rev_map_get($desired_revision, $uuid);
- } else {
- my (undef, $rev, undef) = cmt_metadata($revision_or_hash);
- $result = $rev;
- }
- print "$result\n" if $result;
- }
- sub auto_create_empty_directories {
- my ($gs) = @_;
- my $var = eval { command_oneline('config', '--get', '--bool',
- "svn-remote.$gs->{repo_id}.automkdirs") };
- # By default, create empty directories by consulting the unhandled log,
- # but allow setting it to 'false' to skip it.
- return !($var && $var eq 'false');
- }
- sub cmd_rebase {
- command_noisy(qw/update-index --refresh/);
- my ($url, $rev, $uuid, $gs) = working_head_info('HEAD');
- unless ($gs) {
- die "Unable to determine upstream SVN information from ",
- "working tree history\n";
- }
- if ($_dry_run) {
- print "Remote Branch: " . $gs->refname . "\n";
- print "SVN URL: " . $url . "\n";
- return;
- }
- if (command(qw/diff-index HEAD --/)) {
- print STDERR "Cannot rebase with uncommited changes:\n";
- command_noisy('status');
- exit 1;
- }
- unless ($_local) {
- # rebase will checkout for us, so no need to do it explicitly
- $_no_checkout = 'true';
- $_fetch_all ? $gs->fetch_all : $gs->fetch;
- }
- command_noisy(rebase_cmd(), $gs->refname);
- if (auto_create_empty_directories($gs)) {
- $gs->mkemptydirs;
- }
- }
- sub cmd_show_ignore {
- my ($url, $rev, $uuid, $gs) = working_head_info('HEAD');
- $gs ||= Git::SVN->new;
- my $r = (defined $_revision ? $_revision : $gs->ra->get_latest_revnum);
- $gs->prop_walk($gs->{path}, $r, sub {
- my ($gs, $path, $props) = @_;
- print STDOUT "\n# $path\n";
- my $s = $props->{'svn:ignore'} or return;
- $s =~ s/[\r\n]+/\n/g;
- $s =~ s/^\n+//;
- chomp $s;
- $s =~ s#^#$path#gm;
- print STDOUT "$s\n";
- });
- }
- sub cmd_show_externals {
- my ($url, $rev, $uuid, $gs) = working_head_info('HEAD');
- $gs ||= Git::SVN->new;
- my $r = (defined $_revision ? $_revision : $gs->ra->get_latest_revnum);
- $gs->prop_walk($gs->{path}, $r, sub {
- my ($gs, $path, $props) = @_;
- print STDOUT "\n# $path\n";
- my $s = $props->{'svn:externals'} or return;
- $s =~ s/[\r\n]+/\n/g;
- chomp $s;
- $s =~ s#^#$path#gm;
- print STDOUT "$s\n";
- });
- }
- sub cmd_create_ignore {
- my ($url, $rev, $uuid, $gs) = working_head_info('HEAD');
- $gs ||= Git::SVN->new;
- my $r = (defined $_revision ? $_revision : $gs->ra->get_latest_revnum);
- $gs->prop_walk($gs->{path}, $r, sub {
- my ($gs, $path, $props) = @_;
- # $path is of the form /path/to/dir/
- $path = '.' . $path;
- # SVN can have attributes on empty directories,
- # which git won't track
- mkpath([$path]) unless -d $path;
- my $ignore = $path . '.gitignore';
- my $s = $props->{'svn:ignore'} or return;
- open(GITIGNORE, '>', $ignore)
- or fatal("Failed to open `$ignore' for writing: $!");
- $s =~ s/[\r\n]+/\n/g;
- $s =~ s/^\n+//;
- chomp $s;
- # Prefix all patterns so that the ignore doesn't apply
- # to sub-directories.
- $s =~ s#^#/#gm;
- print GITIGNORE "$s\n";
- close(GITIGNORE)
- or fatal("Failed to close `$ignore': $!");
- command_noisy('add', '-f', $ignore);
- });
- }
- sub cmd_mkdirs {
- my ($url, $rev, $uuid, $gs) = working_head_info('HEAD');
- $gs ||= Git::SVN->new;
- $gs->mkemptydirs($_revision);
- }
- sub canonicalize_path {
- my ($path) = @_;
- my $dot_slash_added = 0;
- if (substr($path, 0, 1) ne "/") {
- $path = "./" . $path;
- $dot_slash_added = 1;
- }
- # File::Spec->canonpath doesn't collapse x/../y into y (for a
- # good reason), so let's do this manually.
- $path =~ s#/+#/#g;
- $path =~ s#/\.(?:/|$)#/#g;
- $path =~ s#/[^/]+/\.\.##g;
- $path =~ s#/$##g;
- $path =~ s#^\./## if $dot_slash_added;
- $path =~ s#^/##;
- $path =~ s#^\.$##;
- return $path;
- }
- sub canonicalize_url {
- my ($url) = @_;
- $url =~ s#^([^:]+://[^/]*/)(.*)$#$1 . canonicalize_path($2)#e;
- return $url;
- }
- # get_svnprops(PATH)
- # ------------------
- # Helper for cmd_propget and cmd_proplist below.
- sub get_svnprops {
- my $path = shift;
- my ($url, $rev, $uuid, $gs) = working_head_info('HEAD');
- $gs ||= Git::SVN->new;
- # prefix THE PATH by the sub-directory from which the user
- # invoked us.
- $path = $cmd_dir_prefix . $path;
- fatal("No such file or directory: $path") unless -e $path;
- my $is_dir = -d $path ? 1 : 0;
- $path = $gs->{path} . '/' . $path;
- # canonicalize the path (otherwise libsvn will abort or fail to
- # find the file)
- $path = canonicalize_path($path);
- my $r = (defined $_revision ? $_revision : $gs->ra->get_latest_revnum);
- my $props;
- if ($is_dir) {
- (undef, undef, $props) = $gs->ra->get_dir($path, $r);
- }
- else {
- (undef, $props) = $gs->ra->get_file($path, $r, undef);
- }
- return $props;
- }
- # cmd_propget (PROP, PATH)
- # ------------------------
- # Print the SVN property PROP for PATH.
- sub cmd_propget {
- my ($prop, $path) = @_;
- $path = '.' if not defined $path;
- usage(1) if not defined $prop;
- my $props = get_svnprops($path);
- if (not defined $props->{$prop}) {
- fatal("`$path' does not have a `$prop' SVN property.");
- }
- print $props->{$prop} . "\n";
- }
- # cmd_proplist (PATH)
- # -------------------
- # Print the list of SVN properties for PATH.
- sub cmd_proplist {
- my $path = shift;
- $path = '.' if not defined $path;
- my $props = get_svnprops($path);
- print "Properties on '$path':\n";
- foreach (sort keys %{$props}) {
- print " $_\n";
- }
- }
- sub cmd_multi_init {
- my $url = shift;
- unless (defined $_trunk || @_branches || @_tags) {
- usage(1);
- }
- $_prefix = '' unless defined $_prefix;
- if (defined $url) {
- $url = canonicalize_url($url);
- init_subdir(@_);
- }
- do_git_init_db();
- if (defined $_trunk) {
- $_trunk =~ s#^/+##;
- my $trunk_ref = 'refs/remotes/' . $_prefix . 'trunk';
- # try both old-style and new-style lookups:
- my $gs_trunk = eval { Git::SVN->new($trunk_ref) };
- unless ($gs_trunk) {
- my ($trunk_url, $trunk_path) =
- complete_svn_url($url, $_trunk);
- $gs_trunk = Git::SVN->init($trunk_url, $trunk_path,
- undef, $trunk_ref);
- }
- }
- return unless @_branches || @_tags;
- my $ra = $url ? Git::SVN::Ra->new($url) : undef;
- foreach my $path (@_branches) {
- complete_url_ls_init($ra, $path, '--branches/-b', $_prefix);
- }
- foreach my $path (@_tags) {
- complete_url_ls_init($ra, $path, '--tags/-t', $_prefix.'tags/');
- }
- }
- sub cmd_multi_fetch {
- $Git::SVN::no_reuse_existing = undef;
- my $remotes = Git::SVN::read_all_remotes();
- foreach my $repo_id (sort keys %$remotes) {
- if ($remotes->{$repo_id}->{url}) {
- Git::SVN::fetch_all($repo_id, $remotes);
- }
- }
- }
- # this command is special because it requires no metadata
- sub cmd_commit_diff {
- my ($ta, $tb, $url) = @_;
- my $usage = "Usage: $0 commit-diff -r<revision> ".
- "<tree-ish> <tree-ish> [<URL>]";
- fatal($usage) if (!defined $ta || !defined $tb);
- my $svn_path = '';
- if (!defined $url) {
- my $gs = eval { Git::SVN->new };
- if (!$gs) {
- fatal("Needed URL or usable git-svn --id in ",
- "the command-line\n", $usage);
- }
- $url = $gs->{url};
- $svn_path = $gs->{path};
- }
- unless (defined $_revision) {
- fatal("-r|--revision is a required argument\n", $usage);
- }
- if (defined $_message && defined $_file) {
- fatal("Both --message/-m and --file/-F specified ",
- "for the commit message.\n",
- "I have no idea what you mean");
- }
- if (defined $_file) {
- $_message = file_to_s($_file);
- } else {
- $_message ||= get_commit_entry($tb)->{log};
- }
- my $ra ||= Git::SVN::Ra->new($url);
- my $r = $_revision;
- if ($r eq 'HEAD') {
- $r = $ra->get_latest_revnum;
- } elsif ($r !~ /^\d+$/) {
- die "revision argument: $r not understood by git-svn\n";
- }
- my %ed_opts = ( r => $r,
- log => $_message,
- ra => $ra,
- tree_a => $ta,
- tree_b => $tb,
- editor_cb => sub { print "Committed r$_[0]\n" },
- svn_path => $svn_path );
- if (!SVN::Git::Editor->new(\%ed_opts)->apply_diff) {
- print "No changes\n$ta == $tb\n";
- }
- }
- sub escape_uri_only {
- my ($uri) = @_;
- my @tmp;
- foreach (split m{/}, $uri) {
- s/([^~\w.%+-]|%(?![a-fA-F0-9]{2}))/sprintf("%%%02X",ord($1))/eg;
- push @tmp, $_;
- }
- join('/', @tmp);
- }
- sub escape_url {
- my ($url) = @_;
- if ($url =~ m#^([^:]+)://([^/]*)(.*)$#) {
- my ($scheme, $domain, $uri) = ($1, $2, escape_uri_only($3));
- $url = "$scheme://$domain$uri";
- }
- $url;
- }
- sub cmd_info {
- my $path = canonicalize_path(defined($_[0]) ? $_[0] : ".");
- my $fullpath = canonicalize_path($cmd_dir_prefix . $path);
- if (exists $_[1]) {
- die "Too many arguments specified\n";
- }
- my ($file_type, $diff_status) = find_file_type_and_diff_status($path);
- if (!$file_type && !$diff_status) {
- print STDERR "svn: '$path' is not under version control\n";
- exit 1;
- }
- my ($url, $rev, $uuid, $gs) = working_head_info('HEAD');
- unless ($gs) {
- die "Unable to determine upstream SVN information from ",
- "working tree history\n";
- }
- # canonicalize_path() will return "" to make libsvn 1.5.x happy,
- $path = "." if $path eq "";
- my $full_url = $url . ($fullpath eq "" ? "" : "/$fullpath");
- if ($_url) {
- print escape_url($full_url), "\n";
- return;
- }
- my $result = "Path: $path\n";
- $result .= "Name: " . basename($path) . "\n" if $file_type ne "dir";
- $result .= "URL: " . escape_url($full_url) . "\n";
- eval {
- my $repos_root = $gs->repos_root;
- Git::SVN::remove_username($repos_root);
- $result .= "Repository Root: " . escape_url($repos_root) . "\n";
- };
- if ($@) {
- $result .= "Repository Root: (offline)\n";
- }
- ::_req_svn();
- $result .= "Repository UUID: $uuid\n" unless $diff_status eq "A" &&
- ($SVN::Core::VERSION le '1.5.4' || $file_type ne "dir");
- $result .= "Revision: " . ($diff_status eq "A" ? 0 : $rev) . "\n";
- $result .= "Node Kind: " .
- ($file_type eq "dir" ? "directory" : "file") . "\n";
- my $schedule = $diff_status eq "A"
- ? "add"
- : ($diff_status eq "D" ? "delete" : "normal");
- $result .= "Schedule: $schedule\n";
- if ($diff_status eq "A") {
- print $result, "\n";
- return;
- }
- my ($lc_author, $lc_rev, $lc_date_utc);
- my @args = Git::SVN::Log::git_svn_log_cmd($rev, $rev, "--", $fullpath);
- my $log = command_output_pipe(@args);
- my $esc_color = qr/(?:\033\[(?:(?:\d+;)*\d*)?m)*/;
- while (<$log>) {
- if (/^${esc_color}author (.+) <[^>]+> (\d+) ([\-\+]?\d+)$/o) {
- $lc_author = $1;
- $lc_date_utc = Git::SVN::Log::parse_git_date($2, $3);
- } elsif (/^${esc_color} (git-svn-id:.+)$/o) {
- (undef, $lc_rev, undef) = ::extract_metadata($1);
- }
- }
- close $log;
- Git::SVN::Log::set_local_timezone();
- $result .= "Last Changed Author: $lc_author\n";
- $result .= "Last Changed Rev: $lc_rev\n";
- $result .= "Last Changed Date: " .
- Git::SVN::Log::format_svn_date($lc_date_utc) . "\n";
- if ($file_type ne "dir") {
- my $text_last_updated_date =
- ($diff_status eq "D" ? $lc_date_utc : (stat $path)[9]);
- $result .=
- "Text Last Updated: " .
- Git::SVN::Log::format_svn_date($text_last_updated_date) .
- "\n";
- my $checksum;
- if ($diff_status eq "D") {
- my ($fh, $ctx) =
- command_output_pipe(qw(cat-file blob), "HEAD:$path");
- if ($file_type eq "link") {
- my $file_name = <$fh>;
- $checksum = md5sum("link $file_name");
- } else {
- $checksum = md5sum($fh);
- }
- command_close_pipe($fh, $ctx);
- } elsif ($file_type eq "link") {
- my $file_name =
- command(qw(cat-file blob), "HEAD:$path");
- $checksum =
- md5sum("link " . $file_name);
- } else {
- open FILE, "<", $path or die $!;
- $checksum = md5sum(\*FILE);
- close FILE or die $!;
- }
- $result .= "Checksum: " . $checksum . "\n";
- }
- print $result, "\n";
- }
- sub cmd_reset {
- my $target = shift || $_revision or die "SVN revision required\n";
- $target = $1 if $target =~ /^r(\d+)$/;
- $target =~ /^\d+$/ or die "Numeric SVN revision expected\n";
- my ($url, $rev, $uuid, $gs) = working_head_info('HEAD');
- unless ($gs) {
- die "Unable to determine upstream SVN information from ".
- "history\n";
- }
- my ($r, $c) = $gs->find_rev_before($target, not $_fetch_parent);
- die "Cannot find SVN revision $target\n" unless defined($c);
- $gs->rev_map_set($r, $c, 'reset', $uuid);
- print "r$r = $c ($gs->{ref_id})\n";
- }
- sub cmd_gc {
- if (!$can_compress) {
- warn "Compress::Zlib could not be found; unhandled.log " .
- "files will not be compressed.\n";
- }
- find({ wanted => \&gc_directory, no_chdir => 1}, "$ENV{GIT_DIR}/svn");
- }
- ########################### utility functions #########################
- sub rebase_cmd {
- my @cmd = qw/rebase/;
- push @cmd, '-v' if $_verbose;
- push @cmd, qw/--merge/ if $_merge;
- push @cmd, "--strategy=$_strategy" if $_strategy;
- @cmd;
- }
- sub post_fetch_checkout {
- return if $_no_checkout;
- my $gs = $Git::SVN::_head or return;
- return if verify_ref('refs/heads/master^0');
- # look for "trunk" ref if it exists
- my $remote = Git::SVN::read_all_remotes()->{$gs->{repo_id}};
- my $fetch = $remote->{fetch};
- if ($fetch) {
- foreach my $p (keys %$fetch) {
- basename($fetch->{$p}) eq 'trunk' or next;
- $gs = Git::SVN->new($fetch->{$p}, $gs->{repo_id}, $p);
- last;
- }
- }
- my $valid_head = verify_ref('HEAD^0');
- command_noisy(qw(update-ref refs/heads/master), $gs->refname);
- return if ($valid_head || !verify_ref('HEAD^0'));
- return if $ENV{GIT_DIR} !~ m#^(?:.*/)?\.git$#;
- my $index = $ENV{GIT_INDEX_FILE} || "$ENV{GIT_DIR}/index";
- return if -f $index;
- return if command_oneline(qw/rev-parse --is-inside-work-tree/) eq 'false';
- return if command_oneline(qw/rev-parse --is-inside-git-dir/) eq 'true';
- command_noisy(qw/read-tree -m -u -v HEAD HEAD/);
- print STDERR "Checked out HEAD:\n ",
- $gs->full_url, " r", $gs->last_rev, "\n";
- if (auto_create_empty_directories($gs)) {
- $gs->mkemptydirs($gs->last_rev);
- }
- }
- sub complete_svn_url {
- my ($url, $path) = @_;
- $path =~ s#/+$##;
- if ($path !~ m#^[a-z\+]+://#) {
- if (!defined $url || $url !~ m#^[a-z\+]+://#) {
- fatal("E: '$path' is not a complete URL ",
- "and a separate URL is not specified");
- }
- return ($url, $path);
- }
- return ($path, '');
- }
- sub complete_url_ls_init {
- my ($ra, $repo_path, $switch, $pfx) = @_;
- unless ($repo_path) {
- print STDERR "W: $switch not specified\n";
- return;
- }
- $repo_path =~ s#/+$##;
- if ($repo_path =~ m#^[a-z\+]+://#) {
- $ra = Git::SVN::Ra->new($repo_path);
- $repo_path = '';
- } else {
- $repo_path =~ s#^/+##;
- unless ($ra) {
- fatal("E: '$repo_path' is not a complete URL ",
- "and a separate URL is not specified");
- }
- }
- my $url = $ra->{url};
- my $gs = Git::SVN->init($url, undef, undef, undef, 1);
- my $k = "svn-remote.$gs->{repo_id}.url";
- my $orig_url = eval { command_oneline(qw/config --get/, $k) };
- if ($orig_url && ($orig_url ne $gs->{url})) {
- die "$k already set: $orig_url\n",
- "wanted to set to: $gs->{url}\n";
- }
- command_oneline('config', $k, $gs->{url}) unless $orig_url;
- my $remote_path = "$gs->{path}/$repo_path";
- $remote_path =~ s{%([0-9A-F]{2})}{chr hex($1)}ieg;
- $remote_path =~ s#/+#/#g;
- $remote_path =~ s#^/##g;
- $remote_path .= "/*" if $remote_path !~ /\*/;
- my ($n) = ($switch =~ /^--(\w+)/);
- if (length $pfx && $pfx !~ m#/$#) {
- die "--prefix='$pfx' must have a trailing slash '/'\n";
- }
- command_noisy('config',
- '--add',
- "svn-remote.$gs->{repo_id}.$n",
- "$remote_path:refs/remotes/$pfx*" .
- ('/*' x (($remote_path =~ tr/*/*/) - 1)) );
- }
- sub verify_ref {
- my ($ref) = @_;
- eval { command_oneline([ 'rev-parse', '--verify', $ref ],
- { STDERR => 0 }); };
- }
- sub get_tree_from_treeish {
- my ($treeish) = @_;
- # $treeish can be a symbolic ref, too:
- my $type = command_oneline(qw/cat-file -t/, $treeish);
- my $expected;
- while ($type eq 'tag') {
- ($treeish, $type) = command(qw/cat-file tag/, $treeish);
- }
- if ($type eq 'commit') {
- $expected = (grep /^tree /, command(qw/cat-file commit/,
- $treeish))[0];
- ($expected) = ($expected =~ /^tree ($sha1)$/o);
- die "Unable to get tree from $treeish\n" unless $expected;
- } elsif ($type eq 'tree') {
- $expected = $treeish;
- } else {
- die "$treeish is a $type, expected tree, tag or commit\n";
- }
- return $expected;
- }
- sub get_commit_entry {
- my ($treeish) = shift;
- my %log_entry = ( log => '', tree => get_tree_from_treeish($treeish) );
- my $commit_editmsg = "$ENV{GIT_DIR}/COMMIT_EDITMSG";
- my $commit_msg = "$ENV{GIT_DIR}/COMMIT_MSG";
- open my $log_fh, '>', $commit_editmsg or croak $!;
- my $type = command_oneline(qw/cat-file -t/, $treeish);
- if ($type eq 'commit' || $type eq 'tag') {
- my ($msg_fh, $ctx) = command_output_pipe('cat-file',
- $type, $treeish);
- my $in_msg = 0;
- my $author;
- my $saw_from = 0;
- my $msgbuf = "";
- while (<$msg_fh>) {
- if (!$in_msg) {
- $in_msg = 1 if (/^\s*$/);
- $author = $1 if (/^author (.*>)/);
- } elsif (/^git-svn-id: /) {
- # skip this for now, we regenerate the
- # correct one on re-fetch anyways
- # TODO: set *:merge properties or like...
- } else {
- if (/^From:/ || /^Signed-off-by:/) {
- $saw_from = 1;
- }
- $msgbuf .= $_;
- }
- }
- $msgbuf =~ s/\s+$//s;
- if ($Git::SVN::_add_author_from && defined($author)
- && !$saw_from) {
- $msgbuf .= "\n\nFrom: $author";
- }
- print $log_fh $msgbuf or croak $!;
- command_close_pipe($msg_fh, $ctx);
- }
- close $log_fh or croak $!;
- if ($_edit || ($type eq 'tree')) {
- chomp(my $editor = command_oneline(qw(var GIT_EDITOR)));
- system('sh', '-c', $editor.' "$@"', $editor, $commit_editmsg);
- }
- rename $commit_editmsg, $commit_msg or croak $!;
- {
- require Encode;
- # SVN requires messages to be UTF-8 when entering the repo
- local $/;
- open $log_fh, '<', $commit_msg or croak $!;
- binmode $log_fh;
- chomp($log_entry{log} = <$log_fh>);
- my $enc = Git::config('i18n.commitencoding') || 'UTF-8';
- my $msg = $log_entry{log};
- eval { $msg = Encode::decode($enc, $msg, 1) };
- if ($@) {
- die "Could not decode as $enc:\n", $msg,
- "\nPerhaps you need to set i18n.commitencoding\n";
- }
- eval { $msg = Encode::encode('UTF-8', $msg, 1) };
- die "Could not encode as UTF-8:\n$msg\n" if $@;
- $log_entry{log} = $msg;
- close $log_fh or croak $!;
- }
- unlink $commit_msg;
- \%log_entry;
- }
- sub s_to_file {
- my ($str, $file, $mode) = @_;
- open my $fd,'>',$file or croak $!;
- print $fd $str,"\n" or croak $!;
- close $fd or croak $!;
- chmod ($mode &~ umask, $file) if (defined $mode);
- }
- sub file_to…
Large files files are truncated, but you can click here to view the full file