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 )