X-Git-Url: https://defaria.com/gitweb/?a=blobdiff_plain;f=clients%2FLynuxWorks%2Flib%2FDiff.pm;fp=clients%2FLynuxWorks%2Flib%2FDiff.pm;h=98b76110c19d8c41bbb9b4ae2a7ed5af914aa28b;hb=a8c84d2892f07a6863b68a11eb0a4a79ffd71fb5;hp=0000000000000000000000000000000000000000;hpb=95384f94f88aceeb5eef2d322210ba4a438b6512;p=clearscm.git

diff --git a/clients/LynuxWorks/lib/Diff.pm b/clients/LynuxWorks/lib/Diff.pm
new file mode 100644
index 0000000..98b7611
--- /dev/null
+++ b/clients/LynuxWorks/lib/Diff.pm
@@ -0,0 +1,584 @@
+package Diff;
+use strict;
+use vars qw($VERSION @EXPORT_OK @ISA @EXPORT);
+use integer;		# see below in _replaceNextLargerWith() for mod to make
+					# if you don't use this
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw();
+@EXPORT_OK = qw(LCS diff traverse_sequences);
+$VERSION = sprintf('%d.%02d', (q$Revision: 1.10 $ =~ /\d+/g));
+
+# McIlroy-Hunt diff algorithm
+# Adapted from the Smalltalk code of Mario I. Wolczko, <mario@wolczko.com>
+# by Ned Konz, perl@bike-nomad.com
+
+=head1 NAME
+
+Algorithm::Diff - Compute `intelligent' differences between two files / lists
+
+=head1 SYNOPSIS
+
+  use Algorithm::Diff qw(diff LCS traverse_sequences);
+
+  @lcs    = LCS( \@seq1, \@seq2 );
+
+  @lcs    = LCS( \@seq1, \@seq2, $key_generation_function );
+
+  $lcsref = LCS( \@seq1, \@seq2 );
+
+  $lcsref = LCS( \@seq1, \@seq2, $key_generation_function );
+
+  @diffs = diff( \@seq1, \@seq2 );
+
+  @diffs = diff( \@seq1, \@seq2, $key_generation_function );
+  
+  traverse_sequences( \@seq1, \@seq2,
+                     { MATCH => $callback,
+                       DISCARD_A => $callback,
+                       DISCARD_B => $callback,
+                     } );
+
+  traverse_sequences( \@seq1, \@seq2,
+                     { MATCH => $callback,
+                       DISCARD_A => $callback,
+                       DISCARD_B => $callback,
+                     },
+                     $key_generation_function );
+
+=head1 INTRODUCTION
+
+(by Mark-Jason Dominus)
+
+I once read an article written by the authors of C<diff>; they said
+that they hard 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
+
+=head1 USAGE
+
+This module provides three exportable functions, which we'll deal with in
+ascending order of difficulty: C<LCS>, C<diff>, and
+C<traverse_sequences>.
+
+=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 );
+  $lcsref = LCS( \@seq1, \@seq2, $keyGen );
+
+Additional parameters, if any, will be passed to the key generation
+routine.
+
+=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.  The return value of C<diff> is a list of
+hunks, or, in scalar context, a reference to such a list.
+
+Here is an example:  The diff 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
+
+Result:
+
+ [ 
+   [ [ '-', 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.  The other two hunks similarly. 
+
+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<traverse_sequences>
+
+C<traverse_sequences> is the most general facility provided by this
+module; C<diff> and C<LCS> are implemented as calls to it.
+
+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 callback which specifies the callback functions, like
+this:
+
+  traverse_sequences( \@seq1, \@seq2,
+                     { MATCH => $callback_1,
+                       DISCARD_A => $callback_2,
+                       DISCARD_B => $callback_3,
+                     } );
+
+Callbacks 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.
+
+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.
+
+=head1 KEY GENERATION FUNCTIONS
+
+C<diff>, C<LCS>, and C<traverse_sequences> accept an optional last 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 AUTHOR
+
+This version by Ned Konz, perl@bike-nomad.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 the documentation and names of the routines
+from Mark-Jason's, but has all new code in Diff.pm.
+
+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
+
+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.
+
+=cut
+
+# 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
+{
+	my $aCollection = shift;	# array ref
+	my $start = shift;
+	my $end = shift;
+	my $keyGen = shift;
+	my %d;
+	my $index;
+	for ( $index = $start; $index <= $end; $index++ )
+	{
+		my $element = $aCollection->[ $index ];
+		my $key = &$keyGen( $element, @_ );
+		if ( exists( $d{ $key } ) )
+		{
+			push( @{ $d{ $key } }, $index );
+		}
+		else
+		{
+			$d{ $key } = [ $index ];
+		}
+	}
+	return wantarray ? %d: \%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
+{
+	my ( $array, $aValue, $high ) = @_;
+	$high ||= $#$array;
+
+	# off the end?
+	if ( $high == -1 || $aValue > $array->[ -1 ] )
+	{
+		push( @$array, $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 undef;
+		}
+		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..scalar( @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
+{
+	my $a = shift;	# array ref
+	my $b = shift;	# array ref
+	my $keyGen = shift;	# code ref
+	my $compare;	# code ref
+
+	# set up code refs
+	# Note that these are optimized.
+	if ( !defined( $keyGen ) )	# optimize for strings
+	{
+		$keyGen = sub { $_[0] };
+		$compare = sub { my ($a, $b) = @_; $a eq $b };
+	}
+	else
+	{
+		$compare = sub {
+			my $a = shift; my $b = shift;
+			&$keyGen( $a, @_ ) eq &$keyGen( $b, @_ )
+		};
+	}
+
+	my ($aStart, $aFinish, $bStart, $bFinish, $matchVector) = (0, $#$a, 0, $#$b, []);
+
+	# 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++;
+	}
+
+	# now the end
+	while ( $aStart <= $aFinish
+		and $bStart <= $bFinish
+		and &$compare( $a->[ $aFinish ], $b->[ $bFinish ], @_ ) )
+	{
+		$matchVector->[ $aFinish-- ] = $bFinish--;
+	}
+
+	# Now compute the equivalence classes of positions of elements
+	my $bMatches = _withPositionsOfInInterval( $b, $bStart, $bFinish, $keyGen, @_ );
+	my $thresh = [];
+	my $links = [];
+
+	my ( $i, $ai, $j, $k );
+	for ( $i = $aStart; $i <= $aFinish; $i++ )
+	{
+		$ai = &$keyGen( $a->[ $i ] );
+		if ( exists( $bMatches->{ $ai } ) )
+		{
+			$k = 0;
+			for $j ( reverse( @{ $bMatches->{ $ai } } ) )
+			{
+				# 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 ( defined( $k ) )
+				{
+					$links->[ $k ] = 
+						[ ( $k ? $links->[ $k - 1 ] : undef ), $i, $j ];
+				}
+			}
+		}
+	}
+
+	if ( @$thresh )
+	{
+		for ( my $link = $links->[ $#$thresh ]; $link; $link = $link->[ 0 ] )
+		{
+			$matchVector->[ $link->[ 1 ] ] = $link->[ 2 ];
+		}
+	}
+
+	return wantarray ? @$matchVector : $matchVector;
+}
+
+sub traverse_sequences
+{
+	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 $discardBCallback = $callbacks->{'DISCARD_B'} || sub { };
+	my $matchVector = _longestCommonSubsequence( $a, $b, $keyGen, @_ );
+	# Process all the lines in match vector
+	my $lastA = $#$a;
+	my $lastB = $#$b;
+	my $bi = 0;
+	my $ai;
+	for ( $ai = 0; $ai <= $#$matchVector; $ai++ )
+	{
+		my $bLine = $matchVector->[ $ai ];
+		if ( defined( $bLine ) )
+		{
+			&$discardBCallback( $ai, $bi++, @_ ) while $bi < $bLine;
+			&$matchCallback( $ai, $bi++, @_ );
+		}
+		else
+		{
+			&$discardACallback( $ai, $bi, @_ );
+		}
+	}
+
+	&$discardACallback( $ai++, $bi, @_ ) while ( $ai <= $lastA );
+	&$discardBCallback( $ai, $bi++, @_ ) while ( $bi <= $lastB );
+	return 1;
+}
+
+sub LCS
+{
+	my $a = shift;	# array ref
+	my $matchVector = _longestCommonSubsequence( $a, @_ );
+	my @retval;
+	my $i;
+	for ( $i = 0; $i <= $#$matchVector; $i++ )
+	{
+		if ( defined( $matchVector->[ $i ] ) )
+		{
+			push( @retval, $a->[ $i ] );
+		}
+	}
+	return wantarray ? @retval : \@retval;
+}
+
+sub diff
+{
+	my $a = shift;	# array ref
+	my $b = shift;	# array ref
+	my $retval = [];
+	my $hunk = [];
+	my $discard = sub { push( @$hunk, [ '-', $_[ 0 ], $a->[ $_[ 0 ] ] ] ) };
+	my $add = sub { push( @$hunk, [ '+', $_[ 1 ], $b->[ $_[ 1 ] ] ] ) };
+	my $match = sub { push( @$retval, $hunk ) if scalar(@$hunk); $hunk = [] };
+	traverse_sequences( $a, $b,
+		{ MATCH => $match, DISCARD_A => $discard, DISCARD_B => $add },
+		@_ );
+	&$match();
+	return wantarray ? @$retval : $retval;
+}
+
+1;