SVN-Mirror
view release on metacpan or search on metacpan
lib/SVN/Mirror.pm view on Meta::CPAN
}
# prepare source
sub pre_init {}
sub init {
my $self = shift;
my $pool = SVN::Pool->new_default ($self->{pool});
if ($self->is_initialized) {
$self->pre_init (0);
$self->load_state ();
return 0;
}
return $self->do_initialize;
}
sub is_initialized {
my $self = shift;
my $headrev = $self->{headrev} ||= $self->{fs}->youngest_rev;
$self->{root} ||= $self->{fs}->revision_root ($headrev);
if ($self->{target_path} eq '/') {
$self->{fs}->revision_root($self->{headrev})->node_prop('/', 'svm:source');
}
else {
# XXX: verify this is a valid mirror too.
$self->{root}->check_path ($self->{target_path}) != $SVN::Node::none;
}
}
sub do_initialize {
my $self = shift;
$self->pre_init (1);
my $txn = $self->{fs}->begin_txn ($self->{headrev});
my $txnroot = $txn->root;
$self->mkpdir ($txnroot, $self->{target_path});
my $source = $self->init_state ($txn);
my %mirrors = map { ($_ => 1) }
split(/\n/, $txnroot->node_prop ('/', 'svm:mirror') || '');
$mirrors{$self->{target_path}}++;
$txnroot->change_node_prop ('/', 'svm:mirror', join("\n", (grep length, sort keys %mirrors), ''));
$txnroot->change_node_prop ($self->{target_path}, 'svm:source', $source);
$txnroot->change_node_prop ($self->{target_path}, 'svm:uuid', $self->{source_uuid});
my $rev = $self->commit_txn($txn);
print "Committed revision $rev.\n";
$self->{fs}->change_rev_prop ($rev, "svn:author", 'svm');
$self->{fs}->change_rev_prop
($rev, "svn:log", "SVM: initializing mirror for $self->{target_path}");
return $rev;
}
sub relocate {
my $self = shift;
my $pool = SVN::Pool->new_default ($self->{pool});
my $headrev = $self->{headrev} = $self->{fs}->youngest_rev;
$self->{root} = $self->{fs}->revision_root ($headrev);
$self->is_initialized
or die "Cannot relocate uninitialized path $self->{target_path}";
$self->pre_init (0);
$self->load_state ();
my $ra = $self->_new_ra (url => $self->{source});
my $ra_uuid = $ra->get_uuid;
die "Local and remote UUID differ." unless ($ra_uuid eq $self->{source_uuid} or $ra_uuid eq $self->{rsource_uuid});
# Get latest revprops
my $old_prevs = $self->{fs}->revision_proplist(
$self->find_local_rev($self->{fromrev}) , $pool
);
my $rev = $self->do_initialize;
$self->{fs}->change_rev_prop ($rev, $_ => $old_prevs->{$_})
for sort grep /^svm:/, keys %$old_prevs;
$self->{fs}->change_rev_prop ($rev, 'svm:incomplete' => '*');
return $rev;
}
sub mergeback {
my ($self, $fromrev, $path, $rev) = @_;
# verify $path is copied from $self->{target_path}
# concat batch merge?
my $msg = $self->{fs}->revision_prop ($rev, 'svn:log');
$msg .= "\n\nmerged from rev $rev of repository ".$self->{fs}->get_uuid;
my $editor = $self->get_merge_back_editor ('', $msg,
sub {warn "committed via RA"});
# dir_delta ($path, $fromrev, $rev) for commit_editor
SVN::Repos::dir_delta($self->{fs}->revision_root ($fromrev), $path,
$SVN::Core::VERSION ge '0.36.0' ? '' : undef,
$self->{fs}->revision_root ($rev), $path,
$editor, undef,
1, 1, 0, 1
);
}
sub mkpdir {
my ($self, $root, $dir) = @_;
my @dirs = File::Spec::Unix->splitdir($self->{target_path});
my $path = '';
my $new;
while (@dirs) {
$path = File::Spec::Unix->join($path, shift @dirs);
my $kind = $self->{root}->check_path ($path);
if ($kind == $SVN::Core::node_none) {
$root->make_dir ($path, SVN::Pool->new);
$new = 1;
}
elsif ($kind != $SVN::Core::node_dir) {
die "something is in the way of mirror root($path)";
}
}
( run in 0.936 second using v1.01-cache-2.11-cpan-5511b514fd6 )