view release on metacpan or  search on metacpan

Merge.pm  view on Meta::CPAN

package Algorithm::Merge;

use Algorithm::Diff ();
use Carp;
use strict;
use Data::Dumper;

use vars qw(@EXPORT_OK @ISA $VERSION $REVISION);

$VERSION = '0.08';

$REVISION = (qw$Revision: 1.11 $)[-1];

@EXPORT_OK = qw(diff3 merge traverse_sequences3);

@ISA = qw(Exporter);

sub diag {
    main::diag(@_) if($Algorithm::Merge::DEBUG);
}

sub diff3 {
    my $pivot             = shift;                                  # array ref
    my $doca              = shift;                                  # array ref
    my $docb              = shift;                                  # array ref
    my $keyGen            = shift;

    my @ret;

    if(@$doca == 0 && @$docb == 0 && @$pivot == 0) {
      return [ [ ] ];
    }

    my $no_change;

#    if($keyGen) {
#        $no_change = sub {
#            if($keyGen->($pivot -> [$_[0]]) ne $keyGen->($doca -> [$_[1]])
#               || $keyGen->($pivot -> [$_[0]]) ne $keyGen->($docb -> [$_[2]])
#               || $keyGen->($doca -> [$_[1]]) ne $keyGen->($docb -> [$_[2]]))
#            {
#               croak "No change detected, but elements differ between sequences.  Please submit a bug report to jsmith\@cpan.org with a description of the set of sequences which lead to this error.\n";
#            }
#            push @ret, [ 'u', $pivot -> [$_[0]], $doca -> [$_[1]], $docb -> [$_[2]] ];
#        };
#    }
#    else {
        $no_change = sub {
#            if($pivot -> [$_[0]] ne $doca -> [$_[1]]
#               || $pivot -> [$_[0]] ne $docb -> [$_[2]]
#               || $doca -> [$_[1]] ne $docb -> [$_[2]])
#            {
#               croak "No change detected, but elements differ between sequences.  Please submit a bug report to jsmith\@cpan.org with a description of the set of sequences which lead to this error.\n";
#            }
            push @ret, [ 'u', $pivot -> [$_[0]], $doca -> [$_[1]], $docb -> [$_[2]] ];
        };
#    }

    my $conflict = sub {
        my($a, $b, $c);
        $a = $pivot -> [$_[0]] if defined $_[0];
        $b = $doca -> [$_[1]] if defined $_[1];
        $c = $docb -> [$_[2]] if defined $_[2];
        push @ret, [ 'c', $a, $b, $c ];
    };

Merge.pm  view on Meta::CPAN

        diag(join "", "args: ", join(", ", map { (qw(- C B - A - - - D))[$_] } @args), "(", join(", ", map { defined($_) ? $_ : 'undef' } @pos[@args]), ")\n");
        diag('--------------------');
        &{$f}(@pos[@args]);
        foreach (@args) {
            $pos[$_]++ unless $_ == D;
            if($_ eq A) {
                shift @{$diffs{&AB_A}} while @{$diffs{&AB_A}} && $diffs{&AB_A}[0] < $pos[$_];# if $matches[AB_A];
                shift @{$diffs{&AC_A}} while @{$diffs{&AC_A}} && $diffs{&AC_A}[0] < $pos[$_];#if $matches[AC_A];
            } elsif($_ eq B) {
                shift @{$diffs{&AB_B}} while @{$diffs{&AB_B}} && $diffs{&AB_B}[0] < $pos[$_];#if $matches[AB_B];
                shift @{$diffs{&BC_B}} while @{$diffs{&BC_B}} && $diffs{&BC_B}[0] < $pos[$_];#if $matches[BC_B];
            } elsif($_ eq C) {
                shift @{$diffs{&AC_C}} while @{$diffs{&AC_C}} && $diffs{&AC_C}[0] < $pos[$_];#if $matches[AC_C];
                shift @{$diffs{&BC_C}} while @{$diffs{&BC_C}} && $diffs{&BC_C}[0] < $pos[$_];#if $matches[BC_C];
            }
        }
        last unless @args;
    }

    my $switch;
    my @args;

    while(grep { $pos[$_] < $sizes[$_] } (A, B, C)) {
        $switch = 0;
        @args = ();
        foreach my $i (A, B, C) {
            if($pos[$i] < $sizes[$i]) {
                #warn "$i: $pos[$i] < $sizes[$i]\n";
                $switch |= $i;
                #warn "switch: $switch\n";
                push @args, $pos[$i]++;
            }
        }

        my $match = $switch;
        $switch = ( 0, 5, 24, 17, 34, 8, 10, 0 )[$switch];
        #main::diag(join"", "callback: $switch - \@pos: ", join(", ", @pos[A, B, C]));
        #main::diag(join"", "  match: $match");
        &{$Callback_Map[$switch][0]}(@args)
            if $Callback_Map[$switch];
    }
}

sub merge {
    my $pivot             = shift;                                  # array ref
    my $doca              = shift;                                  # array ref
    my $docb              = shift;                                  # array ref
    my $callbacks         = shift || {};
    my $keyGen            = shift;

    my $conflictCallback  = $callbacks -> {'CONFLICT'} || sub ($$) { (
        q{<!-- ------ START CONFLICT ------ -->},
        (@{$_[0]}),
        q{<!-- ---------------------------- -->},
        (@{$_[1]}),
        q{<!-- ------  END  CONFLICT ------ -->},
    ) };

    my $diff = diff3($pivot, $doca, $docb, $keyGen, @_);

#    print Data::Dumper -> Dump([$diff]), "\n";

    my @ret;

    my @conflict = ( [], [] );

    foreach my $h (@{$diff}) {
        my $i = 0;
        #print "op: ", $h -> [0];
        if($h -> [0] eq 'c') { # conflict
            push @{$conflict[0]}, $h -> [2] if defined $h -> [2];
            push @{$conflict[1]}, $h -> [3] if defined $h -> [3];
        }
        else {
            if(@{$conflict[0]} || @{$conflict[1]}) {
                push @ret, &$conflictCallback(@conflict);
                @conflict = ( [], [] );
            }
            if($h -> [0] eq 'u') { # unchanged
                push @ret, $h -> [2] || $h -> [3];
            }
            elsif($h -> [0] eq 'o') { # added
                push @ret, $h -> [2] if defined $h -> [2];
            }
            elsif($h -> [0] eq 'l') { # added by left
                push @ret, $h -> [2] if defined $h -> [2];
            }
            elsif($h -> [0] eq 'r') { # added by right
                push @ret, $h -> [3] if defined $h -> [3];
            }
        }
        #print " : ", join(" ", @ret), " [$$h[1],$$h[2],$$h[3]]\n";
    }

    if(@{$conflict[0]} || @{$conflict[1]}) {
        push @ret, &$conflictCallback(@conflict);
    }

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


__END__
#
# For testing:
#
sub main::diag {
    warn join("", @_) , "\n";
}

print join(" ", merge(
#print Data::Dumper -> Dump([
#    merge(
#    #[qw(a b c d       h i j)], # ancestor
#    #[qw(a b c d   f   h i j)], # left
#    #[qw(a b c   e   g      )], # right
    [qw(0 1 2 3 4 7 9 b)],
    [qw(0 6       8 a b)],
    [qw(0 1 2 3 5 8 a b)],
##
    {
        CONFLICT => sub ($$) { (
            q{<}, @{$_[0]}, q{|}, @{$_[1]}, q{>}
        ) },
    },
)), "\n";
#)]), "\n";
#print join(" ", @{
#    [qw(0 1 @ < 3 | # > 6)]
#  }), "\n";

1;
__END__


1;

__END__

=head1 NAME

Algorithm::Merge - Three-way merge and diff

=head1 SYNOPSIS

 use Algorithm::Merge qw(merge diff3 traverse_sequences3);

 @merged = merge(\@ancestor, \@a, \@b, { 
               CONFLICT => sub { } 
           });

 @merged = merge(\@ancestor, \@a, \@b, { 
               CONFLICT => sub { } 
           }, $key_generation_function);

 $merged = merge(\@ancestor, \@a, \@b, { 
               CONFLICT => sub { } 
           });

 $merged = merge(\@ancestor, \@a, \@b, { 
               CONFLICT => sub { } 
           }, $key_generation_function);

 @diff   = diff3(\@ancestor, \@a, \@b);

 @diff   = diff3(\@ancestor, \@a, \@b, $key_generation_function);

 $diff   = diff3(\@ancestor, \@a, \@b);

 $diff   = diff3(\@ancestor, \@a, \@b, $key_generation_function);

 @trav   = traverse_sequences3(\@ancestor, \@a, \@b, {