view release on metacpan or  search on metacpan

Merge.pm  view on Meta::CPAN

        }
    };

    traverse_sequences3(
        $pivot, $doca, $docb, 
        {
            NO_CHANGE => $no_change,
            A_DIFF  => $diff_a,
            B_DIFF  => $diff_b,
            C_DIFF   => $diff_c,
            CONFLICT  => $conflict,
        }, 
        $keyGen, @_
    );

    if(wantarray) {
        return @ret;
    }
    else {
        return \@ret;
    }
}

use constant A => 4;
use constant B => 2;
use constant C => 1;
use constant D => 8;  # should be an undef

use constant AB_A => 32;
use constant AB_B => 16;
use constant AC_A =>  8;
use constant AC_C =>  4;
use constant BC_B =>  2;
use constant BC_C =>  1;
use constant CB_C =>  3;  # not used in calculations
use constant CB_B =>  5;  # not used in calculations

my @abc_s;
$abc_s[(A|B)*8+A] = AB_A;
$abc_s[(A|B)*8+B] = AB_B;
$abc_s[(A|C)*8+A] = AC_A;
$abc_s[(A|C)*8+C] = AC_C;
$abc_s[(B|C)*8+B] = BC_B;
$abc_s[(B|C)*8+C] = BC_C;

sub traverse_sequences3 {
    my $adoc      = shift;                                  # array ref
    my $bdoc      = shift;                                  # array ref
    my $cdoc      = shift;                                  # array ref
    my $callbacks = shift || {};
    my $keyGen    = shift;
    my $a_diff     = $callbacks->{'A_DIFF'} || sub { };
    my $b_diff     = $callbacks->{'B_DIFF'} || sub { };
    my $c_diff     = $callbacks->{'C_DIFF'} || sub { };
    my $no_change = $callbacks->{'NO_CHANGE'} || sub { };
    my $conflict  = $callbacks->{'CONFLICT'} || sub { };

    my $b_len = scalar(@{$bdoc});
    my $c_len = scalar(@{$cdoc});
    my $target_len = $b_len < $c_len ? $b_len : $c_len;
    my $bc_different_lengths = $b_len != $c_len;

    my(@bdoc_save, @cdoc_save);

    # make these into traverse_sequences calls
    my($left, $right);
    my %diffs;

    my $ts_callbacks = {
        DISCARD_A => sub { # discard left
            push @{$diffs{$left}}, $_[0];
        },
        DISCARD_B => sub { # discard right
            push @{$diffs{$right}}, $_[1];
        },
    };

    @diffs{(AB_A, AB_B)} = ([], []);
    $left = AB_A; $right = AB_B;
    Algorithm::Diff::traverse_sequences( $adoc, $bdoc, $ts_callbacks, $keyGen, @_);

    @diffs{(AC_A, AC_C)} = ([], []);
    $left = AC_A; $right = AC_C;
    Algorithm::Diff::traverse_sequences( $adoc, $cdoc, $ts_callbacks, $keyGen, @_);

    if($bc_different_lengths) {
        
        @diffs{(CB_C, CB_B)} = ([], []);
        $left = CB_C; $right = CB_B;
        Algorithm::Diff::traverse_sequences( $cdoc, $bdoc, $ts_callbacks, $keyGen, @_);

        @diffs{(BC_B, BC_C)} = ([], []);  
        $left = BC_B; $right = BC_C; 
        Algorithm::Diff::traverse_sequences( $bdoc, $cdoc, $ts_callbacks, $keyGen, @_);

        if(join(",", @{$diffs{&CB_B}}) ne join(",", @{$diffs{&BC_B}}) ||
           join(",", @{$diffs{&CB_C}}) ne join(",", @{$diffs{&BC_C}}))
        {
            @bdoc_save = splice @{$bdoc}, $target_len;
            @cdoc_save = splice @{$cdoc}, $target_len;
            
            carp "Algorithm::Diff::diff is not symmetric for second and third sequences - results might not be correct";
        }

        @diffs{(BC_B, BC_C)} = ([], []);
        $left = BC_B; $right = BC_C;
        Algorithm::Diff::traverse_sequences( $bdoc, $cdoc, $ts_callbacks, $keyGen, @_);

        if(scalar(@bdoc_save) || scalar(@cdoc_save)) {
            push @{$diffs{&BC_B}}, ($target_len .. $b_len) if $target_len < $b_len;
            push @{$diffs{&BC_C}}, ($target_len .. $c_len) if $target_len < $c_len;
        
            push @{$bdoc}, @bdoc_save; undef @bdoc_save;
            push @{$cdoc}, @cdoc_save; undef @cdoc_save;
        }
    }
    else {
        @diffs{(BC_B, BC_C)} = ([], []);
        $left = BC_B; $right = BC_C;
        Algorithm::Diff::traverse_sequences( $bdoc, $cdoc, $ts_callbacks, $keyGen, @_);
    }

    my @pos;
    @pos[A, B, C] = (0, 0, 0);

    my @sizes;
    @sizes[A, B, C] = ( scalar(@{$adoc}), scalar(@{$bdoc}), scalar(@{$cdoc}) );

    my @matches;
    $#matches = 32;

    my $callback = 0;

    my $noop = sub { };

# Callback_Map is indexed by the sum of AB_A, AB_B, ..., as indicated by @matches
# this isn't the most efficient, but it's a bit easier to maintain and 
# read than if it were broken up into separate arrays
# half the entries are not $noop - it would seem then that no 
# entries should be $noop.  I need patterns to figure out what the 
# other entries are.

    my @Callback_Map = (
      [ $no_change,     A, B, C ], # 0  - no matches
      #[ $noop,                  ], # 1  -                          BC_C
      [ $b_diff,        A,    C ], # 1  -                          BC_C

Merge.pm  view on Meta::CPAN

first sequence is not in either of the other two sequences.

If two arguments, then there is no element in the first sequence that 
corresponds to the elements at the given positions in the second and 
third sequences.

If three arguments, then the element at the given position in the first 
sequence is different than the corresponding element in the other two 
sequences, but the other two sequences have corresponding elements.

=item B_DIFF

This is called if the second sequence is different than the other two 
sequences at the current position.
This callback will be called with one, two, or three arguments.   

If one argument, then only the element at the given position from the 
second sequence is not in either of the other two sequences.

If two arguments, then there is no element in the second sequence that 
corresponds to the elements at the given positions in the first and 
third sequences.

If three arguments, then the element at the given position in the second 
sequence is different than the corresponding element in the other two 
sequences, but the other two sequences have corresponding elements.

=item C_DIFF

This is called if the third sequence is different than the other two 
sequences at the current position.
This callback will be called with one, two, or three arguments.   

If one argument, then only the element at the given position from the 
third sequence is not in either of the other two sequences.

If two arguments, then there is no element in the third sequence that 
corresponds to the elements at the given positions in the first and 
second sequences.

If three arguments, then the element at the given position in the third 
sequence is different than the corresponding element in the other two 
sequences, but the other two sequences have corresponding elements.

=item CONFLICT

This is called if all three sequences have different elements at the 
current position.  The three arguments are the current positions within 
each sequence.

=back 4

=head1 BUGS

Most assuredly there are bugs.  If a pattern similar to the above 
example does not work, send it to <jsmith@cpan.org> or report it on 
<http://rt.cpan.org/>, the CPAN bug tracker.

L<Algorithm::Diff|Algorithm::Diff>'s implementation of 
C<traverse_sequences> may not be symmetric with respect to the input 
sequences if the second and third sequence are of different lengths.  
Because of this, C<traverse_sequences3> will calculate the diffs of 
the second and third sequences as passed and swapped.  If the differences 
are not the same, it will issue an `Algorithm::Diff::diff is not symmetric 
for second and third sequences...' warning.  It will try to handle 
this, but there may be some cases where it can't.

=head1 SEE ALSO

L<Algorithm::Diff>.

=head1 AUTHOR

James G. Smith, <jsmith@cpan.org>

=head1 COPYRIGHT

Copyright (C) 2003, 2007  Texas A&M University.  All Rights Reserved.

This module is free software; you may redistribute it and/or
modify it under the same terms as Perl itself.