# BEGIN BPS TAGGED BLOCK {{{
# COPYRIGHT:
#
# This software is Copyright (c) 2003-2006 Best Practical Solutions, LLC
# <clkao@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
#
#
# LICENSE:
#
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of either:
#
# a) Version 2 of the GNU General Public License. You should have
# received a copy of the GNU General Public License along with this
# program. If not, write to the Free Software Foundation, Inc., 51
# Franklin Street, Fifth Floor, Boston, MA 02110-1301 or visit
# their web page on the internet at
# http://www.gnu.org/copyleft/gpl.html.
#
# b) Version 1 of Perl's "Artistic License". You should have received
# a copy of the Artistic License with this package, in the file
# named "ARTISTIC". The license is also available at
# http://opensource.org/licenses/artistic-license.php.
#
# This work is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# CONTRIBUTION SUBMISSION POLICY:
#
# (The following paragraph is not intended to limit the rights granted
# to you to modify and distribute this software under the terms of the
# GNU General Public License and is only of importance to you if you
# choose to contribute your changes and enhancements to the community
# by submitting them to Best Practical Solutions, LLC.)
#
# By intentionally submitting any modifications, corrections or
# derivatives to this work, or any other work intended for use with SVK,
# to Best Practical Solutions, LLC, you confirm that you are the
# copyright holder for those contributions and you grant Best Practical
# Solutions, LLC a nonexclusive, worldwide, irrevocable, royalty-free,
# perpetual, license to use, copy, create derivative works based on
# those contributions, and sublicense and distribute those contributions
# and any derivatives thereof.
#
# END BPS TAGGED BLOCK }}}
package SVK::Editor::Rename;
use strict;
use SVK::Version; our $VERSION = $SVK::VERSION;
use base qw(SVK::Editor::Patch);
use SVK::I18N;
use SVK::Util 'is_path_inside';
=head1 NAME
SVK::Editor::Rename - An editor that translates editor calls for renamed entries
=head1 SYNOPSIS
$editor = SVK::Editor::Rename->new
( editor => $next_editor,
rename_map => \@rename_map
);
=head1 DESCRIPTION
Given the rename_map, which is a list of [from, to] pairs for
translating path in editor calls, C<SVK::Editor::Rename> serialize the
calls and rearrange them for making proper calls to C<$next_editor>.
The translation of pathnames is done with iterating through the
C<@rename_map>, translate with the first match. Translation is redone
untill no match is found.
C<SVK::Editor::Rename> is a subclass of C<SVK::Editor::Patch>, which
serailizes incoming editor calls. Each baton opened is recorded in
C<$self->{opened_baton}>, which could be use to lookup with path names.
When a path is opened that should be renamed, it's recorded in
C<$self->{renamed_anchor}> for reanchoring the renamed result to
proper parent directory before calls are emitted to C<$next_editor>.
=cut
sub rename_check {
my ($self, $path, $nocache) = @_;
return $self->{rename_cache}{$path}
if exists $self->{rename_cache}{$path};
for (@{$self->{rename_map}}) {
my ($from, $to) = @$_;
if (is_path_inside($path, $from)) {
my $newpath = $path;
$newpath =~ s/^\Q$from\E/$to/;
$newpath = $self->rename_check ($newpath, 1);
$self->{rename_cache}{$path} = $newpath;
return $newpath;
}
}
return $path;
}
sub _same_parent {
my ($path1, $path2) = @_;
$path1 =~ s|/[^/]*$|/|;
$path2 =~ s|/[^/]*$|/|;
return $path1 eq $path2;
}
sub open_root {
my ($self, @arg) = @_;
my $ret = $self->SUPER::open_root (@arg);
$self->{opened_baton}{''} = [$ret, 0];
return $ret;
}
sub AUTOLOAD {
my ($self, @arg) = @_;
my $func = our $AUTOLOAD;
my $class = ref ($self);
$func =~ s/^.*:://;
return if $func =~ m/^[A-Z]+$/;
my $baton_at = $self->baton_at ($func);
my ($renamed, $renamed_anchor);
if ($baton_at > 0) {
my $newpath = $self->rename_check ($arg[0]);
if ($newpath ne $arg[0]) {
++$renamed;
# XXX: always reanchor for now. skip those non-leaf matching.
# 'mv A/file A/B/file; mv A/B A/C'
# tracking the change made on file would die on opening 'B'
# if (exists $self->{renamed}[$arg[1]]) {
# }
# else {
++$renamed_anchor unless _same_parent ($newpath, $arg[0]);
# }
$arg[0] = $newpath;
}
}
my $sfunc = "SUPER::$func";
my $ret = $self->$sfunc (@arg);
$self->{renamed}[$ret]++ if $renamed && $ret;
if ($renamed_anchor) {
push @{$self->{renamed_anchor}}, $self->{edit_tree}[$arg[$baton_at]][-1];
}
else {
$self->{opened_baton}{$arg[0]} = [$ret, $arg[1]]
if $func =~ m/^open/;
}
return $ret;
}
sub open_parent {
my ($self, $path) = @_;
my $parent = $path;
$parent =~ s|/[^/]*$|| or $parent = '';
return @{$self->{opened_baton}{$parent}}
if exists $self->{opened_baton}{$parent};
my ($pbaton, $ppbaton) = $self->open_parent ($parent);
++$self->{batons};
# XXX: If inspector is always there, then the first check isn't necessary.
if ($self->{inspector} && !$self->{inspector}->exist($parent)) {
unshift @{$self->{edit_tree}[$pbaton]},
[$self->{batons}, 'add_directory', $parent, $ppbaton, undef, -1];
}
else {
unshift @{$self->{edit_tree}[$pbaton]},
[$self->{batons}, 'open_directory', $parent, $ppbaton, -1];
}
$self->{edit_tree}[$self->{batons}] = [[undef, 'close_directory', $self->{batons}]];
$self->{opened_baton}{$parent} = [$self->{batons}, $pbaton];
return ($self->{batons}, $pbaton);
}
sub adjust_anchor {
my ($self, $entry) = @_;
my $path = $entry->[2];
my ($pbaton) = $self->open_parent ($path);
my @newentry = @$entry;
$self->_insert_entry ($self->{edit_tree}[$pbaton] ||= [], \@newentry);
$newentry[2+$self->baton_at ($entry->[1])] = $pbaton;
@$entry = [];
}
sub adjust_last_anchor {
$_[0]->adjust_anchor($_[0]{edit_tree}[0][-1]);
}
sub _insert_entry {
my ($self, $anchor, $entry) = @_;
# move the call to a proper place.
# retain the order, but calls must be placed before close.
if (@$anchor && $anchor->[-1][1] =~ m/^close/) {
splice @$anchor, -1, 0, $entry;
}
else {
push @$anchor, $entry;
}
}
sub close_edit {
my $self = shift;
$self->SUPER::close_edit (@_);
for (@{$self->{renamed_anchor}}) {
$self->adjust_anchor($_);
}
# XXX: addition phase here to trim useless opens.
$self->drive ($self->{editor});
#SVN::Delta::Editor->new (_debug => 1, _editor => [$self->{editor}]));
}
# Make sure driven editor aborts too.
sub abort_edit {
my $self = shift;
$self->SUPER::abort_edit (@_);
my $r = $self->{editor}->abort_edit(@_);
return $r;
}
1;