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 ];
    };

    my $diff_a = sub {
        if(@_ == 1) {
            push @ret, [ 'o', $pivot -> [$_[0]], undef, undef ];
        }
        elsif(@_ == 2) {
            push @ret, [ 'o', undef, $doca -> [$_[0]], $docb -> [$_[1]] ];
        }
        elsif(@_ == 3) {
            push @ret, [ 'o', $pivot -> [$_[0]], $doca -> [$_[1]], $docb -> [$_[2]] ];
        }
    };

    my $diff_b = sub {
        if(@_ == 1) {
            push @ret, [ 'l', undef, $doca -> [$_[0]], undef ];
        }
        elsif(@_ == 2) {
            push @ret, [ 'l', $pivot -> [$_[0]], undef, $docb -> [$_[1]] ];
        }
        elsif(@_ == 3) {
            push @ret, [ 'l', $pivot -> [$_[0]], $doca -> [$_[1]], $docb -> [$_[2]] ];
        }
    };

    my $diff_c = sub {
        if(@_ == 1) {
            push @ret, [ 'r', undef, undef, (defined($_[0]) ? $docb -> [$_[0]] : undef) ];
        }
        elsif(@_ == 2) {
            push @ret, [ 'r', (defined($_[0]) ? $pivot -> [$_[0]] : undef), (defined($_[1]) ? $doca -> [$_[1]] : undef), undef ];
        }
        elsif(@_ == 3) {
            push @ret, [ 'r', (defined($_[0]) ? $pivot -> [$_[0]] : undef), (defined($_[1]) ? $doca -> [$_[1]] : undef), (defined($_[0]) ? $docb -> [$_[2]] : undef)];
        }
    };

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