view release on metacpan or  search on metacpan

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

    }

    my $pool = SVN::Pool->new_default;
    while ( my $record = $dump->next_record() ) {
	if ($record->type eq 'format' or $record->type eq 'uuid') {
	    $header = $header.$record->as_string;
	    next;
	}

	for my $r ($record, $record->get_included_record) {
	    next unless $r;

	    if (my $path = $r->get_header('Node-copyfrom-path')) {
		$path = $prefix.$path;
		$r->set_header('Node-copyfrom-path' => $path );
	    }

	    if ($r->get_header('Revision-number')) {
		printf STDERR "%s rev:%d\r",$progress->report( "%45b",$rev),$rev;
		$rev = $r->get_header('Revision-number');
		$prev = $rev if !$prev;
		$r->set_property('svm:headrev',$self->source_uuid.':'.$rev."\n");
	    }

	    if ( my $path = $r->get_header('Node-path') ) {
		$path = $prefix.$path;
		$r->set_header('Node-path' => $path);
	    }
	}

	if ($rev and $prev != $rev) {
	    $self->_import_repos($header, $buf, $pool) if $prev > $self->fromrev;
	    $pool->clear;
	    $buf = "";
	    $prev = $rev;
	}

	$buf = $buf.$record->as_string;
    }
    # last one
    if ($rev) {
	$self->_import_repos($header, $buf, $pool) if $prev > $self->fromrev;
    }

}

sub _import_repos {
    my $self = shift;
    my ($header, $buf, $pool) = @_;
    $buf = $header.$buf;
    open my $fh, '<', \$buf;
    my $feedback = '';
    open my $fstream, '>', \$feedback;
    my $ret = SVN::Repos::load_fs2( $self->repos, $fh, $fstream, $SVN::Repos::load_uuid_default, undef, 0, 0, undef, undef, $pool );
    # (repos,dumpstream,feedback_stream,uuid_action,parent_dir,use_pre_commit_hook,use_post_commit_hook,cancel_func,cancel_baton,pool);
    # XXX: display $feedback if we are in verbose / debug mode.
    # and provide progress feedback in caller
    return $ret;
}

=item relocate($newurl)

=item with_lock($code)

=cut

sub with_lock {
    my ( $self, $lock, $code ) = @_;

    $self->lock;
    eval { $code->() };
    $self->unlock;
    die $@ if $@;
}

sub _lock_token {
    my $token = $_[0]->path;
    $token =~ s/_/__/g;
    $token =~ s{/}{_}g;
    return "svm:lock:$token";
}

sub _lock_content { hostname . ':' . $$ };

sub lock {
    my ($self)  = @_;
    my $fs      = $self->repos->fs;
    my $token   = $self->_lock_token;
    my $content = $self->_lock_content;
    my $where = join( ' ', ( caller(0) )[ 0 .. 2 ] );

    my $lock_message = $self->_lock_message;
    # This is not good enough but race condition should result in failed sync
    # without corrupting repository.
LOCKED:
    {
	my $pool = SVN::Pool->new_default;
        while (1) {
	    $pool->clear;
            my $who = $fs->revision_prop( 0, $token ) or last LOCKED;
	    last if $who eq $content;
	    $lock_message->($self, $who);
            sleep 1;
        }
    }
    $fs->change_rev_prop( 0, $token, $content );
    $self->_locked(1);
}

sub unlock {
    my ( $self, $force ) = @_;
    my $fs = $self->repos->fs;
    if ($force) {
        for ( keys %{ $fs->revision_proplist(0) } ) {
            next unless m/^svm:lock:/;
            $fs->change_rev_prop( 0, $_, undef );
        }
        return;
    }

    my $token = $self->_lock_token;
    if ( $self->_locked ) {
        $fs->change_rev_prop( 0, $token, undef );
        $self->_locked(0);
    }
}

=item find_changeset($localrev)

Returns an opaque object that C<sync_changeset> understands.

=cut

=item find_rev_from_changeset($remote_identifier)

=item traverse_new_changesets($code)

calls C<$code> with an opaque object and metadata that C<sync_changeset> understands.

=item sync_changeset($changeset, $metadata)

=item mirror_changesets

=item get_commit_editor

=item url

=cut

sub get_svkpath {
    my ($self, $path) = @_;
    return SVK::Path->real_new( { depot => $self->depot, path => $path || $self->path } )
      ->refresh_revision;
}

for my $delegate
    qw( find_rev_from_changeset find_changeset sync_changeset traverse_new_changesets mirror_changesets get_commit_editor refresh change_rev_prop fromrev source_path relocate )
{
    no strict 'refs';
    *{$delegate} = sub {
        my $self   = shift;
	Carp::cluck $delegate unless $self->_backend;
        my $method = $self->_backend->can($delegate);
        unshift @_, $self->_backend;
        goto $method;
    };
}

# compat methods

sub spec {
    my $self = shift;
    return join(':', $self->server_uuid, $self->_backend->source_path);
}

sub find_local_rev {
    my ($self, $changeset, $uuid) = @_;
    $self->_rev_cache({}) unless $self->_rev_cache;
    $self->_rev_cache->{$uuid || ''}{$changeset}
        ||= $self->find_rev_from_changeset($changeset, $uuid);
}

sub find_remote_rev {
    goto \&find_changeset;
}

sub get_merge_back_editor {
    my $self = shift;
    return ($self->_backend->fromrev, $self->get_commit_editor(@_));
}

sub run {
    my ($self, $torev, $fake_last) = @_;
    return $self->run_svnmirror_sync({ torev => $torev }) unless $self->_backend->has_replay;

    $logger->info(loc("Syncing %1", $self->url).($self->_backend->_relayed ? loc(" via %1", $self->server_url) : ""));

    $self->{use_progress} = 1 unless SVK::Test->can('is_output');

    $self->mirror_changesets($torev,
        sub {
            my ( $changeset, $rev ) = @_;
            $logger->info("Committed revision $rev from revision $changeset.")
                unless $self->{use_progress};
        }, $fake_last
    );
    die $@ if $@;
}

sub sync_snapshot {
    my ($self, $snapshot) = @_;
    $logger->warn(loc("
svk is now taking a snapshot of the repository at:
  %1

This is essentially making a checkout of the url, and is bad if the
url contains directories like trunk and branches.  If this isn't what