Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

initial import

  • Loading branch information...
commit bd168796ee269c2c1d8e1de85102d2935c01e4fa 0 parents
@Takadonet authored
Showing with 2,404 additions and 0 deletions.
  1. +6 −0 MANIFEST
  2. +92 −0 README
  3. +1,696 −0 lib/Algorithm/Diff.pm
  4. +388 −0 t/base.t
  5. +222 −0 t/oo.t
6 MANIFEST
@@ -0,0 +1,6 @@
+Changes
+lib/Algorithm/Diff.pm Algorithm::Diff perl module
+MANIFEST
+README
+t/base.t Basic test script
+t/oo.t OO interface test script
92 README
@@ -0,0 +1,92 @@
+Building Algorithm::Diff
+
+$ ufo && make
+
+
+
+The module is a direct port from the Perl 5 version and should be close to 100% similair
+other then some Perl 6 idioms.
+
+Listed below is the original README:
+
+This is a module for computing the difference between two files, two
+strings, or any other two lists of things. It uses an intelligent
+algorithm similar to (or identical to) the one used by the Unix "diff"
+program. It is guaranteed to find the *smallest possible* set of
+differences.
+
+This package contains a few parts.
+
+Algorithm::Diff is the module that contains several interfaces for which
+computing the differences betwen two lists.
+
+The several "diff" programs also included in this package use
+Algorithm::Diff to find the differences and then they format the output.
+
+Algorithm::Diff also includes some other useful functions such as "LCS",
+which computes the longest common subsequence of two lists.
+
+A::D is suitable for many uses. You can use it for finding the smallest
+set of differences between two strings, or for computing the most
+efficient way to update the screen if you were replacing "curses".
+
+Algorithm::DiffOld is a previous version of the module which is included
+primarilly for those wanting to use a custom comparison function rather
+than a key generating function (and who don't mind the significant
+performance penalty of perhaps 20-fold).
+
+diff.pl implements a "diff" in Perl that is as simple as (was
+previously) possible so that you can see how it works. The output
+format is not compatible with regular "diff". It needs to be
+reimplemented using the OO interface to greatly simplify the code.
+
+diffnew.pl implements a "diff" in Perl with full bells and whistles. By
+Mark-Jason, with code from cdiff.pl included.
+
+cdiff.pl implements "diff" that generates real context diffs in either
+traditional format or GNU unified format. Original contextless
+"context" diff supplied by Christian Murphy. Modifications to make it
+into a real full-featured diff with -c and -u options supplied by Amir
+D. Karger.
+
+Yes, you can use this program to generate patches.
+
+OTHER RESOURCES
+
+"Longest Common Subsequences", at
+http://www.ics.uci.edu/~eppstein/161/960229.html
+
+This code was adapted from the Smalltalk code of Mario Wolczko
+<mario@wolczko.com>, which is available at
+ftp://st.cs.uiuc.edu/pub/Smalltalk/MANCHESTER/manchester/4.0/diff.st
+
+THANKS SECTION
+
+Thanks to Ned Konz's for rewriting the module to greatly improve
+performance, for maintaining it over the years, and for readilly handing
+it over to me so I could plod along with my improvements.
+
+(From Ned Konz's earlier versions):
+
+Thanks to Mark-Jason Dominus for doing the original Perl version and
+maintaining it over the last couple of years. Mark-Jason has been a huge
+contributor to the Perl community and CPAN; it's because of people like
+him that Perl has become a success.
+
+Thanks to Mario Wolczko <mario@wolczko.com> for writing and making
+publicly available his Smalltalk version of diff, which this Perl
+version is heavily based on.
+
+Thanks to Mike Schilli <m@perlmeister.com> for writing sdiff and
+traverse_balanced and making them available for the Algorithm::Diff
+distribution.
+
+(From Mark-Jason Dominus' earlier versions):
+
+Huge thanks to Amir Karger for adding full context diff supprt to
+"cdiff.pl", and then for waiting patiently for five months while I let
+it sit in a closet and didn't release it. Thank you thank you thank
+you, Amir!
+
+Thanks to Christian Murphy for adding the first context diff format
+support to "cdiff.pl".
1,696 lib/Algorithm/Diff.pm
@@ -0,0 +1,1696 @@
+module Algorithm::Diff {
+
+
+# use integer; # see below in _replaceNextLargerWith() for mod to make
+# # if you don't use this
+
+# @EXPORT_OK = qw(
+# prepare LCS LCSidx LCS_length
+# diff sdiff compact_diff
+# traverse_sequences traverse_balanced
+# );
+
+# # McIlroy-Hunt diff algorithm
+# # Adapted from the Smalltalk code of Mario I. Wolczko, <mario@wolczko.com>
+# # by Ned Konz, perl@bike-nomad.com
+# # Updates by Tye McQueen, http://perlmonks.org/?node=tye
+
+# # Create a hash that maps each element of $aCollection to the set of
+# # positions it occupies in $aCollection, restricted to the elements
+# # within the range of indexes specified by $start and $end.
+# # The fourth parameter is a subroutine reference that will be called to
+# # generate a string to use as a key.
+# # Additional parameters, if any, will be passed to this subroutine.
+# #
+# # my $hashRef = _withPositionsOfInInterval( \@array, $start, $end, $keyGen );
+
+sub _withPositionsOfInInterval(@aCollection,$start,$end,$keyGen,*@rest) is export
+{
+ #todo make type constraint for $keyGen to Code $keygen
+ my %d;
+ my $index;
+ loop ( $index = $start ; $index <= $end ; $index++ )
+ {
+ my $element = @aCollection[$index];
+ my $key = $keyGen.($element);
+ if ( %d.exists($key) )
+ {
+ #unshift ( @{ $d{$key} }, $index );
+ %d{$key}.unshift( $index );
+ }
+ else
+ {
+ %d{$key}[0]=$index;
+ }
+ }
+ return %d;
+}
+
+# # Find the place at which aValue would normally be inserted into the
+# # array. If that place is already occupied by aValue, do nothing, and
+# # return undef. If the place does not exist (i.e., it is off the end of
+# # the array), add it to the end, otherwise replace the element at that
+# # point with aValue. It is assumed that the array's values are numeric.
+# # This is where the bulk (75%) of the time is spent in this module, so
+# # try to make it fast!
+sub _replaceNextLargerWith(@array is rw , $aValue,$high is copy)
+{
+ $high ||= @array.elems()-1;
+
+ # off the end?
+ if $high == -1 || $aValue > @array[*-1]
+ {
+ @array.push($aValue);
+ return $high + 1;
+ }
+
+ # binary search for insertion point...
+ my $low = 0;
+ my $index;
+ my $found;
+ while $low <= $high
+ {
+ $index = ( $high + $low ) / 2;
+
+ # $index = int(( $high + $low ) / 2); # without 'use integer'
+ $found = @array[$index];
+
+ if ( $aValue == $found )
+ {
+ return Mu;
+ }
+ elsif ( $aValue > $found )
+ {
+ $low = $index + 1;
+ }
+ else
+ {
+ $high = $index - 1;
+ }
+ }
+
+ # now insertion point is in $low.
+ @array[$low] = $aValue; # overwrite next larger
+ return $low;
+}
+
+# # This method computes the longest common subsequence in $a and $b.
+
+# # Result is array or ref, whose contents is such that
+# # $a->[ $i ] == $b->[ $result[ $i ] ]
+# # foreach $i in ( 0 .. $#result ) if $result[ $i ] is defined.
+
+# # An additional argument may be passed; this is a hash or key generating
+# # function that should return a string that uniquely identifies the given
+# # element. It should be the case that if the key is the same, the elements
+# # will compare the same. If this parameter is undef or missing, the key
+# # will be the element as a string.
+
+# # By default, comparisons will use "eq" and elements will be turned into keys
+# # using the default stringizing operator '""'.
+
+# # Additional parameters, if any, will be passed to the key generation
+# # routine.
+
+sub _longestCommonSubsequence(@a,@b,$counting?,$keyGen? is rw,*@leftover) is export
+{
+# my $a = shift; # array ref or hash ref
+# my $b = shift; # array ref or hash ref
+# my $counting = shift; # scalar
+# my $keyGen = shift; # code ref
+ my $compare; # code ref
+ my $keygen = $keyGen;
+#no idea why we have this...
+#probably a different way to call it
+# if ( ref($a) eq 'HASH' )
+# { # prepared hash must be in $b
+# my $tmp = $b;
+# $b = $a;
+# $a = $tmp;
+# }
+
+# # set up code refs
+# # Note that these are optimized.
+# if ( !defined($keyGen) ) # optimize for strings
+# {
+ $keygen = sub { return shift @_ };
+# $compare = sub { my ( $a, $b ) = @_; $a eq $b };
+# }
+# else
+# {
+ $compare = sub {
+ my $a = shift @_;
+ my $b = shift @_;
+ #hardcoded for now that it will be the default
+ $a eq $b;
+# &$keyGen( $a, @_ ) eq &$keyGen( $b, @_ );
+ };
+# }
+
+ my ( $aStart, $aFinish ) = ( 0, @a.elems()-1);
+ my @matchVector;
+ my ( $prunedCount, %bMatches ) = ( 0, {});
+# if ( ref($b) eq 'HASH' ) # was $bMatches prepared for us?
+# {
+# $bMatches = $b;
+# }
+# else
+# {
+ my $bStart = 0;
+ my $bFinish = @b.elems()-1;
+ # First we prune off any common elements at the beginning
+ while $aStart <= $aFinish
+ and $bStart <= $bFinish
+ and $compare.( @a[$aStart], @b[$bStart])
+ {
+ @matchVector[ $aStart++ ] = $bStart++;
+ $prunedCount++;
+ }
+
+ # now the end
+ while $aStart <= $aFinish
+ and $bStart <= $bFinish
+ and $compare.( @a[$aFinish], @b[$bFinish] )
+ {
+ @matchVector[ $aFinish-- ] = $bFinish--;
+ $prunedCount++;
+ }
+
+ # Now compute the equivalence classes of positions of elements
+ %bMatches = _withPositionsOfInInterval( @b, $bStart, $bFinish, $keygen);
+
+# }
+ my @thresh;
+ my @links;
+
+ my ( $i, $ai, $j, $k );
+ loop ( $i = $aStart ; $i <= $aFinish ; $i++ )
+ {
+ $ai = $keygen.( @a[$i] );
+ if ( %bMatches.exists($ai) )
+ {
+ $k = 0;
+ for @( %bMatches{$ai} ) -> $j
+ {
+
+ # optimization: most of the time this will be true
+ if ( $k and @thresh[$k] > $j and @thresh[ $k - 1 ] < $j )
+ {
+ @thresh[$k] = $j;
+ }
+ else
+ {
+ $k = _replaceNextLargerWith( @thresh, $j, $k );
+ }
+
+ # oddly, it's faster to always test this (CPU cache?).
+ if ( $k.defined )
+ {
+ if $k {
+ @links[$k] = [ @links[ $k - 1 ] , $i, $j ];
+
+ }
+ else {
+ @links[$k] = [ Mu , $i, $j ];
+ }
+ }
+ }
+ }
+ }
+ if (@thresh)
+ {
+ return $prunedCount + @thresh.elems()-1 if $counting;
+ #for ( my $link = $links[$#$thresh] ; $link ; $link = $link->[0] )
+ loop ( my $link = @links[@thresh.elems()-1] ; $link ; $link = $link[0] )
+ {
+ @matchVector[ $link[1] ] = $link[2];
+ }
+ }
+ elsif ($counting)
+ {
+ return $prunedCount;
+ }
+ return @matchVector;
+}
+
+sub traverse_sequences(@a,@b ,$keyGen?,:MATCH($match), :DISCARD_A($discard_a), :DISCARD_B($discard_b), :A_FINISHED($finished_a) is copy,:B_FINISHED($finished_b) is copy ) is export
+{
+# my $a = shift; # array ref
+# my $b = shift; # array ref
+# my $callbacks = shift || {};
+# my $keyGen = shift;
+# my $matchCallback = $callbacks->{'MATCH'} || sub { };
+# my $discardACallback = $callbacks->{'DISCARD_A'} || sub { };
+# my $finishedACallback = $callbacks->{'A_FINISHED'};
+# my $discardBCallback = $callbacks->{'DISCARD_B'} || sub { };
+# my $finishedBCallback = $callbacks->{'B_FINISHED'};
+ my @matchVector = _longestCommonSubsequence( @a, @b, 0, $keyGen );
+
+ # Process all the lines in @matchVector
+ my $lastA = @a.elems()-1;
+ my $lastB = @b.elems()-1;
+ my $bi = 0;
+ my $ai;
+
+ loop ( $ai = 0 ; $ai <= @matchVector.elems()-1 ; $ai++ )
+ {
+ my $bLine = @matchVector[$ai];
+ if $bLine.defined # matched
+ {
+ $discard_b.( $ai, $bi++, ) while $bi < $bLine;
+ $match.( $ai, $bi++, );
+ }
+ else
+ {
+ $discard_a.( $ai, $bi);
+ }
+ }
+
+ # The last entry (if any) processed was a match.
+ # $ai and $bi point just past the last matching lines in their sequences.
+
+ while $ai <= $lastA or $bi <= $lastB
+ {
+
+ # last A?
+ if $ai == $lastA + 1 and $bi <= $lastB
+ {
+ if ( $finished_a.defined )
+ {
+ $finished_a.( $lastA);
+ $finished_a = Mu;
+ }
+ else
+ {
+ $discard_b.( $ai, $bi++ ) while $bi <= $lastB;
+ }
+ }
+
+ # last B?
+ if ( $bi == $lastB + 1 and $ai <= $lastA )
+ {
+ if ( $finished_b.defined )
+ {
+ $finished_b.( $lastB);
+ $finished_b = Mu;
+ }
+ else
+ {
+ $discard_a.( $ai++, $bi ) while $ai <= $lastA;
+ }
+ }
+
+ $discard_a.( $ai++, $bi ) if $ai <= $lastA;
+ $discard_b.( $ai, $bi++ ) if $bi <= $lastB;
+ }
+
+ return 1;
+}
+
+#sub traverse_sequences(@a,@b ,$keyGen?,:MATCH($match), :DISCARD_A($discard_a), :DISCARD_B($discard_b), :A_FINISHED($finished_a) is copy,:B_FINISHED($finished_b) is copy ) is export
+sub traverse_balanced(@a,@b,$keyGen?,:MATCH($match), :DISCARD_A($discard_a), :DISCARD_B($discard_b),:CHANGE($change) ) is export
+{
+# my $matchCallback = $callbacks->{'MATCH'} || sub { };
+# my $discardACallback = $callbacks->{'DISCARD_A'} || sub { };
+# my $discardBCallback = $callbacks->{'DISCARD_B'} || sub { };
+# my $changeCallback = $callbacks->{'CHANGE'};
+ my @matchVector = _longestCommonSubsequence( @a, @b, 0, $keyGen );
+
+ # Process all the lines in match vector
+ my $lastA = @a.elems()-1;
+ my $lastB = @b.elems()-1;
+ my $bi = 0;
+ my $ai = 0;
+ my $ma = -1;
+ my $mb;
+
+ while (1)
+ {
+
+ # Find next match indices $ma and $mb
+ repeat {
+ $ma++;
+ } while
+ $ma <= @matchVector.elems()-1
+ && !(@matchVector[$ma].defined);
+
+ last if $ma > @matchVector.elems()-1; # end of matchVector?
+ $mb = @matchVector[$ma];
+
+ # Proceed with discard a/b or change events until
+ # next match
+ while $ai < $ma || $bi < $mb
+ {
+
+ if $ai < $ma && $bi < $mb
+ {
+
+ # Change
+ if ( $change.defined )
+ {
+ $change.( $ai++, $bi++);
+ }
+ else
+ {
+ $discard_a( $ai++, $bi);
+ $discard_b( $ai, $bi++);
+ }
+ }
+ elsif $ai < $ma
+ {
+ $discard_a.( $ai++, $bi);
+ }
+ else
+ {
+ # $bi < $mb
+ $discard_b( $ai, $bi++);
+ }
+ }
+
+ # Match
+ $match.( $ai++, $bi++ );
+ }
+
+ while $ai <= $lastA || $bi <= $lastB
+ {
+ if $ai <= $lastA && $bi <= $lastB
+ {
+
+ # Change
+ if $change.defined
+ {
+ $change.( $ai++, $bi++);
+ }
+ else
+ {
+ $discard_a.( $ai++, $bi);
+ $discard_b.( $ai, $bi++);
+ }
+ }
+ elsif $ai <= $lastA
+ {
+ $discard_a( $ai++, $bi);
+ }
+ else
+ {
+ # $bi <= $lastB
+ $discard_b( $ai, $bi++);
+ }
+ }
+
+ return 1;
+}
+
+# sub prepare
+# {
+# my $a = shift; # array ref
+# my $keyGen = shift; # code ref
+
+# # set up code ref
+# $keyGen = sub { $_[0] } unless defined($keyGen);
+
+# return scalar _withPositionsOfInInterval( $a, 0, $#$a, $keyGen, @_ );
+# }
+
+sub LCS(@a,@b) is export
+{
+# my $a = shift; # array ref
+# my $b = shift; # array ref or hash ref
+ my @matchVector = _longestCommonSubsequence( @a, @b, 0);
+ my @retval;
+ my $i;
+ loop ( $i = 0 ; $i <= @matchVector.elems()-1 ; $i++ )
+ {
+ if @matchVector[$i].defined
+ {
+ @retval.push(@a[$i]);
+ }
+ }
+# return wantarray ? @retval : \@retval;
+ return @retval;
+}
+
+# sub LCS_length
+# {
+# my $a = shift; # array ref
+# my $b = shift; # array ref or hash ref
+# return _longestCommonSubsequence( $a, $b, 1, @_ );
+# }
+
+# sub LCSidx
+# {
+# my $a= shift @_;
+# my $b= shift @_;
+# my $match= _longestCommonSubsequence( $a, $b, 0, @_ );
+# my @am= grep defined $match->[$_], 0..$#$match;
+# my @bm= @{$match}[@am];
+# return \@am, \@bm;
+# }
+
+# sub compact_diff
+# {
+# my $a= shift @_;
+# my $b= shift @_;
+# my( $am, $bm )= LCSidx( $a, $b, @_ );
+# my @cdiff;
+# my( $ai, $bi )= ( 0, 0 );
+# push @cdiff, $ai, $bi;
+# while( 1 ) {
+# while( @$am && $ai == $am->[0] && $bi == $bm->[0] ) {
+# shift @$am;
+# shift @$bm;
+# ++$ai, ++$bi;
+# }
+# push @cdiff, $ai, $bi;
+# last if ! @$am;
+# $ai = $am->[0];
+# $bi = $bm->[0];
+# push @cdiff, $ai, $bi;
+# }
+# push @cdiff, 0+@$a, 0+@$b
+# if $ai < @$a || $bi < @$b;
+# return wantarray ? @cdiff : \@cdiff;
+# }
+
+sub diff(@a,@b) is export
+{
+ my @retval;
+ my @hunk;
+ my $discard = sub {
+ my ($x,$y) = @_;
+ @hunk.push( [ '-', $x, @a[ $x ] ]);
+ };
+ my $add = sub {
+ my ($x,$y) = @_;
+ @hunk.push( [ '+', $y, @b[ $y ] ]);
+ };
+ my $match = sub {
+ my ($x,$y) = @_;
+ @retval.push(@hunk)
+ if 0 < @hunk.elems();
+ @hunk = ();
+ };
+ traverse_sequences( @a, @b, MATCH => $match, DISCARD_A => $discard, DISCARD_B => $add );
+ $match.();
+ return @retval;
+}
+
+sub sdiff(@a,@b) is export
+{
+ my @retval;
+ my $discard = sub { my $x = shift @_; @retval.push( [ '-', @a[ $x ], "" ] ) };
+ my $add = sub { my ($x,$y) = @_; @retval.push( [ '+', "", @b[ $y ] ] ) };
+ my $change = sub {
+ my ($x,$y) = @_;
+ @retval.push( [ 'c', @a[ $x ], @b[ $y ] ] );
+ };
+ my $match = sub {
+ my ($x,$y) = @_;
+ @retval.push( [ 'u', @a[ $x ], @b[ $y ] ] );
+ };
+
+ traverse_balanced(@a,@b,
+ MATCH => $match,
+ DISCARD_A => $discard,
+ DISCARD_B => $add,
+ CHANGE => $change,
+ );
+ return @retval;
+}
+
+# ########################################
+# my $Root= __PACKAGE__;
+# package Algorithm::Diff::_impl;
+# use strict;
+
+# sub _Idx() { 0 } # $me->[_Idx]: Ref to array of hunk indices
+# # 1 # $me->[1]: Ref to first sequence
+# # 2 # $me->[2]: Ref to second sequence
+# sub _End() { 3 } # $me->[_End]: Diff between forward and reverse pos
+# sub _Same() { 4 } # $me->[_Same]: 1 if pos 1 contains unchanged items
+# sub _Base() { 5 } # $me->[_Base]: Added to range's min and max
+# sub _Pos() { 6 } # $me->[_Pos]: Which hunk es currently selected
+# sub _Off() { 7 } # $me->[_Off]: Offset into _Idx for current position
+# sub _Min() { -2 } # Added to _Off to get min instead of max+1
+
+# sub Die
+# {
+# require Carp;
+# Carp::confess( @_ );
+# }
+
+# sub _ChkPos
+# {
+# my( $me )= @_;
+# return if $me->[_Pos];
+# my $meth= ( caller(1) )[3];
+# Die( "Called $meth on 'reset' object" );
+# }
+
+# sub _ChkSeq
+# {
+# my( $me, $seq )= @_;
+# return $seq + $me->[_Off]
+# if 1 == $seq || 2 == $seq;
+# my $meth= ( caller(1) )[3];
+# Die( "$meth: Invalid sequence number ($seq); must be 1 or 2" );
+# }
+
+# sub getObjPkg
+# {
+# my( $us )= @_;
+# return ref $us if ref $us;
+# return $us . "::_obj";
+# }
+
+# sub new
+# {
+# my( $us, $seq1, $seq2, $opts ) = @_;
+# my @args;
+# for( $opts->{keyGen} ) {
+# push @args, $_ if $_;
+# }
+# for( $opts->{keyGenArgs} ) {
+# push @args, @$_ if $_;
+# }
+# my $cdif= Algorithm::Diff::compact_diff( $seq1, $seq2, @args );
+# my $same= 1;
+# if( 0 == $cdif->[2] && 0 == $cdif->[3] ) {
+# $same= 0;
+# splice @$cdif, 0, 2;
+# }
+# my @obj= ( $cdif, $seq1, $seq2 );
+# $obj[_End] = (1+@$cdif)/2;
+# $obj[_Same] = $same;
+# $obj[_Base] = 0;
+# my $me = bless \@obj, $us->getObjPkg();
+# $me->Reset( 0 );
+# return $me;
+# }
+
+# sub Reset
+# {
+# my( $me, $pos )= @_;
+# $pos= int( $pos || 0 );
+# $pos += $me->[_End]
+# if $pos < 0;
+# $pos= 0
+# if $pos < 0 || $me->[_End] <= $pos;
+# $me->[_Pos]= $pos || !1;
+# $me->[_Off]= 2*$pos - 1;
+# return $me;
+# }
+
+# sub Base
+# {
+# my( $me, $base )= @_;
+# my $oldBase= $me->[_Base];
+# $me->[_Base]= 0+$base if defined $base;
+# return $oldBase;
+# }
+
+# sub Copy
+# {
+# my( $me, $pos, $base )= @_;
+# my @obj= @$me;
+# my $you= bless \@obj, ref($me);
+# $you->Reset( $pos ) if defined $pos;
+# $you->Base( $base );
+# return $you;
+# }
+
+# sub Next {
+# my( $me, $steps )= @_;
+# $steps= 1 if ! defined $steps;
+# if( $steps ) {
+# my $pos= $me->[_Pos];
+# my $new= $pos + $steps;
+# $new= 0 if $pos && $new < 0;
+# $me->Reset( $new )
+# }
+# return $me->[_Pos];
+# }
+
+# sub Prev {
+# my( $me, $steps )= @_;
+# $steps= 1 if ! defined $steps;
+# my $pos= $me->Next(-$steps);
+# $pos -= $me->[_End] if $pos;
+# return $pos;
+# }
+
+# sub Diff {
+# my( $me )= @_;
+# $me->_ChkPos();
+# return 0 if $me->[_Same] == ( 1 & $me->[_Pos] );
+# my $ret= 0;
+# my $off= $me->[_Off];
+# for my $seq ( 1, 2 ) {
+# $ret |= $seq
+# if $me->[_Idx][ $off + $seq + _Min ]
+# < $me->[_Idx][ $off + $seq ];
+# }
+# return $ret;
+# }
+
+# sub Min {
+# my( $me, $seq, $base )= @_;
+# $me->_ChkPos();
+# my $off= $me->_ChkSeq($seq);
+# $base= $me->[_Base] if !defined $base;
+# return $base + $me->[_Idx][ $off + _Min ];
+# }
+
+# sub Max {
+# my( $me, $seq, $base )= @_;
+# $me->_ChkPos();
+# my $off= $me->_ChkSeq($seq);
+# $base= $me->[_Base] if !defined $base;
+# return $base + $me->[_Idx][ $off ] -1;
+# }
+
+# sub Range {
+# my( $me, $seq, $base )= @_;
+# $me->_ChkPos();
+# my $off = $me->_ChkSeq($seq);
+# if( !wantarray ) {
+# return $me->[_Idx][ $off ]
+# - $me->[_Idx][ $off + _Min ];
+# }
+# $base= $me->[_Base] if !defined $base;
+# return ( $base + $me->[_Idx][ $off + _Min ] )
+# .. ( $base + $me->[_Idx][ $off ] - 1 );
+# }
+
+# sub Items {
+# my( $me, $seq )= @_;
+# $me->_ChkPos();
+# my $off = $me->_ChkSeq($seq);
+# if( !wantarray ) {
+# return $me->[_Idx][ $off ]
+# - $me->[_Idx][ $off + _Min ];
+# }
+# return
+# @{$me->[$seq]}[
+# $me->[_Idx][ $off + _Min ]
+# .. ( $me->[_Idx][ $off ] - 1 )
+# ];
+# }
+
+# sub Same {
+# my( $me )= @_;
+# $me->_ChkPos();
+# return wantarray ? () : 0
+# if $me->[_Same] != ( 1 & $me->[_Pos] );
+# return $me->Items(1);
+# }
+
+# my %getName;
+# BEGIN {
+# %getName= (
+# same => \&Same,
+# diff => \&Diff,
+# base => \&Base,
+# min => \&Min,
+# max => \&Max,
+# range=> \&Range,
+# items=> \&Items, # same thing
+# );
+# }
+
+# sub Get
+# {
+# my $me= shift @_;
+# $me->_ChkPos();
+# my @value;
+# for my $arg ( @_ ) {
+# for my $word ( split ' ', $arg ) {
+# my $meth;
+# if( $word !~ /^(-?\d+)?([a-zA-Z]+)([12])?$/
+# || not $meth= $getName{ lc $2 }
+# ) {
+# Die( $Root, ", Get: Invalid request ($word)" );
+# }
+# my( $base, $name, $seq )= ( $1, $2, $3 );
+# push @value, scalar(
+# 4 == length($name)
+# ? $meth->( $me )
+# : $meth->( $me, $seq, $base )
+# );
+# }
+# }
+# if( wantarray ) {
+# return @value;
+# } elsif( 1 == @value ) {
+# return $value[0];
+# }
+# Die( 0+@value, " values requested from ",
+# $Root, "'s Get in scalar context" );
+# }
+
+
+# my $Obj= getObjPkg($Root);
+# no strict 'refs';
+
+# for my $meth ( qw( new getObjPkg ) ) {
+# *{$Root."::".$meth} = \&{$meth};
+# *{$Obj ."::".$meth} = \&{$meth};
+# }
+# for my $meth ( qw(
+# Next Prev Reset Copy Base Diff
+# Same Items Range Min Max Get
+# _ChkPos _ChkSeq
+# ) ) {
+# *{$Obj."::".$meth} = \&{$meth};
+# }
+
+# 1;
+# __END__
+
+# =head1 NAME
+
+# Algorithm::Diff - Compute `intelligent' differences between two files / lists
+
+# =head1 SYNOPSIS
+
+# require Algorithm::Diff;
+
+# # This example produces traditional 'diff' output:
+
+# my $diff = Algorithm::Diff->new( \@seq1, \@seq2 );
+
+# $diff->Base( 1 ); # Return line numbers, not indices
+# while( $diff->Next() ) {
+# next if $diff->Same();
+# my $sep = '';
+# if( ! $diff->Items(2) ) {
+# printf "%d,%dd%d\n",
+# $diff->Get(qw( Min1 Max1 Max2 ));
+# } elsif( ! $diff->Items(1) ) {
+# printf "%da%d,%d\n",
+# $diff->Get(qw( Max1 Min2 Max2 ));
+# } else {
+# $sep = "---\n";
+# printf "%d,%dc%d,%d\n",
+# $diff->Get(qw( Min1 Max1 Min2 Max2 ));
+# }
+# print "< $_" for $diff->Items(1);
+# print $sep;
+# print "> $_" for $diff->Items(2);
+# }
+
+
+# # Alternate interfaces:
+
+# use Algorithm::Diff qw(
+# LCS LCS_length LCSidx
+# diff sdiff compact_diff
+# traverse_sequences traverse_balanced );
+
+# @lcs = LCS( \@seq1, \@seq2 );
+# $lcsref = LCS( \@seq1, \@seq2 );
+# $count = LCS_length( \@seq1, \@seq2 );
+
+# ( $seq1idxref, $seq2idxref ) = LCSidx( \@seq1, \@seq2 );
+
+
+# # Complicated interfaces:
+
+# @diffs = diff( \@seq1, \@seq2 );
+
+# @sdiffs = sdiff( \@seq1, \@seq2 );
+
+# @cdiffs = compact_diff( \@seq1, \@seq2 );
+
+# traverse_sequences(
+# \@seq1,
+# \@seq2,
+# { MATCH => \&callback1,
+# DISCARD_A => \&callback2,
+# DISCARD_B => \&callback3,
+# },
+# \&key_generator,
+# @extra_args,
+# );
+
+# traverse_balanced(
+# \@seq1,
+# \@seq2,
+# { MATCH => \&callback1,
+# DISCARD_A => \&callback2,
+# DISCARD_B => \&callback3,
+# CHANGE => \&callback4,
+# },
+# \&key_generator,
+# @extra_args,
+# );
+
+
+# =head1 INTRODUCTION
+
+# (by Mark-Jason Dominus)
+
+# I once read an article written by the authors of C<diff>; they said
+# that they worked very hard on the algorithm until they found the
+# right one.
+
+# I think what they ended up using (and I hope someone will correct me,
+# because I am not very confident about this) was the `longest common
+# subsequence' method. In the LCS problem, you have two sequences of
+# items:
+
+# a b c d f g h j q z
+
+# a b c d e f g i j k r x y z
+
+# and you want to find the longest sequence of items that is present in
+# both original sequences in the same order. That is, you want to find
+# a new sequence I<S> which can be obtained from the first sequence by
+# deleting some items, and from the secend sequence by deleting other
+# items. You also want I<S> to be as long as possible. In this case I<S>
+# is
+
+# a b c d f g j z
+
+# From there it's only a small step to get diff-like output:
+
+# e h i k q r x y
+# + - + + - + + +
+
+# This module solves the LCS problem. It also includes a canned function
+# to generate C<diff>-like output.
+
+# It might seem from the example above that the LCS of two sequences is
+# always pretty obvious, but that's not always the case, especially when
+# the two sequences have many repeated elements. For example, consider
+
+# a x b y c z p d q
+# a b c a x b y c z
+
+# A naive approach might start by matching up the C<a> and C<b> that
+# appear at the beginning of each sequence, like this:
+
+# a x b y c z p d q
+# a b c a b y c z
+
+# This finds the common subsequence C<a b c z>. But actually, the LCS
+# is C<a x b y c z>:
+
+# a x b y c z p d q
+# a b c a x b y c z
+
+# or
+
+# a x b y c z p d q
+# a b c a x b y c z
+
+# =head1 USAGE
+
+# (See also the README file and several example
+# scripts include with this module.)
+
+# This module now provides an object-oriented interface that uses less
+# memory and is easier to use than most of the previous procedural
+# interfaces. It also still provides several exportable functions. We'll
+# deal with these in ascending order of difficulty: C<LCS>,
+# C<LCS_length>, C<LCSidx>, OO interface, C<prepare>, C<diff>, C<sdiff>,
+# C<traverse_sequences>, and C<traverse_balanced>.
+
+# =head2 C<LCS>
+
+# Given references to two lists of items, LCS returns an array containing
+# their longest common subsequence. In scalar context, it returns a
+# reference to such a list.
+
+# @lcs = LCS( \@seq1, \@seq2 );
+# $lcsref = LCS( \@seq1, \@seq2 );
+
+# C<LCS> may be passed an optional third parameter; this is a CODE
+# reference to a key generation function. See L</KEY GENERATION
+# FUNCTIONS>.
+
+# @lcs = LCS( \@seq1, \@seq2, \&keyGen, @args );
+# $lcsref = LCS( \@seq1, \@seq2, \&keyGen, @args );
+
+# Additional parameters, if any, will be passed to the key generation
+# routine.
+
+# =head2 C<LCS_length>
+
+# This is just like C<LCS> except it only returns the length of the
+# longest common subsequence. This provides a performance gain of about
+# 9% compared to C<LCS>.
+
+# =head2 C<LCSidx>
+
+# Like C<LCS> except it returns references to two arrays. The first array
+# contains the indices into @seq1 where the LCS items are located. The
+# second array contains the indices into @seq2 where the LCS items are located.
+
+# Therefore, the following three lists will contain the same values:
+
+# my( $idx1, $idx2 ) = LCSidx( \@seq1, \@seq2 );
+# my @list1 = @seq1[ @$idx1 ];
+# my @list2 = @seq2[ @$idx2 ];
+# my @list3 = LCS( \@seq1, \@seq2 );
+
+# =head2 C<new>
+
+# $diff = Algorithm::Diffs->new( \@seq1, \@seq2 );
+# $diff = Algorithm::Diffs->new( \@seq1, \@seq2, \%opts );
+
+# C<new> computes the smallest set of additions and deletions necessary
+# to turn the first sequence into the second and compactly records them
+# in the object.
+
+# You use the object to iterate over I<hunks>, where each hunk represents
+# a contiguous section of items which should be added, deleted, replaced,
+# or left unchanged.
+
+# =over 4
+
+# The following summary of all of the methods looks a lot like Perl code
+# but some of the symbols have different meanings:
+
+# [ ] Encloses optional arguments
+# : Is followed by the default value for an optional argument
+# | Separates alternate return results
+
+# Method summary:
+
+# $obj = Algorithm::Diff->new( \@seq1, \@seq2, [ \%opts ] );
+# $pos = $obj->Next( [ $count : 1 ] );
+# $revPos = $obj->Prev( [ $count : 1 ] );
+# $obj = $obj->Reset( [ $pos : 0 ] );
+# $copy = $obj->Copy( [ $pos, [ $newBase ] ] );
+# $oldBase = $obj->Base( [ $newBase ] );
+
+# Note that all of the following methods C<die> if used on an object that
+# is "reset" (not currently pointing at any hunk).
+
+# $bits = $obj->Diff( );
+# @items|$cnt = $obj->Same( );
+# @items|$cnt = $obj->Items( $seqNum );
+# @idxs |$cnt = $obj->Range( $seqNum, [ $base ] );
+# $minIdx = $obj->Min( $seqNum, [ $base ] );
+# $maxIdx = $obj->Max( $seqNum, [ $base ] );
+# @values = $obj->Get( @names );
+
+# Passing in C<undef> for an optional argument is always treated the same
+# as if no argument were passed in.
+
+# =item C<Next>
+
+# $pos = $diff->Next(); # Move forward 1 hunk
+# $pos = $diff->Next( 2 ); # Move forward 2 hunks
+# $pos = $diff->Next(-5); # Move backward 5 hunks
+
+# C<Next> moves the object to point at the next hunk. The object starts
+# out "reset", which means it isn't pointing at any hunk. If the object
+# is reset, then C<Next()> moves to the first hunk.
+
+# C<Next> returns a true value iff the move didn't go past the last hunk.
+# So C<Next(0)> will return true iff the object is not reset.
+
+# Actually, C<Next> returns the object's new position, which is a number
+# between 1 and the number of hunks (inclusive), or returns a false value.
+
+# =item C<Prev>
+
+# C<Prev($N)> is almost identical to C<Next(-$N)>; it moves to the $Nth
+# previous hunk. On a 'reset' object, C<Prev()> [and C<Next(-1)>] move
+# to the last hunk.
+
+# The position returned by C<Prev> is relative to the I<end> of the
+# hunks; -1 for the last hunk, -2 for the second-to-last, etc.
+
+# =item C<Reset>
+
+# $diff->Reset(); # Reset the object's position
+# $diff->Reset($pos); # Move to the specified hunk
+# $diff->Reset(1); # Move to the first hunk
+# $diff->Reset(-1); # Move to the last hunk
+
+# C<Reset> returns the object, so, for example, you could use
+# C<< $diff->Reset()->Next(-1) >> to get the number of hunks.
+
+# =item C<Copy>
+
+# $copy = $diff->Copy( $newPos, $newBase );
+
+# C<Copy> returns a copy of the object. The copy and the orignal object
+# share most of their data, so making copies takes very little memory.
+# The copy maintains its own position (separate from the original), which
+# is the main purpose of copies. It also maintains its own base.
+
+# By default, the copy's position starts out the same as the original
+# object's position. But C<Copy> takes an optional first argument to set the
+# new position, so the following three snippets are equivalent:
+
+# $copy = $diff->Copy($pos);
+
+# $copy = $diff->Copy();
+# $copy->Reset($pos);
+
+# $copy = $diff->Copy()->Reset($pos);
+
+# C<Copy> takes an optional second argument to set the base for
+# the copy. If you wish to change the base of the copy but leave
+# the position the same as in the original, here are two
+# equivalent ways:
+
+# $copy = $diff->Copy();
+# $copy->Base( 0 );
+
+# $copy = $diff->Copy(undef,0);
+
+# Here are two equivalent way to get a "reset" copy:
+
+# $copy = $diff->Copy(0);
+
+# $copy = $diff->Copy()->Reset();
+
+# =item C<Diff>
+
+# $bits = $obj->Diff();
+
+# C<Diff> returns a true value iff the current hunk contains items that are
+# different between the two sequences. It actually returns one of the
+# follow 4 values:
+
+# =over 4
+
+# =item 3
+
+# C<3==(1|2)>. This hunk contains items from @seq1 and the items
+# from @seq2 that should replace them. Both sequence 1 and 2
+# contain changed items so both the 1 and 2 bits are set.
+
+# =item 2
+
+# This hunk only contains items from @seq2 that should be inserted (not
+# items from @seq1). Only sequence 2 contains changed items so only the 2
+# bit is set.
+
+# =item 1
+
+# This hunk only contains items from @seq1 that should be deleted (not
+# items from @seq2). Only sequence 1 contains changed items so only the 1
+# bit is set.
+
+# =item 0
+
+# This means that the items in this hunk are the same in both sequences.
+# Neither sequence 1 nor 2 contain changed items so neither the 1 nor the
+# 2 bits are set.
+
+# =back
+
+# =item C<Same>
+
+# C<Same> returns a true value iff the current hunk contains items that
+# are the same in both sequences. It actually returns the list of items
+# if they are the same or an emty list if they aren't. In a scalar
+# context, it returns the size of the list.
+
+# =item C<Items>
+
+# $count = $diff->Items(2);
+# @items = $diff->Items($seqNum);
+
+# C<Items> returns the (number of) items from the specified sequence that
+# are part of the current hunk.
+
+# If the current hunk contains only insertions, then
+# C<< $diff->Items(1) >> will return an empty list (0 in a scalar conext).
+# If the current hunk contains only deletions, then C<< $diff->Items(2) >>
+# will return an empty list (0 in a scalar conext).
+
+# If the hunk contains replacements, then both C<< $diff->Items(1) >> and
+# C<< $diff->Items(2) >> will return different, non-empty lists.
+
+# Otherwise, the hunk contains identical items and all of the following
+# will return the same lists:
+
+# @items = $diff->Items(1);
+# @items = $diff->Items(2);
+# @items = $diff->Same();
+
+# =item C<Range>
+
+# $count = $diff->Range( $seqNum );
+# @indices = $diff->Range( $seqNum );
+# @indices = $diff->Range( $seqNum, $base );
+
+# C<Range> is like C<Items> except that it returns a list of I<indices> to
+# the items rather than the items themselves. By default, the index of
+# the first item (in each sequence) is 0 but this can be changed by
+# calling the C<Base> method. So, by default, the following two snippets
+# return the same lists:
+
+# @list = $diff->Items(2);
+# @list = @seq2[ $diff->Range(2) ];
+
+# You can also specify the base to use as the second argument. So the
+# following two snippets I<always> return the same lists:
+
+# @list = $diff->Items(1);
+# @list = @seq1[ $diff->Range(1,0) ];
+
+# =item C<Base>
+
+# $curBase = $diff->Base();
+# $oldBase = $diff->Base($newBase);
+
+# C<Base> sets and/or returns the current base (usually 0 or 1) that is
+# used when you request range information. The base defaults to 0 so
+# that range information is returned as array indices. You can set the
+# base to 1 if you want to report traditional line numbers instead.
+
+# =item C<Min>
+
+# $min1 = $diff->Min(1);
+# $min = $diff->Min( $seqNum, $base );
+
+# C<Min> returns the first value that C<Range> would return (given the
+# same arguments) or returns C<undef> if C<Range> would return an empty
+# list.
+
+# =item C<Max>
+
+# C<Max> returns the last value that C<Range> would return or C<undef>.
+
+# =item C<Get>
+
+# ( $n, $x, $r ) = $diff->Get(qw( min1 max1 range1 ));
+# @values = $diff->Get(qw( 0min2 1max2 range2 same base ));
+
+# C<Get> returns one or more scalar values. You pass in a list of the
+# names of the values you want returned. Each name must match one of the
+# following regexes:
+
+# /^(-?\d+)?(min|max)[12]$/i
+# /^(range[12]|same|diff|base)$/i
+
+# The 1 or 2 after a name says which sequence you want the information
+# for (and where allowed, it is required). The optional number before
+# "min" or "max" is the base to use. So the following equalities hold:
+
+# $diff->Get('min1') == $diff->Min(1)
+# $diff->Get('0min2') == $diff->Min(2,0)
+
+# Using C<Get> in a scalar context when you've passed in more than one
+# name is a fatal error (C<die> is called).
+
+# =back
+
+# =head2 C<prepare>
+
+# Given a reference to a list of items, C<prepare> returns a reference
+# to a hash which can be used when comparing this sequence to other
+# sequences with C<LCS> or C<LCS_length>.
+
+# $prep = prepare( \@seq1 );
+# for $i ( 0 .. 10_000 )
+# {
+# @lcs = LCS( $prep, $seq[$i] );
+# # do something useful with @lcs
+# }
+
+# C<prepare> may be passed an optional third parameter; this is a CODE
+# reference to a key generation function. See L</KEY GENERATION
+# FUNCTIONS>.
+
+# $prep = prepare( \@seq1, \&keyGen );
+# for $i ( 0 .. 10_000 )
+# {
+# @lcs = LCS( $seq[$i], $prep, \&keyGen );
+# # do something useful with @lcs
+# }
+
+# Using C<prepare> provides a performance gain of about 50% when calling LCS
+# many times compared with not preparing.
+
+# =head2 C<diff>
+
+# @diffs = diff( \@seq1, \@seq2 );
+# $diffs_ref = diff( \@seq1, \@seq2 );
+
+# C<diff> computes the smallest set of additions and deletions necessary
+# to turn the first sequence into the second, and returns a description
+# of these changes. The description is a list of I<hunks>; each hunk
+# represents a contiguous section of items which should be added,
+# deleted, or replaced. (Hunks containing unchanged items are not
+# included.)
+
+# The return value of C<diff> is a list of hunks, or, in scalar context, a
+# reference to such a list. If there are no differences, the list will be
+# empty.
+
+# Here is an example. Calling C<diff> for the following two sequences:
+
+# a b c e h j l m n p
+# b c d e f j k l m r s t
+
+# would produce the following list:
+
+# (
+# [ [ '-', 0, 'a' ] ],
+
+# [ [ '+', 2, 'd' ] ],
+
+# [ [ '-', 4, 'h' ],
+# [ '+', 4, 'f' ] ],
+
+# [ [ '+', 6, 'k' ] ],
+
+# [ [ '-', 8, 'n' ],
+# [ '-', 9, 'p' ],
+# [ '+', 9, 'r' ],
+# [ '+', 10, 's' ],
+# [ '+', 11, 't' ] ],
+# )
+
+# There are five hunks here. The first hunk says that the C<a> at
+# position 0 of the first sequence should be deleted (C<->). The second
+# hunk says that the C<d> at position 2 of the second sequence should
+# be inserted (C<+>). The third hunk says that the C<h> at position 4
+# of the first sequence should be removed and replaced with the C<f>
+# from position 4 of the second sequence. And so on.
+
+# C<diff> may be passed an optional third parameter; this is a CODE
+# reference to a key generation function. See L</KEY GENERATION
+# FUNCTIONS>.
+
+# Additional parameters, if any, will be passed to the key generation
+# routine.
+
+# =head2 C<sdiff>
+
+# @sdiffs = sdiff( \@seq1, \@seq2 );
+# $sdiffs_ref = sdiff( \@seq1, \@seq2 );
+
+# C<sdiff> computes all necessary components to show two sequences
+# and their minimized differences side by side, just like the
+# Unix-utility I<sdiff> does:
+
+# same same
+# before | after
+# old < -
+# - > new
+
+# It returns a list of array refs, each pointing to an array of
+# display instructions. In scalar context it returns a reference
+# to such a list. If there are no differences, the list will have one
+# entry per item, each indicating that the item was unchanged.
+
+# Display instructions consist of three elements: A modifier indicator
+# (C<+>: Element added, C<->: Element removed, C<u>: Element unmodified,
+# C<c>: Element changed) and the value of the old and new elements, to
+# be displayed side-by-side.
+
+# An C<sdiff> of the following two sequences:
+
+# a b c e h j l m n p
+# b c d e f j k l m r s t
+
+# results in
+
+# ( [ '-', 'a', '' ],
+# [ 'u', 'b', 'b' ],
+# [ 'u', 'c', 'c' ],
+# [ '+', '', 'd' ],
+# [ 'u', 'e', 'e' ],
+# [ 'c', 'h', 'f' ],
+# [ 'u', 'j', 'j' ],
+# [ '+', '', 'k' ],
+# [ 'u', 'l', 'l' ],
+# [ 'u', 'm', 'm' ],
+# [ 'c', 'n', 'r' ],
+# [ 'c', 'p', 's' ],
+# [ '+', '', 't' ],
+# )
+
+# C<sdiff> may be passed an optional third parameter; this is a CODE
+# reference to a key generation function. See L</KEY GENERATION
+# FUNCTIONS>.
+
+# Additional parameters, if any, will be passed to the key generation
+# routine.
+
+# =head2 C<compact_diff>
+
+# C<compact_diff> is much like C<sdiff> except it returns a much more
+# compact description consisting of just one flat list of indices. An
+# example helps explain the format:
+
+# my @a = qw( a b c e h j l m n p );
+# my @b = qw( b c d e f j k l m r s t );
+# @cdiff = compact_diff( \@a, \@b );
+# # Returns:
+# # @a @b @a @b
+# # start start values values
+# ( 0, 0, # =
+# 0, 0, # a !
+# 1, 0, # b c = b c
+# 3, 2, # ! d
+# 3, 3, # e = e
+# 4, 4, # f ! h
+# 5, 5, # j = j
+# 6, 6, # ! k
+# 6, 7, # l m = l m
+# 8, 9, # n p ! r s t
+# 10, 12, #
+# );
+
+# The 0th, 2nd, 4th, etc. entries are all indices into @seq1 (@a in the
+# above example) indicating where a hunk begins. The 1st, 3rd, 5th, etc.
+# entries are all indices into @seq2 (@b in the above example) indicating
+# where the same hunk begins.
+
+# So each pair of indices (except the last pair) describes where a hunk
+# begins (in each sequence). Since each hunk must end at the item just
+# before the item that starts the next hunk, the next pair of indices can
+# be used to determine where the hunk ends.
+
+# So, the first 4 entries (0..3) describe the first hunk. Entries 0 and 1
+# describe where the first hunk begins (and so are always both 0).
+# Entries 2 and 3 describe where the next hunk begins, so subtracting 1
+# from each tells us where the first hunk ends. That is, the first hunk
+# contains items C<$diff[0]> through C<$diff[2] - 1> of the first sequence
+# and contains items C<$diff[1]> through C<$diff[3] - 1> of the second
+# sequence.
+
+# In other words, the first hunk consists of the following two lists of items:
+
+# # 1st pair 2nd pair
+# # of indices of indices
+# @list1 = @a[ $cdiff[0] .. $cdiff[2]-1 ];
+# @list2 = @b[ $cdiff[1] .. $cdiff[3]-1 ];
+# # Hunk start Hunk end
+
+# Note that the hunks will always alternate between those that are part of
+# the LCS (those that contain unchanged items) and those that contain
+# changes. This means that all we need to be told is whether the first
+# hunk is a 'same' or 'diff' hunk and we can determine which of the other
+# hunks contain 'same' items or 'diff' items.
+
+# By convention, we always make the first hunk contain unchanged items.
+# So the 1st, 3rd, 5th, etc. hunks (all odd-numbered hunks if you start
+# counting from 1) all contain unchanged items. And the 2nd, 4th, 6th,
+# etc. hunks (all even-numbered hunks if you start counting from 1) all
+# contain changed items.
+
+# Since @a and @b don't begin with the same value, the first hunk in our
+# example is empty (otherwise we'd violate the above convention). Note
+# that the first 4 index values in our example are all zero. Plug these
+# values into our previous code block and we get:
+
+# @hunk1a = @a[ 0 .. 0-1 ];
+# @hunk1b = @b[ 0 .. 0-1 ];
+
+# And C<0..-1> returns the empty list.
+
+# Move down one pair of indices (2..5) and we get the offset ranges for
+# the second hunk, which contains changed items.
+
+# Since C<@diff[2..5]> contains (0,0,1,0) in our example, the second hunk
+# consists of these two lists of items:
+
+# @hunk2a = @a[ $cdiff[2] .. $cdiff[4]-1 ];
+# @hunk2b = @b[ $cdiff[3] .. $cdiff[5]-1 ];
+# # or
+# @hunk2a = @a[ 0 .. 1-1 ];
+# @hunk2b = @b[ 0 .. 0-1 ];
+# # or
+# @hunk2a = @a[ 0 .. 0 ];
+# @hunk2b = @b[ 0 .. -1 ];
+# # or
+# @hunk2a = ( 'a' );
+# @hunk2b = ( );
+
+# That is, we would delete item 0 ('a') from @a.
+
+# Since C<@diff[4..7]> contains (1,0,3,2) in our example, the third hunk
+# consists of these two lists of items:
+
+# @hunk3a = @a[ $cdiff[4] .. $cdiff[6]-1 ];
+# @hunk3a = @b[ $cdiff[5] .. $cdiff[7]-1 ];
+# # or
+# @hunk3a = @a[ 1 .. 3-1 ];
+# @hunk3a = @b[ 0 .. 2-1 ];
+# # or
+# @hunk3a = @a[ 1 .. 2 ];
+# @hunk3a = @b[ 0 .. 1 ];
+# # or
+# @hunk3a = qw( b c );
+# @hunk3a = qw( b c );
+
+# Note that this third hunk contains unchanged items as our convention demands.
+
+# You can continue this process until you reach the last two indices,
+# which will always be the number of items in each sequence. This is
+# required so that subtracting one from each will give you the indices to
+# the last items in each sequence.
+
+# =head2 C<traverse_sequences>
+
+# C<traverse_sequences> used to be the most general facility provided by
+# this module (the new OO interface is more powerful and much easier to
+# use).
+
+# Imagine that there are two arrows. Arrow A points to an element of
+# sequence A, and arrow B points to an element of the sequence B.
+# Initially, the arrows point to the first elements of the respective
+# sequences. C<traverse_sequences> will advance the arrows through the
+# sequences one element at a time, calling an appropriate user-specified
+# callback function before each advance. It willadvance the arrows in
+# such a way that if there are equal elements C<$A[$i]> and C<$B[$j]>
+# which are equal and which are part of the LCS, there will be some moment
+# during the execution of C<traverse_sequences> when arrow A is pointing
+# to C<$A[$i]> and arrow B is pointing to C<$B[$j]>. When this happens,
+# C<traverse_sequences> will call the C<MATCH> callback function and then
+# it will advance both arrows.
+
+# Otherwise, one of the arrows is pointing to an element of its sequence
+# that is not part of the LCS. C<traverse_sequences> will advance that
+# arrow and will call the C<DISCARD_A> or the C<DISCARD_B> callback,
+# depending on which arrow it advanced. If both arrows point to elements
+# that are not part of the LCS, then C<traverse_sequences> will advance
+# one of them and call the appropriate callback, but it is not specified
+# which it will call.
+
+# The arguments to C<traverse_sequences> are the two sequences to
+# traverse, and a hash which specifies the callback functions, like this:
+
+# traverse_sequences(
+# \@seq1, \@seq2,
+# { MATCH => $callback_1,
+# DISCARD_A => $callback_2,
+# DISCARD_B => $callback_3,
+# }
+# );
+
+# Callbacks for MATCH, DISCARD_A, and DISCARD_B are invoked with at least
+# the indices of the two arrows as their arguments. They are not expected
+# to return any values. If a callback is omitted from the table, it is
+# not called.
+
+# Callbacks for A_FINISHED and B_FINISHED are invoked with at least the
+# corresponding index in A or B.
+
+# If arrow A reaches the end of its sequence, before arrow B does,
+# C<traverse_sequences> will call the C<A_FINISHED> callback when it
+# advances arrow B, if there is such a function; if not it will call
+# C<DISCARD_B> instead. Similarly if arrow B finishes first.
+# C<traverse_sequences> returns when both arrows are at the ends of their
+# respective sequences. It returns true on success and false on failure.
+# At present there is no way to fail.
+
+# C<traverse_sequences> may be passed an optional fourth parameter; this
+# is a CODE reference to a key generation function. See L</KEY GENERATION
+# FUNCTIONS>.
+
+# Additional parameters, if any, will be passed to the key generation function.
+
+# If you want to pass additional parameters to your callbacks, but don't
+# need a custom key generation function, you can get the default by
+# passing undef:
+
+# traverse_sequences(
+# \@seq1, \@seq2,
+# { MATCH => $callback_1,
+# DISCARD_A => $callback_2,
+# DISCARD_B => $callback_3,
+# },
+# undef, # default key-gen
+# $myArgument1,
+# $myArgument2,
+# $myArgument3,
+# );
+
+# C<traverse_sequences> does not have a useful return value; you are
+# expected to plug in the appropriate behavior with the callback
+# functions.
+
+# =head2 C<traverse_balanced>
+
+# C<traverse_balanced> is an alternative to C<traverse_sequences>. It
+# uses a different algorithm to iterate through the entries in the
+# computed LCS. Instead of sticking to one side and showing element changes
+# as insertions and deletions only, it will jump back and forth between
+# the two sequences and report I<changes> occurring as deletions on one
+# side followed immediatly by an insertion on the other side.
+
+# In addition to the C<DISCARD_A>, C<DISCARD_B>, and C<MATCH> callbacks
+# supported by C<traverse_sequences>, C<traverse_balanced> supports
+# a C<CHANGE> callback indicating that one element got C<replaced> by another:
+
+# traverse_balanced(
+# \@seq1, \@seq2,
+# { MATCH => $callback_1,
+# DISCARD_A => $callback_2,
+# DISCARD_B => $callback_3,
+# CHANGE => $callback_4,
+# }
+# );
+
+# If no C<CHANGE> callback is specified, C<traverse_balanced>
+# will map C<CHANGE> events to C<DISCARD_A> and C<DISCARD_B> actions,
+# therefore resulting in a similar behaviour as C<traverse_sequences>
+# with different order of events.
+
+# C<traverse_balanced> might be a bit slower than C<traverse_sequences>,
+# noticable only while processing huge amounts of data.
+
+# The C<sdiff> function of this module
+# is implemented as call to C<traverse_balanced>.
+
+# C<traverse_balanced> does not have a useful return value; you are expected to
+# plug in the appropriate behavior with the callback functions.
+
+# =head1 KEY GENERATION FUNCTIONS
+
+# Most of the functions accept an optional extra parameter. This is a
+# CODE reference to a key generating (hashing) function that should return
+# a string that uniquely identifies a given element. It should be the
+# case that if two elements are to be considered equal, their keys should
+# be the same (and the other way around). If no key generation function
+# is provided, the key will be the element as a string.
+
+# By default, comparisons will use "eq" and elements will be turned into keys
+# using the default stringizing operator '""'.
+
+# Where this is important is when you're comparing something other than
+# strings. If it is the case that you have multiple different objects
+# that should be considered to be equal, you should supply a key
+# generation function. Otherwise, you have to make sure that your arrays
+# contain unique references.
+
+# For instance, consider this example:
+
+# package Person;
+
+# sub new
+# {
+# my $package = shift;
+# return bless { name => '', ssn => '', @_ }, $package;
+# }
+
+# sub clone
+# {
+# my $old = shift;
+# my $new = bless { %$old }, ref($old);
+# }
+
+# sub hash
+# {
+# return shift()->{'ssn'};
+# }
+
+# my $person1 = Person->new( name => 'Joe', ssn => '123-45-6789' );
+# my $person2 = Person->new( name => 'Mary', ssn => '123-47-0000' );
+# my $person3 = Person->new( name => 'Pete', ssn => '999-45-2222' );
+# my $person4 = Person->new( name => 'Peggy', ssn => '123-45-9999' );
+# my $person5 = Person->new( name => 'Frank', ssn => '000-45-9999' );
+
+# If you did this:
+
+# my $array1 = [ $person1, $person2, $person4 ];
+# my $array2 = [ $person1, $person3, $person4, $person5 ];
+# Algorithm::Diff::diff( $array1, $array2 );
+
+# everything would work out OK (each of the objects would be converted
+# into a string like "Person=HASH(0x82425b0)" for comparison).
+
+# But if you did this:
+
+# my $array1 = [ $person1, $person2, $person4 ];
+# my $array2 = [ $person1, $person3, $person4->clone(), $person5 ];
+# Algorithm::Diff::diff( $array1, $array2 );
+
+# $person4 and $person4->clone() (which have the same name and SSN)
+# would be seen as different objects. If you wanted them to be considered
+# equivalent, you would have to pass in a key generation function:
+
+# my $array1 = [ $person1, $person2, $person4 ];
+# my $array2 = [ $person1, $person3, $person4->clone(), $person5 ];
+# Algorithm::Diff::diff( $array1, $array2, \&Person::hash );
+
+# This would use the 'ssn' field in each Person as a comparison key, and
+# so would consider $person4 and $person4->clone() as equal.
+
+# You may also pass additional parameters to the key generation function
+# if you wish.
+
+# =head1 ERROR CHECKING
+
+# If you pass these routines a non-reference and they expect a reference,
+# they will die with a message.
+
+# =head1 AUTHOR
+
+# This version released by Tye McQueen (http://perlmonks.org/?node=tye).
+
+# =head1 LICENSE
+
+# Parts Copyright (c) 2000-2004 Ned Konz. All rights reserved.
+# Parts by Tye McQueen.
+
+# This program is free software; you can redistribute it and/or modify it
+# under the same terms as Perl.
+
+# =head1 MAILING LIST
+
+# Mark-Jason still maintains a mailing list. To join a low-volume mailing
+# list for announcements related to diff and Algorithm::Diff, send an
+# empty mail message to mjd-perl-diff-request@plover.com.
+
+# =head1 CREDITS
+
+# Versions through 0.59 (and much of this documentation) were written by:
+
+# Mark-Jason Dominus, mjd-perl-diff@plover.com
+
+# This version borrows some documentation and routine names from
+# Mark-Jason's, but Diff.pm's code was completely replaced.
+
+# This code was adapted from the Smalltalk code of Mario Wolczko
+# <mario@wolczko.com>, which is available at
+# ftp://st.cs.uiuc.edu/pub/Smalltalk/MANCHESTER/manchester/4.0/diff.st
+
+# C<sdiff> and C<traverse_balanced> were written by Mike Schilli
+# <m@perlmeister.com>.
+
+# The algorithm is that described in
+# I<A Fast Algorithm for Computing Longest Common Subsequences>,
+# CACM, vol.20, no.5, pp.350-353, May 1977, with a few
+# minor improvements to improve the speed.
+
+# Much work was done by Ned Konz (perl@bike-nomad.com).
+
+# The OO interface and some other changes are by Tye McQueen.
+
+# =cut
+
+}
388 t/base.t
@@ -0,0 +1,388 @@
+use v6;
+use Test;
+plan 35;
+BEGIN
+{
+ @*INC.push('lib');
+ @*INC.push('blib');
+}
+
+
+#use Algorithm::Diff qw(diff LCS traverse_sequences traverse_balanced sdiff);
+use Algorithm::Diff;
+
+my @a = <a b c e h j l m n p>;
+my @b = <b c d e f j k l m r s t>;
+my @correctResult = <b c e j l m>;
+my $correctResult = @correctResult.join(' ');
+my $skippedA = 'a h n p';
+my $skippedB = 'd f k r s t';
+
+# From the Algorithm::Diff manpage:
+my $correctDiffResult = [
+ [ [ '-', 0, 'a' ] ],
+
+ [ [ '+', 2, 'd' ] ],
+
+ [ [ '-', 4, 'h' ], [ '+', 4, 'f' ] ],
+
+ [ [ '+', 6, 'k' ] ],
+
+ [
+ [ '-', 8, 'n' ],
+ [ '+', 9, 'r' ],
+ [ '-', 9, 'p' ],
+ [ '+', 10, 's' ],
+ [ '+', 11, 't' ],
+ ]
+ ];
+
+# Result of LCS must be as long as @a
+my @result = _longestCommonSubsequence( @a, @b );
+
+is( @result.grep( *.defined ).elems(),
+ @correctResult.elems(),
+ "length of _longestCommonSubsequence" );
+
+# result has b[] line#s keyed by a[] line#
+#say "result = " ~ @result;
+
+my @aresult = map { @result[$_].defined ?? @a[$_] !! () } , 0.. @result.elems()-1;
+
+
+
+my @bresult = map { @result[$_].defined ?? @b[@result[$_]] !! () } , 0..@result.elems()-1;
+
+is( ~@aresult, $correctResult, "A results" );
+is( ~@bresult, $correctResult, "B results" );
+
+my ( @matchedA, @matchedB, @discardsA, @discardsB, $finishedA, $finishedB );
+
+sub match
+{
+ my ( $a, $b ) = @_;
+ @matchedA.push( @a[$a] );
+ @matchedB.push( @b[$b] );
+}
+
+sub discard_b
+{
+ my ( $a, $b ) = @_;
+ @discardsB.push(@b[$b]);
+}
+
+sub discard_a
+{
+ my ( $a, $b ) = @_;
+ @discardsA.push(@a[$a]);
+}
+
+sub finished_a
+{
+ my ( $a, $b ) = @_;
+ $finishedA = $a;
+}
+
+sub finished_b
+{
+ my ( $a, $b ) = @_;
+ $finishedB = $b;
+}
+
+traverse_sequences(@a,@b,
+ MATCH => &match,
+ DISCARD_A => &discard_a,
+ DISCARD_B => &discard_b
+);
+
+is( ~@matchedA, $correctResult);
+is( ~@matchedB, $correctResult);
+is( ~@discardsA, $skippedA);
+is( ~@discardsB, $skippedB);
+
+@matchedA = @matchedB = @discardsA = @discardsB = ();
+$finishedA = $finishedB = Mu;
+
+traverse_sequences(@a,@b,
+ MATCH => &match,
+ DISCARD_A => &discard_a,
+ DISCARD_B => &discard_b,
+ A_FINISHED => &finished_a,
+ B_FINISHED => &finished_b,
+);
+
+is( ~@matchedA, $correctResult);
+is( ~@matchedB, $correctResult);
+is( ~@discardsA, $skippedA);
+is( ~@discardsB, $skippedB);
+is( $finishedA, 9, "index of finishedA" );
+ok( !defined($finishedB), "index of finishedB" );
+
+ my @lcs = LCS( @a, @b );
+ ok( ~@lcs, $correctResult );
+
+# Compare the diff output with the one from the Algorithm::Diff manpage.
+my $diff = diff( @a, @b );
+
+ok( $diff eq $correctDiffResult );
+
+##################################################
+# <Mike Schilli> m@perlmeister.com 03/23/2002:
+# Tests for sdiff-interface
+#################################################
+
+@a = <abc def yyy xxx ghi jkl>;
+@b = <abc dxf xxx ghi jkl>;
+$correctDiffResult = [ ['u', 'abc', 'abc'],
+ ['c', 'def', 'dxf'],
+ ['-', 'yyy', ''],
+ ['u', 'xxx', 'xxx'],
+ ['u', 'ghi', 'ghi'],
+ ['u', 'jkl', 'jkl'] ];
+@result = sdiff(@a, @b);
+ok(@result eq $correctDiffResult);
+
+
+#################################################
+@a = <a b c e h j l m n p>;
+@b = <b c d e f j k l m r s t>;
+$correctDiffResult = [ ['-', 'a', '' ],
+ ['u', 'b', 'b'],
+ ['u', 'c', 'c'],
+ ['+', '', 'd'],
+ ['u', 'e', 'e'],
+ ['c', 'h', 'f'],
+ ['u', 'j', 'j'],
+ ['+', '', 'k'],
+ ['u', 'l', 'l'],
+ ['u', 'm', 'm'],
+ ['c', 'n', 'r'],
+ ['c', 'p', 's'],
+ ['+', '', 't'],
+ ];
+@result = sdiff(@a, @b);
+ok(@result eq $correctDiffResult);
+
+#################################################
+@a = <a b c d e>;
+@b = <a e>;
+$correctDiffResult = [ ['u', 'a', 'a' ],
+ ['-', 'b', ''],
+ ['-', 'c', ''],
+ ['-', 'd', ''],
+ ['u', 'e', 'e'],
+ ];
+@result = sdiff(@a, @b);
+ok(@result eq $correctDiffResult);
+
+#################################################
+@a = <a e>;
+@b = <a b c d e>;
+$correctDiffResult = [ ['u', 'a', 'a' ],
+ ['+', '', 'b'],
+ ['+', '', 'c'],
+ ['+', '', 'd'],
+ ['u', 'e', 'e'],
+ ];
+@result = sdiff(@a, @b);
+ok(@result eq $correctDiffResult);
+
+#################################################
+@a = <v x a e>;
+@b = <w y a b c d e>;
+$correctDiffResult = [
+ ['c', 'v', 'w' ],
+ ['c', 'x', 'y' ],
+ ['u', 'a', 'a' ],
+ ['+', '', 'b'],
+ ['+', '', 'c'],
+ ['+', '', 'd'],
+ ['u', 'e', 'e'],
+ ];
+@result = sdiff(@a, @b);
+ok(@result eq $correctDiffResult);
+
+#################################################
+@a = <x a e>;
+@b = <a b c d e>;
+$correctDiffResult = [
+ ['-', 'x', '' ],
+ ['u', 'a', 'a' ],
+ ['+', '', 'b'],
+ ['+', '', 'c'],
+ ['+', '', 'd'],
+ ['u', 'e', 'e'],
+ ];
+@result = sdiff(@a, @b);
+ok(@result eq $correctDiffResult);
+
+#################################################
+@a = <a e>;
+@b = <x a b c d e>;
+$correctDiffResult = [
+ ['+', '', 'x' ],
+ ['u', 'a', 'a' ],
+ ['+', '', 'b'],
+ ['+', '', 'c'],
+ ['+', '', 'd'],
+ ['u', 'e', 'e'],
+ ];
+@result = sdiff(@a, @b);
+ok(@result eq $correctDiffResult);
+
+#################################################
+@a = <a e v>;
+@b = <x a b c d e w x>;
+$correctDiffResult = [
+ ['+', '', 'x' ],
+ ['u', 'a', 'a' ],
+ ['+', '', 'b'],
+ ['+', '', 'c'],
+ ['+', '', 'd'],
+ ['u', 'e', 'e'],
+ ['c', 'v', 'w'],
+ ['+', '', 'x'],
+ ];
+@result = sdiff(@a, @b);
+ok(@result eq $correctDiffResult);
+
+#################################################
+@a=();
+@b = <a b c>;
+$correctDiffResult = [
+ ['+', '', 'a' ],
+ ['+', '', 'b' ],
+ ['+', '', 'c' ],
+ ];
+@result = sdiff(@a, @b);
+ok(@result eq $correctDiffResult);
+
+#################################################
+@a = <a b c>;
+@b = ();
+$correctDiffResult = [
+ ['-', 'a', '' ],
+ ['-', 'b', '' ],
+ ['-', 'c', '' ],
+ ];
+@result = sdiff(@a, @b);
+ok(@result eq $correctDiffResult);
+
+#################################################
+@a = <a b c>;
+@b = <1>;
+$correctDiffResult = [
+ ['c', 'a', '1' ],
+ ['-', 'b', '' ],
+ ['-', 'c', '' ],
+ ];
+@result = sdiff(@a, @b);
+ok(@result eq $correctDiffResult);
+
+#################################################
+@a = <a b c>;
+@b = <c>;
+$correctDiffResult = [
+ ['-', 'a', '' ],
+ ['-', 'b', '' ],
+ ['u', 'c', 'c' ],
+ ];
+@result = sdiff(@a, @b);
+ok(@result eq $correctDiffResult);
+
+#################################################
+@a = <a b c>;
+@b = <a x c>;
+my $r = "";
+traverse_balanced( @a, @b,
+ MATCH => sub { $r ~= "M " ~@_;},
+ DISCARD_A => sub { $r ~= "DA " ~@_;},
+ DISCARD_B => sub { $r ~= "DB " ~@_;},
+ CHANGE => sub { $r ~= "C " ~@_;},
+ );
+
+ok($r eq "M 0 0C 1 1M 2 2");
+
+#################################################
+#No CHANGE callback => use discard_a/b instead
+@a = <a b c>;
+@b = <a x c>;
+$r = "";
+traverse_balanced( @a, @b,
+ MATCH => sub { $r ~= "M " ~@_;},
+ DISCARD_A => sub { $r ~= "DA " ~@_;},
+ DISCARD_B => sub { $r ~= "DB " ~@_;},
+ );
+ok($r eq "M 0 0DA 1 1DB 2 1M 2 2");
+
+#################################################
+@a = <a x y c>;
+@b = <a v w c>;
+$r = "";
+traverse_balanced( @a, @b,
+ MATCH => sub { $r ~= "M " ~@_;},
+ DISCARD_A => sub { $r ~= "DA " ~@_;},
+ DISCARD_B => sub { $r ~= "DB " ~@_;},
+ CHANGE => sub { $r ~= "C " ~@_;},
+ );
+ok($r eq "M 0 0C 1 1C 2 2M 3 3");
+
+#################################################
+@a = <x y c>;
+@b = <v w c>;
+$r = "";
+traverse_balanced( @a, @b,
+ MATCH => sub { $r ~= "M " ~@_;},
+ DISCARD_A => sub { $r ~= "DA " ~@_;},
+ DISCARD_B => sub { $r ~= "DB " ~@_;},
+ CHANGE => sub { $r ~= "C " ~@_;},
+ );
+ok($r eq "C 0 0C 1 1M 2 2");
+
+#################################################
+@a = <a x y z>;
+@b = <b v w>;
+$r = "";
+traverse_balanced( @a, @b,
+ MATCH => sub { $r ~= "M " ~@_;},
+ DISCARD_A => sub { $r ~= "DA " ~@_;},
+ DISCARD_B => sub { $r ~= "DB " ~@_;},
+ CHANGE => sub { $r ~= "C " ~@_;},
+ );
+ok($r eq "C 0 0C 1 1C 2 2DA 3 3");
+
+#################################################
+@a = <a z>;
+@b = <a>;
+$r = "";
+traverse_balanced( @a, @b,
+ MATCH => sub { $r ~= "M " ~@_;},
+ DISCARD_A => sub { $r ~= "DA " ~@_;},
+ DISCARD_B => sub { $r ~= "DB " ~@_;},
+ CHANGE => sub { $r ~= "C " ~@_;},
+ );
+ok($r eq "M 0 0DA 1 1");
+
+#################################################
+@a = <z a>;
+@b = <a>;
+$r = "";
+traverse_balanced( @a, @b,
+ MATCH => sub { $r ~= "M " ~@_;},
+ DISCARD_A => sub { $r ~= "DA " ~@_;},
+ DISCARD_B => sub { $r ~= "DB " ~@_;},
+ CHANGE => sub { $r ~= "C " ~@_;},
+ );
+ok($r eq "DA 0 0M 1 0");
+
+#################################################
+@a = <a b c>;
+@b = <x y z>;
+$r = "";
+traverse_balanced( @a, @b,
+ MATCH => sub { $r ~= "M " ~@_;},
+ DISCARD_A => sub { $r ~= "DA " ~@_;},
+ DISCARD_B => sub { $r ~= "DB " ~@_;},
+ CHANGE => sub { $r ~= "C " ~@_;},
+ );
+ ok($r eq "C 0 0C 1 1C 2 2");
222 t/oo.t
@@ -0,0 +1,222 @@
+use v6;
+use Test;
+plan 0;
+#plan 969;
+BEGIN
+{
+ @*INC.push('lib');
+ @*INC.push('blib');
+}
+
+# # Before `make install' is performed this script should be runnable with
+# # `make test'. After `make install' it should work as `perl oo.t'
+# use strict;
+# BEGIN { $^W++; }
+# use lib qw( blib lib );
+# use Algorithm::Diff qw( compact_diff );
+# use Data::Dumper;
+# use Test qw( plan ok $ntest );
+
+# BEGIN
+# {
+# $|++;
+
+# $SIG{__DIE__} = sub # breakpoint on die
+# {
+# $DB::single = 1
+# if ! $^S;
+# die @_;
+# };
+# $SIG{__WARN__} = sub # breakpoint on warn
+# {
+# $DB::single = 1;
+# warn @_;
+# };
+# }
+
+# sub Ok($$) { @_= reverse @_; goto &ok }
+
+# my( $first, $a, $b, $hunks );
+# for my $pair (
+# [ "a b c e h j l m n p",
+# " b c d e f j k l m r s t", 9 ],
+# [ "", "", 0 ],
+# [ "a b c", "", 1 ],
+# [ "", "a b c d", 1 ],
+# [ "a b", "x y z", 1 ],
+# [ " c e h j l m n p r",
+# "a b c d f g j k l m s t", 7 ],
+# [ "a b c d",
+# "a b c d", 1 ],
+# [ "a d",
+# "a b c d", 3 ],
+# [ "a b c d",
+# "a d", 3 ],
+# [ "a b c d",
+# " b c ", 3 ],
+# [ " b c ",
+# "a b c d", 3 ],
+# ) {
+# $first= $ntest;
+# ( $a, $b, $hunks )= @$pair;
+# my @a = split ' ', $a;
+# my @b = split ' ', $b;
+
+# my $d = Algorithm::Diff->new( \@a, \@b );
+
+# if( @ARGV ) {
+# print "1: $a$/2: $b$/";
+# while( $d->Next() ) {
+# printf "%10s %s %s$/",
+# join(' ',$d->Items(1)),
+# $d->Same() ? '=' : '|',
+# join(' ',$d->Items(2));
+# }
+# }
+
+# Ok( 0, $d->Base() );
+# Ok( 0, $d->Base(undef) );
+# Ok( 0, $d->Base(1) );
+# Ok( 1, $d->Base(undef) );
+# Ok( 1, $d->Base(0) );
+
+# ok( ! eval { $d->Diff(); 1 } );
+# ok( $@, qr/\breset\b/i );
+# ok( ! eval { $d->Same(); 1 } );
+# ok( $@, qr/\breset\b/i );
+# ok( ! eval { $d->Items(1); 1 } );
+# ok( $@, qr/\breset\b/i );
+# ok( ! eval { $d->Range(2); 1 } );
+# ok( $@, qr/\breset\b/i );
+# ok( ! eval { $d->Min(1); 1 } );
+# ok( $@, qr/\breset\b/i );
+# ok( ! eval { $d->Max(2); 1 } );
+# ok( $@, qr/\breset\b/i );
+# ok( ! eval { $d->Get('Min1'); 1 } );
+# ok( $@, qr/\breset\b/i );
+
+# ok( ! $d->Next(0) );
+# ok( ! eval { $d->Same(); 1 } );
+# ok( $@, qr/\breset\b/i );
+# Ok( 1, $d->Next() ) if 0 < $hunks;
+# Ok( 2, $d->Next(undef) ) if 1 < $hunks;
+# Ok( 3, $d->Next(1) ) if 2 < $hunks;
+# Ok( 2, $d->Next(-1) ) if 1 < $hunks;
+# ok( ! $d->Next(-2) );
+# ok( ! eval { $d->Same(); 1 } );
+# ok( $@, qr/\breset\b/i );
+
+# ok( ! $d->Prev(0) );
+# ok( ! eval { $d->Same(); 1 } );
+# ok( $@, qr/\breset\b/i );
+# Ok( -1, $d->Prev() ) if 0 < $hunks;
+# Ok( -2, $d->Prev(undef) ) if 1 < $hunks;
+# Ok( -3, $d->Prev(1) ) if 2 < $hunks;
+# Ok( -2, $d->Prev(-1) ) if 1 < $hunks;
+# ok( ! $d->Prev(-2) );
+
+# Ok( 1, $d->Next() ) if 0 < $hunks;
+# ok( ! $d->Prev() );
+# Ok( 1, $d->Next() ) if 0 < $hunks;
+# ok( ! $d->Prev(2) );
+# Ok( -1, $d->Prev() ) if 0 < $hunks;
+# ok( ! $d->Next() );
+# Ok( -1, $d->Prev() ) if 0 < $hunks;
+# ok( ! $d->Next(5) );
+
+# Ok( 1, $d->Next() ) if 0 < $hunks;
+# Ok( $d, $d->Reset() );
+# ok( ! $d->Prev(0) );
+# Ok( 3, $d->Reset(3)->Next(0) ) if 2 < $hunks;
+# Ok( -3, $d->Reset(-2)->Prev() ) if 2 < $hunks;
+# Ok( $hunks || !1, $d->Reset(0)->Next(-1) );
+
+# my $c = $d->Copy();
+# ok( $c->Base(), $d->Base() );
+# ok( $c->Next(0), $d->Next(0) );
+# ok( $d->Copy(-4)->Next(0),
+# $d->Copy()->Reset(-4)->Next(0) );
+
+# $c = $d->Copy( undef, 1 );
+# Ok( 1, $c->Base() );
+# ok( $c->Next(0), $d->Next(0) );
+
+# $d->Reset();
+# my( @A, @B );
+# while( $d->Next() ) {
+# if( $d->Same() ) {
+# Ok( 0, $d->Diff() );
+# ok( $d->Same(), $d->Range(2) );
+# ok( $d->Items(2), $d->Range(1) );
+# ok( "@{[$d->Same()]}",
+# "@{[$d->Items(1)]}" );
+# ok( "@{[$d->Items(1)]}",
+# "@{[$d->Items(2)]}" );
+# ok( "@{[$d->Items(2)]}",
+# "@a[$d->Range(1)]" );
+# ok( "@a[$d->Range(1,0)]",
+# "@b[$d->Range(2)]" );
+# push @A, $d->Same();
+# push @B, @b[$d->Range(2)];
+# } else {
+# Ok( 0, $d->Same() );
+# ok( $d->Diff() & 1, 1*!!$d->Range(1) );
+# ok( $d->Diff() & 2, 2*!!$d->Range(2) );
+# ok( "@{[$d->Items(1)]}",
+# "@a[$d->Range(1)]" );
+# ok( "@{[$d->Items(2)]}",
+# "@b[$d->Range(2,0)]" );
+# push @A, @a[$d->Range(1)];
+# push @B, $d->Items(2);
+# }
+# }
+# ok( "@A", "@a" );
+# ok( "@B", "@b" );
+
+# next if ! $hunks;
+
+# Ok( 1, $d->Next() );
+# { local $^W= 0;
+# ok( ! eval { $d->Items(); 1 } ); }
+# ok( ! eval { $d->Items(0); 1 } );
+# { local $^W= 0;
+# ok( ! eval { $d->Range(); 1 } ); }
+# ok( ! eval { $d->Range(3); 1 } );
+# { local $^W= 0;
+# ok( ! eval { $d->Min(); 1 } ); }
+# ok( ! eval { $d->Min(-1); 1 } );
+# { local $^W= 0;
+# ok( ! eval { $d->Max(); 1 } ); }
+# ok( ! eval { $d->Max(9); 1 } );
+
+# $d->Reset(-1);
+# $c= $d->Copy(undef,1);
+# ok( "@a[$d->Range(1)]",
+# "@{[(0,@a)[$c->Range(1)]]}" );
+# ok( "@b[$c->Range(2,0)]",
+# "@{[(0,@b)[$d->Range(2,1)]]}" );
+# ok( "@a[$d->Get('min1')..$d->Get('0Max1')]",
+# "@{[(0,@a)[$d->Get('1MIN1')..$c->Get('MAX1')]]}" );
+
+# ok( "@{[$c->Min(1),$c->Max(2,0)]}",
+# "@{[$c->Get('Min1','0Max2')]}" );
+# ok( ! eval { scalar $c->Get('Min1','0Max2'); 1 } );
+# ok( "@{[0+$d->Same(),$d->Diff(),$d->Base()]}",
+# "@{[$d->Get(qq<same Diff BASE>)]}" );
+# ok( "@{[0+$d->Range(1),0+$d->Range(2)]}",
+# "@{[$d->Get(qq<Range1 rAnGe2>)]}" );
+# { local $^W= 0;
+# ok( ! eval { $c->Get('range'); 1 } );
+# ok( ! eval { $c->Get('min'); 1 } );
+# ok( ! eval { $c->Get('max'); 1 } ); }
+
+# } continue {
+# if( @ARGV ) {
+# my $tests= $ntest - $first;
+# print "$hunks hunks, $tests tests.$/";
+# }
+# }
+
+# # $d = Algorithm::Diff->new( \@a, \@b, {KeyGen=>sub...} );
+
+# # @cdiffs = compact_diff( \@seq1, \@seq2 );
Please sign in to comment.
Something went wrong with that request. Please try again.