view release on metacpan or  search on metacpan

lib/SVK/Mirror/Backend/SVNRa.pm  view on Meta::CPAN

    return $self->_init_state($txn, $editor);
}

sub _init_state {
    my ($self, $txn, $editor) = @_;

    my $mirror = $self->mirror;
    my $uuid = $mirror->server_uuid;

    my $t = $mirror->get_svkpath('/');
    die loc( "%1 already exists.\n", $mirror->path )
        if $t->root->check_path( $mirror->path );

    $self->_check_overlap;

    unless ($txn) {
        my %opt;
        ( $editor, %opt ) = $t->get_dynamic_editor(
            ignore_mirror => 1,
            author        => $ENV{USER},
        );
        $opt{txn}->change_prop( 'svm:headrev', "$uuid:0" );
    }
    else {
        $txn->change_prop( 'svm:headrev', "$uuid:0" );
    }

    my $dir_baton = $editor->add_directory( substr($mirror->path, 1), 0, undef, -1 );
    $editor->change_dir_prop( $dir_baton, 'svm:uuid', $uuid);
    $editor->change_dir_prop( $dir_baton, 'svm:source', $self->source_root.'!'.$self->source_path );
    $editor->close_directory($dir_baton);
    $editor->adjust;
    $editor->close_edit unless $txn;

    $mirror->server_uuid( $uuid );

    return $self;
}

sub _check_overlap {
    my ($self) = @_;
    my $depot = $self->mirror->depot;
    my $fs = $depot->repos->fs;
    my $root = $fs->revision_root($fs->youngest_rev);
    my $prop = $root->node_prop ('/', 'svm:mirror') or return;
    my @mirrors = $prop =~ m/^(.*)$/mg;

    for (@mirrors) {
	my $mirror = SVK::Mirror->load( { depot => $depot, path => $_ } );
	next if $self->source_root ne $mirror->_backend->source_root;
	# XXX: check overlap with svk::mirror objects.

	my ($me, $other) = map { Path::Class::Dir->new_foreign('Unix', $_) }
	    $self->source_path, $mirror->_backend->source_path;
	die "Mirroring overlapping paths not supported\n"
	    if $me->subsumes($other) || $other->subsumes($me);
    }
}

=item relocate($newurl)

=cut

sub relocate {
    my ($self, $source, $options) = @_;

    $source =~ s{/+$}{}g;
    my $ra = $self->_new_ra(url => $source);
    my $ra_uuid = $ra->get_uuid;
    my $mirror = $self->mirror;
    die loc("Mirror source UUIDs differ.\n")
	unless $ra_uuid eq $mirror->server_uuid;
    my $source_root = $ra->get_repos_root;
    my $source_path = $source;
    die "source url not under source root"
	if substr($source_path, 0, length($source_root), '') ne $source_root;

    die loc( "Can't relocate: mirror subdirectory changed from %1 to %2.\n",
        $self->source_path, $source_path )
        unless $self->source_path eq $source_path;

    $self->source_root( $ra->get_repos_root );
    $mirror->url($source);

    $self->_do_relocate;
}

sub _do_relocate {
    my ($self) = @_;
    my $mirror = $self->mirror;
    my $t = $mirror->get_svkpath;

    my ( $editor, %opt ) = $t->get_dynamic_editor(
        ignore_mirror => 1,
        message       => loc( 'Mirror relocated to %1', $mirror->url ),
        author        => $ENV{USER},
    );
    $opt{txn}->change_prop( 'svm:headrev', join(':', $mirror->server_uuid, $self->fromrev ) );
    $opt{txn}->change_prop( 'svm:incomplete', '*');

    $editor->change_dir_prop( 0, 'svm:source', $self->source_root.'!'.$self->source_path );
    $editor->adjust;
    $editor->close_edit;
}

=item has_replay_api

Returns if the svn client library has replay capability

=cut

sub has_replay_api {
    my $self = shift;

    return if $ENV{SVKNORAREPLAY};

    return unless _p_svn_ra_session_t->can('replay');

    # The Perl bindings shipped with 1.4.0 has broken replay support
    return $SVN::Core::VERSION gt '1.4.0';
}

=item has_replay

Returns if we can do ra_replay with the mirror source url.

=cut

sub has_replay {
    my $self = shift;
    return $self->_has_replay if defined $self->_has_replay;

    return $self->_has_replay(0) unless $self->has_replay_api;

    my $ra = $self->_new_ra;

    my $err;
    {
        local $SVN::Error::handler = sub { $err = $_[0]; die \'error handled' };
        if ( eval { $ra->replay( 0, 0, 0, SVK::Editor->new ); 1 } ) {
            $self->_ra_finished($ra);
            return $self->_has_replay(1);
        }
        die $@ unless $err;
    }
    $self->_ra_finished($ra);
    # FIXME: if we do ^c here $err would be empty. do something else.
    return $self->_has_replay(0)
      if $err->apr_err == $SVN::Error::RA_NOT_IMPLEMENTED      # ra_svn
      || $err->apr_err == $SVN::Error::UNSUPPORTED_FEATURE     # ra_dav
      || $err->apr_err == $SVN::Error::RA_DAV_REQUEST_FAILED;  # ra_dav (googlecode)
    die $err->expanded_message;
}

sub _new_ra {