view release on metacpan or  search on metacpan

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

	  } );
}

=head2 $self->seek_to($revision)

Return the C<SVK::Path> object that C<$self> is at C<$revision>.  Note
that we don't have forward tracing, so if <$revision is greater than
C<$self->revision>, a C<SVK::Path> at <$revision> will be returned.
In other words, assuming C<foo@N> for C<-r N foo@M> when N > M.

=cut

sub seek_to {
    my ($self, $revision) = @_;

    return $self->mclone( revision => $revision )
        if $revision >= $self->revision;

    # if the path not exist then we should trace back history and watch copies
    # and descedants
    if ( $self->root->check_path( $self->path ) == $SVN::Node::none ) {
        # find a parent that exist
        my $tmp = $self->mclone( path_anchor => $self->path, targets => undef );
        while ( $tmp->root->check_path( $tmp->path_anchor ) == $SVN::Node::none ) {
            $tmp->anchorify;
        }
        my $res = $tmp->_seek_to_by_anchor( $revision );
        return $res if $res;
    }

    while (my ($toroot, $fromroot, $path) = $self->nearest_copy) {
        last if $toroot->revision_root_revision <= $revision;
        $self = $self->mclone( path => $path,
                               revision => $fromroot->revision_root_revision );
    }
    return $self->mclone( revision => $revision )
}

sub _seek_to_by_anchor {
    my ($self, $revision) = @_;

    my $anchor = $self->path_anchor;

    my ($found_at_rev, $switch_to) = (undef, undef);
    traverse_history (
        root  => $self->root,
        path  => $anchor,
        cross => 1,
        callback => sub {
            my ($path, $rev) = @_;
            if ($path ne $anchor) {
                $anchor = $self->path_anchor( $path );
            }

            if ( $self->as_depotpath( $rev )->root->check_path( $self->path ) != $SVN::Node::none ) {
                $found_at_rev = $rev < $revision? $revision : $rev;
                return 0;
            }
            return 0 if $rev < $revision;
            
            my @target = split m{/}, $self->path_target;
            return 1 if @target < 2;

            my @left = (shift @target);
            my @right = (@target);

            while ( @right >= 1 ) {
                my $deanchored = $self->mclone(
                    path_anchor => $self->path_anchor .'/'. join( '/', @left ),
                    targets     => [ join '/', @right ],
                    revision    => $rev,
                    _root       => undef,
                );
                if ( $deanchored->root->check_path( $deanchored->path_anchor ) == $SVN::Node::none ) {
                    last;
                }
                $switch_to = $deanchored;
                push @left, shift @right;
            }
            return $switch_to? 0 : 1;
        },
    );
    return $switch_to->_seek_to_by_anchor( $revision ) if $switch_to;
    return $self->mclone( path => $self->path, targets => undef, revision => $found_at_rev )->seek_to( $revision )
        if defined $found_at_rev;
}

*path_anchor = __PACKAGE__->make_accessor('path');
push @{__PACKAGE__->_clonable_accessors}, 'path_anchor';

sub path_target { $_[0]->{targets}[0] || '' }

use Data::Dumper;
sub dump { warn Dumper($_[0]) }

sub prev {
    my ($self) = shift;
    my $prev = $self->as_depotpath($self->revision-1);

    eval { $prev->normalize; 1 } or return ;

    return $prev;
}

=head1 as_url($local_only, [ $path, $rev ])

Returns (url, revision) pair.

=cut

sub as_url {
    my ($self, $local_only) = @_;
    my ($path, $rev) = ($_[2] || $self->path_anchor, $_[3] || $self->revision);

    if (!$local_only && (my $m = $self->is_mirrored)) {
        my ($m_path, $m_url) = ($m->path, $m->url);
	$path =~ s/^\Q$m_path\E/$m_url/;
	$path =~ s/%/%25/g;
	$path = uri_escape($path);
        if (my $remote_rev = $m->find_remote_rev($rev)) {
            $rev = $remote_rev;