'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,
{ 'message|m=s' => \$_message,
'destination|d=s' => \$_branch_dest,
'dry-run|n' => \$_dry_run,
- 'tag|t' => \$_tag } ],
+ '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 } ],
+ '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, } ],
}
}
my ($lft, $rgt) = @{ $glob->{path} }{qw/left right/};
- my $dst = join '/', $remote->{url}, $lft, $branch_name, ($rgt || ());
+ 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->{url};
+ }
+ }
+ my $dst = join '/', $url, $lft, $branch_name, ($rgt || ());
if ($dst =~ /^https:/ && $src =~ /^http:/) {
$src=~s/^http:/https:/;
my $rs = {
t => $t,
remote => $remote,
- path => Git::SVN::GlobSpec->new($local_ref),
- ref => Git::SVN::GlobSpec->new($remote_ref) };
+ path => Git::SVN::GlobSpec->new($local_ref, 1),
+ ref => Git::SVN::GlobSpec->new($remote_ref, 0) };
if (length($rs->{ref}->{right}) != 0) {
die "The '*' glob character must be the last ",
"character of '$remote_ref'\n";
die "Can't have both 'useSvnsyncProps' and 'rewriteRoot' ",
"options set!\n";
}
+ if ($self->rewrite_uuid) {
+ die "Can't have both 'useSvnsyncProps' and 'rewriteUUID' ",
+ "options set!\n";
+ }
my $svnsync;
# see if we have it in our config, first:
$self->{-rewrite_root} = $rwr;
}
+sub rewrite_uuid {
+ my ($self) = @_;
+ return $self->{-rewrite_uuid} if exists $self->{-rewrite_uuid};
+ my $k = "svn-remote.$self->{repo_id}.rewriteUUID";
+ my $rwid = eval { command_oneline(qw/config --get/, $k) };
+ if ($rwid) {
+ $rwid =~ s#/+$##;
+ if ($rwid !~ m#^[a-f0-9]{8}-(?:[a-f0-9]{4}-){3}[a-f0-9]{12}$#) {
+ die "$rwid is not a valid UUID (key: $k)\n";
+ }
+ }
+ $self->{-rewrite_uuid} = $rwid;
+}
+
sub metadata_url {
my ($self) = @_;
($self->rewrite_root || $self->{url}) .
die "Can't have both 'useSvmProps' and 'rewriteRoot' ",
"options set!\n";
}
+ if ($self->rewrite_uuid) {
+ die "Can't have both 'useSvmProps' and 'rewriteUUID' ",
+ "options set!\n";
+ }
my ($uuid, $r) = $headrev =~ m{^([a-f\d\-]{30,}):(\d+)$}i;
# we don't want "SVM: initializing mirror for junk" ...
return undef if $r == 0;
} else {
my $url = $self->metadata_url;
remove_username($url);
- $log_entry{metadata} = "$url\@$rev " .
- $self->ra->get_uuid;
- $email ||= "$author\@" . $self->ra->get_uuid;
- $commit_email ||= "$author\@" . $self->ra->get_uuid;
+ my $uuid = $self->rewrite_uuid || $self->ra->get_uuid;
+ $log_entry{metadata} = "$url\@$rev " . $uuid;
+ $email ||= "$author\@" . $uuid;
+ $commit_email ||= "$author\@" . $uuid;
}
$log_entry{name} = $name;
$log_entry{email} = $email;
'--');
my $metadata_url = $self->metadata_url;
remove_username($metadata_url);
- my $svn_uuid = $self->ra_uuid;
+ my $svn_uuid = $self->rewrite_uuid || $self->ra_uuid;
my $c;
while (<$log>) {
if ( m{^commit ($::sha1)$} ) {
next if (length $g->{path}->{right} &&
($self->check_path($p, $r) !=
$SVN::Node::dir));
+ next unless $p =~ /$g->{path}->{regex}/;
$exists->{$p} = Git::SVN->init($self->{url}, $p, undef,
$g->{ref}->full_path($de), 1);
}
use warnings;
sub new {
- my ($class, $glob) = @_;
+ my ($class, $glob, $pattern_ok) = @_;
my $re = $glob;
$re =~ s!/+$!!g; # no need for trailing slashes
- $re =~ m!^([^*]*)(\*(?:/\*)*)(.*)$!;
- my $temp = $re;
- my ($left, $right) = ($1, $3);
- $re = $2;
- my $depth = $re =~ tr/*/*/;
- if ($depth != $temp =~ tr/*/*/) {
- die "Only one set of wildcard directories " .
- "(e.g. '*' or '*/*/*') is supported: '$glob'\n";
+ my (@left, @right, @patterns);
+ my $state = "left";
+ my $die_msg = "Only one set of wildcard directories " .
+ "(e.g. '*' or '*/*/*') is supported: '$glob'\n";
+ for my $part (split(m|/|, $glob)) {
+ if ($part =~ /\*/ && $part ne "*") {
+ die "Invalid pattern in '$glob': $part\n";
+ } elsif ($pattern_ok && $part =~ /[{}]/ &&
+ $part !~ /^\{[^{}]+\}/) {
+ die "Invalid pattern in '$glob': $part\n";
+ }
+ if ($part eq "*") {
+ die $die_msg if $state eq "right";
+ $state = "pattern";
+ push(@patterns, "[^/]*");
+ } elsif ($pattern_ok && $part =~ /^\{(.*)\}$/) {
+ die $die_msg if $state eq "right";
+ $state = "pattern";
+ my $p = quotemeta($1);
+ $p =~ s/\\,/|/g;
+ push(@patterns, "(?:$p)");
+ } else {
+ if ($state eq "left") {
+ push(@left, $part);
+ } else {
+ push(@right, $part);
+ $state = "right";
+ }
+ }
}
+ my $depth = @patterns;
if ($depth == 0) {
- die "One '*' is needed for glob: '$glob'\n";
- }
- $re =~ s!\*!\[^/\]*!g;
- $re = quotemeta($left) . "($re)" . quotemeta($right);
- if (length $left && !($left =~ s!/+$!!g)) {
- die "Missing trailing '/' on left side of: '$glob' ($left)\n";
- }
- if (length $right && !($right =~ s!^/+!!g)) {
- die "Missing leading '/' on right side of: '$glob' ($right)\n";
+ die "One '*' is needed in glob: '$glob'\n";
}
+ my $left = join('/', @left);
+ my $right = join('/', @right);
+ $re = join('/', @patterns);
+ $re = join('\/',
+ grep(length, quotemeta($left), "($re)", quotemeta($right)));
my $left_re = qr/^\/\Q$left\E(\/|$)/;
bless { left => $left, right => $right, left_regex => $left_re,
regex => qr/$re/, glob => $glob, depth => $depth }, $class;