Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
390 lines (305 sloc) 9.55 KB
package SVN::Dump::Replayer;
# Replay a Subversion dump. Must be subclassed with something classy.
use Moose;
extends qw(SVN::Dump::Walker);
use File::Copy;
use File::Path;
use Cwd;
use Carp qw(confess);
use Digest::MD5 qw(md5_hex);
use Log::Any qw($log);
use SVN::Dump::Arborist;
has verbose => ( is => 'ro', isa => 'Bool', default => 0 );
# Replays go somewhere. Optional because we might replay somewhere
# dissociated from a filesystem.
has replay_base => (
is => 'ro',
isa => 'Str',
);
has copy_source_depot => (
is => 'ro',
isa => 'Str',
required => 1,
);
has directory_stack => (
is => 'rw',
isa => 'ArrayRef[Str]',
default => sub { [] },
);
has include_regexp => (
is => 'ro',
isa => 'Maybe[RegexpRef]',
);
has db_file_name => ( is => 'rw', isa => 'Str' );
has arborist => (
is => 'ro',
isa => 'SVN::Dump::Arborist',
lazy => 1,
default => sub {
my $self = shift;
return SVN::Dump::Arborist->new(
verbose => $self->verbose(),
db_file_name => $self->db_file_name(),
svn_dump_filename => $self->svn_dump_filename(),
);
},
);
#######################
### Low-level tracking.
sub on_walk_begin {
my $self = shift;
# Initialize the copy source depot.
$self->do_rmdir($self->copy_source_depot()) if -e $self->copy_source_depot();
$self->do_mkdir($self->copy_source_depot());
}
sub on_revision_done {
my ($self, $revision_id) = @_;
# Finalize the revision object, and return it.
my $revision = $self->arborist()->finalize_revision();
# Apply all the changes it represents.
CHANGE: foreach my $change (@{$revision->changes()}) {
my $operation = $change->operation();
my $dst_analysis = $change->analysis();
$log->trace("REP) doing: $operation ", $change->path());
$log->trace(
"REP) entity: ", $dst_analysis->ent_type(),
" ", $dst_analysis->ent_name()
);
$log->trace(
"REP) status: ", ($dst_analysis->is_entity() ? "is" : "is not"),
" entity"
);
# Change is an entity. Perhaps something is tagged or branched?
if ($change->is_entity()) {
my $entity_type = $dst_analysis->ent_type();
if ($entity_type eq "branch") {
$operation = "branch_$operation";
}
elsif ($entity_type eq "tag") {
$operation = "tag_$operation";
}
elsif ($entity_type eq "meta") {
# TODO - Do nothing?
}
else {
confess "unexpected entity type: $entity_type";
}
}
# Change to a non-container is easy.
my $method = "on_$operation";
$log->trace("REP) calling method $method");
$self->$method($change, $revision);
}
}
sub on_revision {
my ($self, $revision, $author, $date, $log_message) = @_;
$log->trace("r$revision by $author at $date");
$log_message = "(none)" unless (
defined($log_message) and length($log_message)
);
chomp $log_message;
$self->arborist()->start_revision($revision, $author, $date, $log_message);
undef;
}
sub on_node_add {
my ($self, $revision, $path, $kind, $data) = @_;
$self->arborist()->add_new_node($revision, $path, $kind, $data);
undef;
}
sub on_node_change {
my ($self, $revision, $path, $kind, $data) = @_;
$self->arborist()->touch_node($revision, $path, $kind, $data);
}
# According to the Red Bean Subersion book, "replacement" happens when
# a node is scheduled for deletion and addition in the same commit.
# As of svn 1.6.6 I'm not sure how to do this for a directory. Maybe
# older versions permitted it?
# TODO - We may need a special "replace" operation if having deletion
# and addition in the same revision is confusing.
sub on_node_replace {
my ($self, $revision, $path, $kind, $data) = @_;
$self->on_node_delete($revision, $path);
goto &on_node_add;
}
sub on_node_delete {
my ($self, $revision, $path) = @_;
$self->arborist()->delete_node($path, $revision);
# TODO - Push the deletion onto the branch?
undef;
}
sub on_node_copy {
my ($self, $revision, $path, $kind, $from_rev, $from_path, $data) = @_;
# TODO - Complex. See walk-svn.pl for starters.
$self->arborist()->copy_node(
$from_rev, $from_path, $revision, $path, $kind, $data
);
undef;
}
### Helper methods. TODO - Might belong in subclasses.
# Depot info is based on nonambiguous full path and revision.
sub get_copy_depot_info {
my ($self, $change) = @_;
return $self->calculate_depot_info($change->src_path(), $change->src_rev());
}
# Depot info is based on nonambiguous full path and revision.
sub calculate_depot_info {
my ($self, $path, $revision) = @_;
my $copy_depot_descriptor = "$path $revision";
my $full_depot_path = (
$self->copy_source_depot() . "/" .
md5_hex($copy_depot_descriptor)
);
$full_depot_path =~ s!//+!/!g;
return($copy_depot_descriptor, $full_depot_path);
}
### Action stuff.
sub do_or_die {
my $self = shift;
$log->trace("RUN) @_");
system @_ and confess "system(@_) = ", ($? >> 8);
return;
}
sub pipe_into_or_die {
my ($self, $data, $cmd) = @_;
$log->trace("PIN) $cmd");
open my $fh, "|-", $cmd or confess $!;
print $fh $data or confess $!;
close $fh or confess $!;
return;
}
sub pipe_out_of_or_die {
my ($self, $cmd) = @_;
$log->trace("POU) $cmd");
open my $fh, "-|", $cmd or confess $!;
local $/;
my $data = <$fh>;
close $fh or confiess $!;
return $data;
}
# Returns true if success.
sub do_sans_die {
my $self = shift;
$log->trace("RUN) @_");
return !(system @_);
}
sub do_mkdir {
my ($self, $directory) = @_;
$log->trace("RUN) mkdir $directory");
mkdir $directory or confess "mkdir $directory failed: $!";
return;
}
sub do_rmdir {
my ($self, $directory) = @_;
$log->trace("RUN) rmtree $directory");
rmtree $directory or confess "rmtree $directory failed: $!";
return;
}
sub push_dir {
my ($self, $new_dir) = @_;
push @{$self->directory_stack()}, cwd();
$log->trace("pushdir $new_dir");
chdir($new_dir) or confess "chdir $new_dir failed: $!";
return;
}
sub pop_dir {
my $self = shift;
my $old_dir = pop @{$self->directory_stack()};
$log->trace("popdir $old_dir");
chdir($old_dir) or confess "popdir failed: $!";
return;
}
sub copy_file_or_die {
my ($self, $src, $dst) = @_;
$log->trace("copy $src $dst");
copy($src, $dst) or confess "cp $src $dst failed: $!";
}
sub rewrite_file {
my ($self, $change, $full_path) = @_;
confess "edit $full_path failed: file doesn't exist" unless -e $full_path;
confess "edit $full_path failed: path is not a file" unless -f $full_path;
# File may not actually be changing. The subversion change may only
# be to properties, which we don't care about here. Only bother
# checking if the file sizes are equal; saves a lot of I/O that way.
if ((-s $full_path) == do { use bytes; length($change->content()) }) {
open my $fh, "<", $full_path or confess $!;
local $/;
my $current_text = <$fh>;
if ($current_text eq $change->content()) {
$log->trace("skipping rewrite - file didn't change");
return;
}
}
$log->trace("changing file $full_path");
$self->write_change_data($change, $full_path);
return 1;
}
sub write_new_file {
my ($self, $change, $full_path) = @_;
confess "create $full_path failed: file already exists" if -e $full_path;
$log->trace("creating file $full_path");
$self->write_change_data($change, $full_path);
}
sub write_change_data {
my ($self, $change, $full_path) = @_;
open my $fh, ">", $full_path or confess "create $full_path failed: $!";
if (defined $change->content()) {
print $fh $change->content() or confess $!;
}
close $fh or confess $!;
}
sub do_file_deletion {
my ($self, $full_path) = @_;
confess "delete $full_path failed: file doesn't exist" unless -e $full_path;
confess "delete $full_path failed: path not to a file" unless -f $full_path;
$log->trace("RUN) rm $full_path");
unlink $full_path or confess "unlink $full_path failed: $!";
}
sub do_rmdir_safely {
my ($self, $full_path) = @_;
confess "rmtree $full_path failed: directory doesn't exist" unless (
-e $full_path
);
confess "rmtree $full_path failed: path not to a directory" unless (
-d $full_path
);
$self->do_rmdir($full_path);
}
sub do_rename {
my ($self, $change) = @_;
my $full_src_path = $self->calculate_path($change->src_path());
my $full_dst_path = $self->calculate_path($change->path());
rename $full_src_path, $full_dst_path or confess(
"rename $full_src_path $full_dst_path failed: $!"
);
}
sub decrement_copy_source {
my ($self, $change, $revision, $copy_depot_path) = @_;
return;
my $copy_source = $self->arborist()->get_copy_source_for_path(
$change->src_rev(),
$change->src_path(),
);
confess "what's going on" unless defined $copy_source;
$self->do_file_deletion($copy_depot_path) unless (
$copy_source->delete_ref($revision->id(), $change->path())
);
}
### Virtual methods to override.
sub on_branch_directory_copy { confess "must override method"; }
sub on_branch_directory_creation { confess "must override method"; }
sub on_branch_directory_deletion { confess "must override method"; }
sub on_branch_rename { confess "must override method"; }
sub on_directory_copy { confess "must override method"; }
sub on_directory_creation { confess "must override method"; }
sub on_directory_deletion { confess "must override method"; }
sub on_directory_rename { confess "must override method"; }
sub on_file_change { confess "must override method"; }
sub on_file_copy { confess "must override method"; }
sub on_file_creation { confess "must override method"; }
sub on_file_deletion { confess "must override method"; }
sub on_file_rename { confess "must override method"; }
sub on_tag_directory_copy { confess "must override method"; }
sub on_tag_directory_deletion { confess "must override method"; }
sub on_tag_rename { confess "must override method"; }
sub on_rename { confess "must override method"; }
1;
Jump to Line
Something went wrong with that request. Please try again.