view release on metacpan or  search on metacpan

lib/Algorithm/Diff/Apply.pm  view on Meta::CPAN

		ref($tag) and croak("Tagnames must be scalar");
		my $diff = shift;
		ref($diff) eq 'ARRAY'
			or croak("Diff sequences must be references of "
				 . "type \"ARRAY\"");
		$diffset{$tag} = __homogenise_diff($diff, %opt);
	}

	# Trivial case
	if (scalar keys %diffset < 1)
	{
		return wantarray ? @ary : \@ary;
	}

	my @alts = __optimise_conflicts(diffset => \%diffset,
	                                opts => \%opt);
	__apply_alternatives(target => \@ary,
	                     alts => \@alts,
			     opts => \%opt);
	return wantarray ? @ary : \@ary;
}


# Converts all the hunks in an Algorithm::Diff-style diff to a
# normalised form in which all hunks are a) still internally
# contiguous, and b) have start indices which refer to items in the
# original array, before any diffs are applied. Normally, hunks
# consisting of only inserts don't meet criterion b).
#
# Allso attaches hash data if the hashing function is defined.

sub __homogenise_diff
{
	my ($orig_diff, %opt) = @_;
	my @hdiff = ();
	my $delta = 0;   # difference between orig and resultant
	foreach my $orig_hunk (@$orig_diff)
	{
		my ($first_op, $start) = @{$orig_hunk->[0]} [0, 1];
		$start -= $delta  if $first_op eq '+';
		my $hhunk = {
			start => $start,
			changes => [],
		};
		foreach my $change (@$orig_hunk)
		{
			my ($op, $data);
			($op, undef, $data) = @$change;
			$delta += (($op eq '+') ? 1 : -1);
			my $hash = (exists($opt{key_generator})
				    ? $opt{key_generator}->($data)
				    : undef);
			push @{$hhunk->{changes}}, [$op, $data, $hash];
		}
		push @hdiff, $hhunk;
	}
	return \@hdiff;
}


# Calls the specified optimisation callbacks, returning a list of discrete
# alternative blocks in a format that __apply_alternatives() can handle.

sub __optimise_conflicts
{
	my %args = @_;
	my %diffset = %{$args{diffset} || confess "\"diffset\" not specified"};
	my %opt = %{$args{opts} || confess "\"opts\" not specified"};

	my @optim;
	if ($opt{optimisers} or $opt{optimizers})
	{
		push @optim, @{$opt{optimisers} || []};
		push @optim, @{$opt{optimizers} || []};
	}
	else
	{
		@optim = &DEFAULT_OPTIMISERS;
	}
	my @alts;
	while (my ($u_min, $u_max, %u_alt)
	       = __shift_next_alternatives(\%diffset))
	{
		# Non-conflict case:
		if (scalar(keys(%u_alt)) <= 1)
		{
			push(@alts, [$u_min, $u_max, %u_alt]);
			next;
		}

		# Conflict case: pass each optimiser over it once.
		foreach my $o (@optim)
		{
			%u_alt = $o->("conflict_block" => \%u_alt);
			%u_alt = __diffset_discard_empties(%u_alt);
		}
		#__dump_diffset(%u_alt);
		
		# An optimiser could turn one block of conflicts into
		# two or more, so re-detect any remaining conflicts
		# within the block.

		while (my ($o_min, $o_max, %o_alt)
		       = __shift_next_alternatives(\%u_alt))
		{
			push(@alts, [$o_min, $o_max, %o_alt]);
		}
	}
	return @alts;
}


# Extracts the array ($min, $max, %alts) from %$diffset where $min and
# $max describe the range of lines affected by all the diff hunks in
# %alts, and %alts is a diffset containing at least one alternative.
# Returns an empty array if there are no diff hunks left.

sub __shift_next_alternatives
{
	my $diffset = shift;
	my $id = __next_hunk_id($diffset);