view release on metacpan or  search on metacpan

lib/SVN/Analysis.pm  view on Meta::CPAN

			SET
				ent_type = ?, ent_name = ?,
				path_lop = ?, path_prepend = ?, rel_path = ?
			WHERE seq = ?
		") or die $self->dbh()->errstr();

		$sth_update->execute(
			$ent_type, $ent_name, $path_lop, $path_prepend, $rel_path, $seq
		) or die $sth_update->errstr();
	}

	# Propagate entity root type,name tuples throughout their
	# subdirectories.

	my $sth_find_ent_roots = $self->dbh()->prepare_cached('
		SELECT path, ent_type, ent_name
		FROM dir
		WHERE path_lop != "" AND rel_path == ""
		ORDER BY
			length(path_lop) ASC, path_lop ASC, length(rel_path) ASC, rel_path ASC
	') or die $self->dbh()->errstr();

	$sth_find_ent_roots->execute() or die $sth_find_ent_roots->errstr();
	$sth_find_ent_roots->bind_columns(
		\my ($ent_path, $ent_type, $ent_name)
	) or die(
		$sth_find_ent_roots->errstr()
	);

	while ($sth_find_ent_roots->fetch()) {
		# First, ensure the entity doesn't contain sub-entities.
		# Nested entities aren't currently supported.
		#
		# TODO - However they ought to be if sub-entities are branches,
		# trunk and tags of a project.

		my $sth_find_sub_roots = $self->dbh()->prepare_cached('
			SELECT path
			FROM dir
			WHERE path LIKE ? AND path_lop != "" AND rel_path == ""
			ORDER BY length(path) ASC, path ASC
		') or die $self->dbh()->errstr();

		my $like_path = "$ent_path/%";
		$sth_find_sub_roots->execute($like_path) or die(
			$sth_find_sub_roots->errstr()
		);
		$sth_find_sub_roots->bind_columns(\my $broken_path) or die(
			$sth_find_sub_roots->errstr()
		);

		my $failures = 0;
		while ($sth_find_sub_roots->fetch()) {
			$failures++;
			warn "failure: entity at $ent_path contains sub-entity at $broken_path";
		}
		die "sub-entities indicate bad entity recognition" if $failures;

		# Second, ensure that the lop and prepend paths are consistent
		# throughout the tree.
		# TODO - Although this may be true as a corollary of rel_path
		# being nonzero length throughout the entity tree, so we're
		# skipping the check until we're sure it's necessary.

		# TODO - Code?

		# Okay, it's good.
		# Let's propagate its entity type and name throughout its tree.

		my $sth_update_entity = $self->dbh()->prepare_cached("
			UPDATE dir
			SET ent_type = ?, ent_name = ?
			WHERE path LIKE ?
		") or die $self->dbh()->errstr();

		$sth_update_entity->execute($ent_type, $ent_name, $like_path) or die(
			$sth_update_entity->errstr()
		);
	}
}

# Fix copy targets so their entity types match copy sources.
# Copies describe a set of directed graphs.  Each modified target
# directory may trigger a new fixup if it also describes a copy
# source.

sub fix_copy_targets {
	my $self = shift;

	my $sth_update_entity = $self->dbh()->prepare_cached("
		UPDATE dir
		SET ent_type = ?
		WHERE (path = ? OR path LIKE ?) AND rev_first <= ? AND rev_last > ?
	") or die $self->dbh()->errstr();

	my $sth_find_copies = $self->dbh()->prepare_cached("
		SELECT *
		FROM copy
		WHERE src_path = ? OR src_path LIKE ? OR dst_path = ? OR dst_path LIKE ?
	") or die $self->dbh()->errstr();

	my @pending_copies = $self->get_all_copies();
	while (@pending_copies) {
		my $next_copy = pop @pending_copies;

		# Get the source and destination dir info.
		my $src_info = $self->get_dir_info(
			$next_copy->src_path(),
			$next_copy->src_rev(),
		);

		# No point if source isn't an entity.
		next unless defined $src_info and $src_info->is_entity();

		my $dst_info = $self->get_dir_info(
			$next_copy->dst_path(),
			$next_copy->dst_rev(),
		);

		# Failure if destination isn't an entity.
		die(