Algorithm-Diff-Apply

 view release on metacpan or  search on metacpan

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

	                                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);

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

	my $id = __next_hunk_id($diffset);
	defined($id) or return ();
	my ($cflict_max, $cflict_min);
	my %cflict;
	my $hunk = shift @{$diffset->{$id}};
	$cflict{$id} = [ $hunk ];

	# Seed range with $hunk:
	my @ch = @{$hunk->{changes}};
	my $span = grep { $_->[0] eq '-' } @ch;
	$cflict_min = $hunk->{start};
	$cflict_max = $cflict_min + $span;

	# Detect conflicting hunks, and add those in too.
	my %ignore;
	while (my $tmp_id = __next_hunk_id($diffset, %ignore))
	{
		my $tmp_hunk = $diffset->{$tmp_id}->[0];
		@ch = @{$tmp_hunk->{changes}};
		my $tmp_span = grep { $_->[0] eq '-' } @ch;
		my $tmp_max = $tmp_hunk->{start} + $tmp_span;
		if ($tmp_hunk->{start} <= $cflict_max)
		{
			exists $cflict{$tmp_id} or $cflict{$tmp_id} = [];
			shift @{$diffset->{$tmp_id}};
			push @{$cflict{$tmp_id}}, $tmp_hunk;
			$cflict_max = $tmp_max if $tmp_max > $cflict_max;
		}
		else
		{
			$ignore{$tmp_id} = 1;
		}
	}

	return ($cflict_min, $cflict_max, %cflict);
}


# Returns the ID of the hunk in %$diffset whose ->{start} is lowest,
# or undef. %ignore{SOMEID} can be set to a true value to cause a
# given sequence to be skipped over.

sub __next_hunk_id
{
	my ($diffset, %ignore) = @_;
	my ($lo_id, $lo_start);
	foreach my $id (keys %$diffset)
	{
		next if $ignore{$id};
		my $diff = $diffset->{$id};
		next if $#$diff < 0;
		my $start = $diff->[0]->{start};
		if ((! defined($lo_start))
		    || $start < $lo_start)
		{
			$lo_id = $id;
			$lo_start = $start;
		}
	}
	return $lo_id;
}


sub __diffset_discard_empties
{
	my %dset = @_;
	return map {

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

		}
		
		if (scalar keys %alt_txts == 1)
		{
			my ($r) = values %alt_txts;
			@replacement = @$r;
		}
		else
		{
			@replacement = $resolver->(src_range_end => $max,
						   src_range_start => $min,
						   src_range => \@orig,
						   alt_txts => \%alt_txts,
						   invoc_opts => \%opt);
		}		
		splice(@$ary, $min + $delta, $#orig+1, @replacement);
		$delta += ($#replacement - $#orig);
	}
}


# Applies a hunk to an array, and calculates the lines lost or gained
# by doing so.

sub __apply_hunk
{
        my ($ary, $rdelta, $hunk) = @_;
	my $pos = $hunk->{start} + $$rdelta;
        foreach my $change (@{$hunk->{changes}})
        {
                if ($change->[0] eq '+')
                {
                        splice(@$ary, $pos, 0, $change->[1]);
                        ++$$rdelta;
                        ++$pos;
                }
                else
                {

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

			push @{$ret{$tag}}, $hunk;
		}
	}
	return %ret;
}


sub __hunks_identical
{
	my ($h1, $h2) = @_;
	$h1->{start} == $h2->{start} or return 0;
	$#{$h1->{changes}} == $#{$h2->{changes}} or return 0;
	foreach my $i (0 .. $#{$h1->{changes}})
	{
		my ($op1, $data1, $hash1) = @{ $h1->{changes}->[$i] };
		my ($op2, $data2, $hash2) = @{ $h2->{changes}->[$i] };
		$op1 eq $op2 or return 0;
		if (defined($hash1) && defined($hash2))
		{
			$hash1 eq $hash2 or return 0;
		}

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

sub __dump_diffset
{
	my %dset = @_;
	print STDERR "-- begin diffset --\n";
	for my $tag (sort keys %dset)
	{
		print STDERR "-- begin seq tag=\"$tag\" --\n";
		my @diff = @{$dset{$tag}};
		for my $diff (@diff)
		{
			print STDERR "\n\@".$diff->{start}."\n";
			for my $e (@{$diff->{changes}})
			{
				my ($op, $data) = @$e;
				$data = quotemeta($data);
				$data =~ s{^(.{0,75})(.*)}{
					$1 . ($2 eq "" ? "" : "...");
				}se;
				print STDERR "$op $data\n";
			}
		}

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

    );

The tag names are whatever you labelled the diff sequences you passed
to C<apply_diffs()>. By definition, a conflict block contains a subset
of at least two separate diffs.

Each of the C<$hunk_X_X> scalars in the arguments above is a hash
reference with the following structure:

    {
        "start"   => N,
        "changes" => [[OP1, DATA1], ..., [OPn, DATAn]],
    }

Where "start" is a line number in the I<target> array, indicating
where this hunk is intended to be applied, and "changes" contains the
changes to apply.

Optimiser callbacks should return a I<permuted copy> of what they were
passed. Empty diffs will be discarded automatically. If only one diff
remains after processing, the conflict will have been optimised away
completely.

=head2 Conflict Resolver Callbacks

t/60regress1.t  view on Meta::CPAN

#!/usr/bin/perl -w
# Conflict regression test. Ensure that early conflicts that lose more
# lines after resolution than they spanned in the first place don't
# screw up the application of later hunks or (worse) start conflicting
# with them.

use Algorithm::Diff  qw{diff};
use Test::Simple tests => 1;
use Algorithm::Diff::Apply qw{apply_diffs};

$orig =             [qw{1 2 3 4 a b c d e f         }] ;
$dif1 = diff($orig, [qw{                  f z1 z2   }] );
$dif2 = diff($orig, [qw{                e f         }] );
$expc = join(':',  qw{d1>> d2>> e <<done f z1 z2 });