move tlperl.straw to tlperl

git-svn-id: svn://tug.org/texlive/trunk@18210 c570f23f-e606-0410-a88d-b1316a301751

6 files changed, 3078 insertions, 0 deletions

diff --git a/Master/tlpkg/tlperl/lib/Algorithm/Diff.pm b/Master/tlpkg/tlperl/lib/Algorithm/Diff.pm
new file mode 100755
index 00000000000..c3ceeade42e
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Algorithm/Diff.pm
@@ -0,0 +1,1713 @@
+package Algorithm::Diff;
+# Skip to first "=head" line for documentation.
+use strict;
+
+use integer;    # see below in _replaceNextLargerWith() for mod to make
+                # if you don't use this
+use vars qw( $VERSION @EXPORT_OK );
+$VERSION = 1.19_02;
+#          ^ ^^ ^^-- Incremented at will
+#          | \+----- Incremented for non-trivial changes to features
+#          \-------- Incremented for fundamental changes
+require Exporter;
+*import    = \&Exporter::import;
+@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
+{
+    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} ) )
+        {
+            unshift ( @{ $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 .. $#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 or hash ref
+    my $b        = shift;    # array ref or hash ref
+    my $counting = shift;    # scalar
+    my $keyGen   = shift;    # code ref
+    my $compare;             # code ref
+
+    if ( ref($a) eq 'HASH' )
+    {                        # prepared hash must be in $b
+        my $tmp = $b;
+        $b = $a;
+        $a = $tmp;
+    }
+
+    # Check for bogus (non-ref) argument values
+    if ( !ref($a) || !ref($b) )
+    {
+        my @callerInfo = caller(1);
+        die 'error: must pass array or hash references to ' . $callerInfo[3];
+    }
+
+    # 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, $matchVector ) = ( 0, $#$a, [] );
+    my ( $prunedCount, $bMatches ) = ( 0, {} );
+
+    if ( ref($b) eq 'HASH' )    # was $bMatches prepared for us?
+    {
+        $bMatches = $b;
+    }
+    else
+    {
+        my ( $bStart, $bFinish ) = ( 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++;
+            $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 );
+    for ( $i = $aStart ; $i <= $aFinish ; $i++ )
+    {
+        $ai = &$keyGen( $a->[$i], @_ );
+        if ( exists( $bMatches->{$ai} ) )
+        {
+            $k = 0;
+            for $j ( @{ $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)
+    {
+        return $prunedCount + @$thresh if $counting;
+        for ( my $link = $links->[$#$thresh] ; $link ; $link = $link->[0] )
+        {
+            $matchVector->[ $link->[1] ] = $link->[2];
+        }
+    }
+    elsif ($counting)
+    {
+        return $prunedCount;
+    }
+
+    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 $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;
+    my $lastB = $#$b;
+    my $bi    = 0;
+    my $ai;
+
+    for ( $ai = 0 ; $ai <= $#$matchVector ; $ai++ )
+    {
+        my $bLine = $matchVector->[$ai];
+        if ( defined($bLine) )    # matched
+        {
+            &$discardBCallback( $ai, $bi++, @_ ) while $bi < $bLine;
+            &$matchCallback( $ai,    $bi++, @_ );
+        }
+        else
+        {
+            &$discardACallback( $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 ( defined($finishedACallback) )
+            {
+                &$finishedACallback( $lastA, @_ );
+                $finishedACallback = undef;
+            }
+            else
+            {
+                &$discardBCallback( $ai, $bi++, @_ ) while $bi <= $lastB;
+            }
+        }
+
+        # last B?
+        if ( $bi == $lastB + 1 and $ai <= $lastA )
+        {
+            if ( defined($finishedBCallback) )
+            {
+                &$finishedBCallback( $lastB, @_ );
+                $finishedBCallback = undef;
+            }
+            else
+            {
+                &$discardACallback( $ai++, $bi, @_ ) while $ai <= $lastA;
+            }
+        }
+
+        &$discardACallback( $ai++, $bi, @_ ) if $ai <= $lastA;
+        &$discardBCallback( $ai, $bi++, @_ ) if $bi <= $lastB;
+    }
+
+    return 1;
+}
+
+sub traverse_balanced
+{
+    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 $changeCallback    = $callbacks->{'CHANGE'};
+    my $matchVector = _longestCommonSubsequence( $a, $b, 0, $keyGen, @_ );
+
+    # Process all the lines in match vector
+    my $lastA = $#$a;
+    my $lastB = $#$b;
+    my $bi    = 0;
+    my $ai    = 0;
+    my $ma    = -1;
+    my $mb;
+
+    while (1)
+    {
+
+        # Find next match indices $ma and $mb
+        do {
+            $ma++;
+        } while(
+                $ma <= $#$matchVector
+            &&  !defined $matchVector->[$ma]
+        );
+
+        last if $ma > $#$matchVector;    # 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 ( defined $changeCallback )
+                {
+                    &$changeCallback( $ai++, $bi++, @_ );
+                }
+                else
+                {
+                    &$discardACallback( $ai++, $bi, @_ );
+                    &$discardBCallback( $ai, $bi++, @_ );
+                }
+            }
+            elsif ( $ai < $ma )
+            {
+                &$discardACallback( $ai++, $bi, @_ );
+            }
+            else
+            {
+
+                # $bi < $mb
+                &$discardBCallback( $ai, $bi++, @_ );
+            }
+        }
+
+        # Match
+        &$matchCallback( $ai++, $bi++, @_ );
+    }
+
+    while ( $ai <= $lastA || $bi <= $lastB )
+    {
+        if ( $ai <= $lastA && $bi <= $lastB )
+        {
+
+            # Change
+            if ( defined $changeCallback )
+            {
+                &$changeCallback( $ai++, $bi++, @_ );
+            }
+            else
+            {
+                &$discardACallback( $ai++, $bi, @_ );
+                &$discardBCallback( $ai, $bi++, @_ );
+            }
+        }
+        elsif ( $ai <= $lastA )
+        {
+            &$discardACallback( $ai++, $bi, @_ );
+        }
+        else
+        {
+
+            # $bi <= $lastB
+            &$discardBCallback( $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
+{
+    my $a = shift;                  # array ref
+    my $b = shift;                  # array ref or hash ref
+    my $matchVector = _longestCommonSubsequence( $a, $b, 0, @_ );
+    my @retval;
+    my $i;
+    for ( $i = 0 ; $i <= $#$matchVector ; $i++ )
+    {
+        if ( defined( $matchVector->[$i] ) )
+        {
+            push ( @retval, $a->[$i] );
+        }
+    }
+    return wantarray ? @retval : \@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
+{
+    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 0 < @$hunk;
+        $hunk = []
+    };
+    traverse_sequences( $a, $b,
+        { MATCH => $match, DISCARD_A => $discard, DISCARD_B => $add }, @_ );
+    &$match();
+    return wantarray ? @$retval : $retval;
+}
+
+sub sdiff
+{
+    my $a      = shift;    # array ref
+    my $b      = shift;    # array ref
+    my $retval = [];
+    my $discard = sub { push ( @$retval, [ '-', $a->[ $_[0] ], "" ] ) };
+    my $add = sub { push ( @$retval, [ '+', "", $b->[ $_[1] ] ] ) };
+    my $change = sub {
+        push ( @$retval, [ 'c', $a->[ $_[0] ], $b->[ $_[1] ] ] );
+    };
+    my $match = sub {
+        push ( @$retval, [ 'u', $a->[ $_[0] ], $b->[ $_[1] ] ] );
+    };
+    traverse_balanced(
+        $a,
+        $b,
+        {
+            MATCH     => $match,
+            DISCARD_A => $discard,
+            DISCARD_B => $add,
+            CHANGE    => $change,
+        },
+        @_
+    );
+    return wantarray ? @$retval : $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 is 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
diff --git a/Master/tlpkg/tlperl/lib/Algorithm/DiffOld.pm b/Master/tlpkg/tlperl/lib/Algorithm/DiffOld.pm
new file mode 100755
index 00000000000..511741ae352
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Algorithm/DiffOld.pm
@@ -0,0 +1,305 @@
+# This is a version of Algorithm::Diff that uses only a comparison function,
+# like versions <= 0.59 used to.
+# $Revision: 1.3 $
+
+package Algorithm::DiffOld;
+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 = 1.10;	# manually tracking Algorithm::Diff
+
+# 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::DiffOld - Compute `intelligent' differences between two files / lists
+but use the old (<=0.59) interface.
+
+=head1 NOTE
+
+This has been provided as part of the Algorithm::Diff package by Ned Konz.
+This particular module is B<ONLY> for people who B<HAVE> to have the old
+interface, which uses a comparison function rather than a key generating
+function.
+
+Because each of the lines in one array have to be compared with each 
+of the lines in the other array, this does M*N comparisions. This can
+be very slow. I clocked it at taking 18 times as long as the stock
+version of Algorithm::Diff for a 4000-line file. It will get worse
+quadratically as array sizes increase.
+
+=head1 SYNOPSIS
+
+  use Algorithm::DiffOld qw(diff LCS traverse_sequences);
+
+  @lcs    = LCS( \@seq1, \@seq2, $comparison_function );
+
+  $lcsref = LCS( \@seq1, \@seq2, $comparison_function );
+
+  @diffs = diff( \@seq1, \@seq2, $comparison_function );
+  
+  traverse_sequences( \@seq1, \@seq2,
+                     { MATCH => $callback,
+                       DISCARD_A => $callback,
+                       DISCARD_B => $callback,
+                     },
+                     $comparison_function );
+
+=head1 COMPARISON FUNCTIONS
+
+Each of the main routines should be passed a comparison function. If you
+aren't passing one in, B<use Algorithm::Diff instead>.
+
+These functions should return a true value when two items should compare
+as equal.
+
+For instance,
+
+  @lcs    = LCS( \@seq1, \@seq2, sub { my ($a, $b) = @_; $a eq $b } );
+
+but if that is all you're doing with your comparison function, just use
+Algorithm::Diff and let it do this (this is its default).
+
+Or:
+
+  sub someFunkyComparisonFunction
+  {
+  	my ($a, $b) = @_;
+	$a =~ m{$b};
+  }
+
+  @diffs = diff( \@lines, \@patterns, \&someFunkyComparisonFunction );
+
+which would allow you to diff an array @lines which consists of text
+lines with an array @patterns which consists of regular expressions.
+
+This is actually the reason I wrote this version -- there is no way
+to do this with a key generation function as in the stock Algorithm::Diff.
+
+=cut
+
+# 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 .. $#result ) if $result[ $i ] is defined.
+
+# An additional argument may be passed; this is a CODE ref to a comparison
+# routine. By default, comparisons will use "eq" .
+# Note that this routine will be called as many as M*N times, so make it fast!
+
+# 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 $compare = shift || sub { my $a = shift; my $b = shift; $a eq $b };
+
+	my $aStart = 0;
+	my $aFinish = $#$a;
+	my $bStart = 0;
+	my $bFinish = $#$b;
+	my $matchVector = [];
+
+	# 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--;
+	}
+
+	my $thresh = [];
+	my $links = [];
+
+	my ( $i, $ai, $j, $k );
+	for ( $i = $aStart; $i <= $aFinish; $i++ )
+	{
+		$k = 0;
+		# look for each element of @b between $bStart and $bFinish
+		# that matches $a->[ $i ], in reverse order
+		for ($j = $bFinish; $j >= $bStart; $j--)
+		{
+			next if ! &$compare( $a->[$i], $b->[$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 ( 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 $compare = 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, $compare, @_ );
+	# 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 ) )	# matched
+		{
+			&$discardBCallback( $ai, $bi++, @_ ) while $bi < $bLine;
+			&$matchCallback( $ai, $bi++, @_ );
+		}
+		else
+		{
+			&$discardACallback( $ai, $bi, @_ );
+		}
+	}
+	# the last entry (if any) processed was a match.
+
+	if ( defined( $finishedBCallback ) && $ai <= $lastA )
+	{
+		&$finishedBCallback( $bi, @_ );
+	}
+	else
+	{
+		&$discardACallback( $ai++, $bi, @_ ) while ( $ai <= $lastA );
+	}
+
+	if ( defined( $finishedACallback ) && $bi <= $lastB )
+	{
+		&$finishedACallback( $ai, @_ );
+	}
+	else
+	{
+		&$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;
diff --git a/Master/tlpkg/tlperl/lib/Algorithm/cdiff.pl b/Master/tlpkg/tlperl/lib/Algorithm/cdiff.pl
new file mode 100755
index 00000000000..7c9140ba12f
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Algorithm/cdiff.pl
@@ -0,0 +1,385 @@
+#!/usr/bin/perl -w
+#
+# `Diff' program in Perl
+# Copyright 1998 M-J. Dominus. (mjd-perl-diff@plover.com)
+#
+# This program is free software; you can redistribute it and/or modify it
+# under the same terms as Perl itself.
+#
+# Altered to output in `context diff' format (but without context)
+# September 1998 Christian Murphy (cpm@muc.de)
+#
+# Command-line arguments and context lines feature added
+# September 1998 Amir D. Karger (karger@bead.aecom.yu.edu)
+#
+# In this file, "item" usually means "line of text", and "item number" usually
+# means "line number". But theoretically the code could be used more generally
+use strict;
+
+use Algorithm::Diff qw(diff);
+use File::stat;
+use vars qw ($opt_C $opt_c $opt_u $opt_U);
+use Getopt::Std;
+
+my $usage = << "ENDUSAGE";
+Usage: $0 [{-c | -u}] [{-C | -U} lines] oldfile newfile
+    -c will do a context diff with 3 lines of context
+    -C will do a context diff with 'lines' lines of context
+    -u will do a unified diff with 3 lines of context
+    -U will do a unified diff with 'lines' lines of context
+ENDUSAGE
+
+getopts('U:C:cu') or bag("$usage");
+bag("$usage") unless @ARGV == 2;
+my ($file1, $file2) = @ARGV;
+if (defined $opt_C || defined $opt_c) {
+    $opt_c = ""; # -c on if -C given on command line
+    $opt_u = undef;
+} elsif (defined $opt_U || defined $opt_u) {
+    $opt_u = ""; # -u on if -U given on command line
+    $opt_c = undef;
+} else {
+    $opt_c = ""; # by default, do context diff, not old diff
+}
+
+my ($char1, $char2); # string to print before file names
+my $Context_Lines; # lines of context to print
+if (defined $opt_c) {
+    $Context_Lines = defined $opt_C ? $opt_C : 3;
+    $char1 = '*' x 3; $char2 = '-' x 3;
+} elsif (defined $opt_u) {
+    $Context_Lines = defined $opt_U ? $opt_U : 3;
+    $char1 = '-' x 3; $char2 = '+' x 3;
+}
+
+# After we've read up to a certain point in each file, the number of items
+# we've read from each file will differ by $FLD (could be 0)
+my $File_Length_Difference = 0;
+
+open (F1, $file1) or bag("Couldn't open $file1: $!");
+open (F2, $file2) or bag("Couldn't open $file2: $!");
+my (@f1, @f2);
+chomp(@f1 = <F1>);
+close F1;
+chomp(@f2 = <F2>);
+close F2;
+
+# diff yields lots of pieces, each of which is basically a Block object
+my $diffs = diff(\@f1, \@f2);
+exit 0 unless @$diffs;
+
+my $st = stat($file1);
+print "$char1 $file1\t", scalar localtime($st->mtime), "\n";
+$st = stat($file2);
+print "$char2 $file2\t", scalar localtime($st->mtime), "\n";
+
+my ($hunk,$oldhunk);
+# Loop over hunks. If a hunk overlaps with the last hunk, join them.
+# Otherwise, print out the old one.
+foreach my $piece (@$diffs) {
+    $hunk = new Hunk ($piece, $Context_Lines);
+    next unless $oldhunk;
+
+    if ($hunk->does_overlap($oldhunk)) {
+	$hunk->prepend_hunk($oldhunk);
+    } else {
+	$oldhunk->output_diff(\@f1, \@f2);
+    }
+
+} continue {
+    $oldhunk = $hunk;
+}
+
+# print the last hunk
+$oldhunk->output_diff(\@f1, \@f2);
+exit 1;
+# END MAIN PROGRAM
+
+sub bag {
+  my $msg = shift;
+  $msg .= "\n";
+  warn $msg;
+  exit 2;
+}
+
+# Package Hunk. A Hunk is a group of Blocks which overlap because of the
+# context surrounding each block. (So if we're not using context, every
+# hunk will contain one block.)
+{
+package Hunk;
+
+sub new {
+# Arg1 is output from &LCS::diff (which corresponds to one Block)
+# Arg2 is the number of items (lines, e.g.,) of context around each block
+#
+# This subroutine changes $File_Length_Difference
+#
+# Fields in a Hunk:
+# blocks      - a list of Block objects
+# start       - index in file 1 where first block of the hunk starts
+# end         - index in file 1 where last block of the hunk ends
+#
+# Variables:
+# before_diff - how much longer file 2 is than file 1 due to all hunks
+#               until but NOT including this one
+# after_diff  - difference due to all hunks including this one
+    my ($class, $piece, $context_items) = @_;
+
+    my $block = new Block ($piece); # this modifies $FLD!
+
+    my $before_diff = $File_Length_Difference; # BEFORE this hunk
+    my $after_diff = $before_diff + $block->{"length_diff"};
+    $File_Length_Difference += $block->{"length_diff"};
+
+    # @remove_array and @insert_array hold the items to insert and remove
+    # Save the start & beginning of each array. If the array doesn't exist
+    # though (e.g., we're only adding items in this block), then figure
+    # out the line number based on the line number of the other file and
+    # the current difference in file lenghts
+    my @remove_array = $block->remove;
+    my @insert_array = $block->insert;
+    my ($a1, $a2, $b1, $b2, $start1, $start2, $end1, $end2);
+    $a1 = @remove_array ? $remove_array[0 ]->{"item_no"} : -1;
+    $a2 = @remove_array ? $remove_array[-1]->{"item_no"} : -1;
+    $b1 = @insert_array ? $insert_array[0 ]->{"item_no"} : -1;
+    $b2 = @insert_array ? $insert_array[-1]->{"item_no"} : -1;
+
+    $start1 = $a1 == -1 ? $b1 - $before_diff : $a1;
+    $end1   = $a2 == -1 ? $b2 - $after_diff  : $a2;
+    $start2 = $b1 == -1 ? $a1 + $before_diff : $b1;
+    $end2   = $b2 == -1 ? $a2 + $after_diff  : $b2;
+
+    # At first, a hunk will have just one Block in it
+    my $hunk = {
+	    "start1" => $start1,
+	    "start2" => $start2,
+	    "end1" => $end1,
+	    "end2" => $end2,
+	    "blocks" => [$block],
+              };
+    bless $hunk, $class;
+
+    $hunk->flag_context($context_items);
+
+    return $hunk;
+}
+
+# Change the "start" and "end" fields to note that context should be added
+# to this hunk
+sub flag_context {
+    my ($hunk, $context_items) = @_;
+    return unless $context_items; # no context
+
+    # add context before
+    my $start1 = $hunk->{"start1"};
+    my $num_added = $context_items > $start1 ? $start1 : $context_items;
+    $hunk->{"start1"} -= $num_added;
+    $hunk->{"start2"} -= $num_added;
+
+    # context after
+    my $end1 = $hunk->{"end1"};
+    $num_added = ($end1+$context_items > $#f1) ?
+                  $#f1 - $end1 :
+                  $context_items;
+    $hunk->{"end1"} += $num_added;
+    $hunk->{"end2"} += $num_added;
+}
+
+# Is there an overlap between hunk arg0 and old hunk arg1?
+# Note: if end of old hunk is one less than beginning of second, they overlap
+sub does_overlap {
+    my ($hunk, $oldhunk) = @_;
+    return "" unless $oldhunk; # first time through, $oldhunk is empty
+
+    # Do I actually need to test both?
+    return ($hunk->{"start1"} - $oldhunk->{"end1"} <= 1 ||
+            $hunk->{"start2"} - $oldhunk->{"end2"} <= 1);
+}
+
+# Prepend hunk arg1 to hunk arg0
+# Note that arg1 isn't updated! Only arg0 is.
+sub prepend_hunk {
+    my ($hunk, $oldhunk) = @_;
+
+    $hunk->{"start1"} = $oldhunk->{"start1"};
+    $hunk->{"start2"} = $oldhunk->{"start2"};
+
+    unshift (@{$hunk->{"blocks"}}, @{$oldhunk->{"blocks"}});
+}
+
+
+# DIFF OUTPUT ROUTINES. THESE ROUTINES CONTAIN DIFF FORMATTING INFO...
+sub output_diff {
+    if    (defined $main::opt_u) {&output_unified_diff(@_)}
+    elsif (defined $main::opt_c) {&output_context_diff(@_)}
+    else {die "unknown diff"}
+}
+
+sub output_unified_diff {
+    my ($hunk, $fileref1, $fileref2) = @_;
+    my @blocklist;
+
+    # Calculate item number range.
+    my $range1 = $hunk->unified_range(1);
+    my $range2 = $hunk->unified_range(2);
+    print "@@ -$range1 +$range2 @@\n";
+
+    # Outlist starts containing the hunk of file 1.
+    # Removing an item just means putting a '-' in front of it.
+    # Inserting an item requires getting it from file2 and splicing it in.
+    #    We splice in $num_added items. Remove blocks use $num_added because
+    # splicing changed the length of outlist.
+    #    We remove $num_removed items. Insert blocks use $num_removed because
+    # their item numbers---corresponding to positions in file *2*--- don't take
+    # removed items into account.
+    my $low = $hunk->{"start1"};
+    my $hi = $hunk->{"end1"};
+    my ($num_added, $num_removed) = (0,0);
+    my @outlist = @$fileref1[$low..$hi];
+    map {s/^/ /} @outlist; # assume it's just context
+
+    foreach my $block (@{$hunk->{"blocks"}}) {
+	foreach my $item ($block->remove) {
+	    my $op = $item->{"sign"}; # -
+	    my $offset = $item->{"item_no"} - $low + $num_added;
+	    $outlist[$offset] =~ s/^ /$op/;
+	    $num_removed++;
+	}
+	foreach my $item ($block->insert) {
+	    my $op = $item->{"sign"}; # +
+	    my $i = $item->{"item_no"};
+	    my $offset = $i - $hunk->{"start2"} + $num_removed;
+	    splice(@outlist,$offset,0,"$op$$fileref2[$i]");
+	    $num_added++;
+	}
+    }
+
+    map {s/$/\n/} @outlist; # add \n's
+    print @outlist;
+
+}
+
+sub output_context_diff {
+    my ($hunk, $fileref1, $fileref2) = @_;
+    my @blocklist;
+
+    print "***************\n";
+    # Calculate item number range.
+    my $range1 = $hunk->context_range(1);
+    my $range2 = $hunk->context_range(2);
+
+    # Print out file 1 part for each block in context diff format if there are
+    # any blocks that remove items
+    print "*** $range1 ****\n";
+    my $low = $hunk->{"start1"};
+    my $hi  = $hunk->{"end1"};
+    if (@blocklist = grep {$_->remove} @{$hunk->{"blocks"}}) {
+	my @outlist = @$fileref1[$low..$hi];
+	map {s/^/  /} @outlist; # assume it's just context
+	foreach my $block (@blocklist) {
+	    my $op = $block->op; # - or !
+	    foreach my $item ($block->remove) {
+		$outlist[$item->{"item_no"} - $low] =~ s/^ /$op/;
+	    }
+	}
+	map {s/$/\n/} @outlist; # add \n's
+	print @outlist;
+    }
+
+    print "--- $range2 ----\n";
+    $low = $hunk->{"start2"};
+    $hi  = $hunk->{"end2"};
+    if (@blocklist = grep {$_->insert} @{$hunk->{"blocks"}}) {
+	my @outlist = @$fileref2[$low..$hi];
+	map {s/^/  /} @outlist; # assume it's just context
+	foreach my $block (@blocklist) {
+	    my $op = $block->op; # + or !
+	    foreach my $item ($block->insert) {
+		$outlist[$item->{"item_no"} - $low] =~ s/^ /$op/;
+	    }
+	}
+	map {s/$/\n/} @outlist; # add \n's
+	print @outlist;
+    }
+}
+
+sub context_range {
+# Generate a range of item numbers to print. Only print 1 number if the range
+# has only one item in it. Otherwise, it's 'start,end'
+    my ($hunk, $flag) = @_;
+    my ($start, $end) = ($hunk->{"start$flag"},$hunk->{"end$flag"});
+    $start++; $end++;  # index from 1, not zero
+    my $range = ($start < $end) ? "$start,$end" : $end;
+    return $range;
+}
+
+sub unified_range {
+# Generate a range of item numbers to print for unified diff
+# Print number where block starts, followed by number of lines in the block
+# (don't print number of lines if it's 1)
+    my ($hunk, $flag) = @_;
+    my ($start, $end) = ($hunk->{"start$flag"},$hunk->{"end$flag"});
+    $start++; $end++;  # index from 1, not zero
+    my $length = $end - $start + 1;
+    my $first = $length < 2 ? $end : $start; # strange, but correct...
+    my $range = $length== 1 ? $first : "$first,$length";
+    return $range;
+}
+} # end Package Hunk
+
+# Package Block. A block is an operation removing, adding, or changing
+# a group of items. Basically, this is just a list of changes, where each
+# change adds or deletes a single item.
+# (Change could be a separate class, but it didn't seem worth it)
+{
+package Block;
+sub new {
+# Input is a chunk from &Algorithm::LCS::diff
+# Fields in a block:
+# length_diff - how much longer file 2 is than file 1 due to this block
+# Each change has:
+# sign        - '+' for insert, '-' for remove
+# item_no     - number of the item in the file (e.g., line number)
+# We don't bother storing the text of the item
+#
+    my ($class,$chunk) = @_;
+    my @changes = ();
+
+# This just turns each change into a hash.
+    foreach my $item (@$chunk) {
+	my ($sign, $item_no, $text) = @$item;
+	my $hashref = {"sign" => $sign, "item_no" => $item_no};
+	push @changes, $hashref;
+    }
+
+    my $block = { "changes" => \@changes };
+    bless $block, $class;
+
+    $block->{"length_diff"} = $block->insert - $block->remove;
+    return $block;
+}
+
+
+# LOW LEVEL FUNCTIONS
+sub op {
+# what kind of block is this?
+    my $block = shift;
+    my $insert = $block->insert;
+    my $remove = $block->remove;
+
+    $remove && $insert and return '!';
+    $remove and return '-';
+    $insert and return '+';
+    warn "unknown block type";
+    return '^'; # context block
+}
+
+# Returns a list of the changes in this block that remove items
+# (or the number of removals if called in scalar context)
+sub remove { return grep {$_->{"sign"} eq '-'} @{shift->{"changes"}}; }
+
+# Returns a list of the changes in this block that insert items
+sub insert { return grep {$_->{"sign"} eq '+'} @{shift->{"changes"}}; }
+
+} # end of package Block
+
diff --git a/Master/tlpkg/tlperl/lib/Algorithm/diff.pl b/Master/tlpkg/tlperl/lib/Algorithm/diff.pl
new file mode 100755
index 00000000000..9bddb15df6b
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Algorithm/diff.pl
@@ -0,0 +1,47 @@
+#!/usr/bin/perl
+#
+# `Diff' program in Perl
+# Copyright 1998 M-J. Dominus. (mjd-perl-diff@plover.com)
+#
+# This program is free software; you can redistribute it and/or modify it
+# under the same terms as Perl itself.
+#
+
+use Algorithm::Diff qw(diff);
+
+bag("Usage: $0 oldfile newfile") unless @ARGV == 2;
+
+my ($file1, $file2) = @ARGV;
+
+# -f $file1 or bag("$file1: not a regular file");
+# -f $file2 or bag("$file2: not a regular file");
+
+-T $file1 or bag("$file1: binary");
+-T $file2 or bag("$file2: binary");
+
+open (F1, $file1) or bag("Couldn't open $file1: $!");
+open (F2, $file2) or bag("Couldn't open $file2: $!");
+chomp(@f1 = <F1>);
+close F1;
+chomp(@f2 = <F2>);
+close F2;
+
+$diffs = diff(\@f1, \@f2);
+exit 0 unless @$diffs;
+
+foreach $chunk (@$diffs) {
+  
+  foreach $line (@$chunk) {
+    my ($sign, $lineno, $text) = @$line;
+    printf "%4d$sign %s\n", $lineno+1, $text;
+  }
+  print "--------\n";
+}
+exit 1;
+
+sub bag {
+  my $msg = shift;
+  $msg .= "\n";
+  warn $msg;
+  exit 2;
+}
diff --git a/Master/tlpkg/tlperl/lib/Algorithm/diffnew.pl b/Master/tlpkg/tlperl/lib/Algorithm/diffnew.pl
new file mode 100755
index 00000000000..492e52b932b
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Algorithm/diffnew.pl
@@ -0,0 +1,528 @@
+#!/usr/bin/perl
+#
+# `Diff' program in Perl
+# Copyright 1998 M-J. Dominus. (mjd-perl-diff@plover.com)
+#
+# This program is free software; you can redistribute it and/or modify it
+# under the same terms as Perl itself.
+#
+# Altered to output in `context diff' format (but without context)
+# September 1998 Christian Murphy (cpm@muc.de)
+#
+# Context lines feature added
+# Unified, "Old" (Standard UNIX), Ed diff added September 1998
+# Reverse_Ed (-f option) added March 1999
+# Amir D. Karger (karger@bead.aecom.yu.edu)
+#
+# Modular functions integrated into program
+# February 1999 M-J. Dominus (mjd-perl-diff@plover.com)
+#
+# In this file, "item" usually means "line of text", and "item number" usually
+# means "line number". But theoretically the code could be used more generally
+use strict;
+use Algorithm::Diff qw(diff);
+
+# GLOBAL VARIABLES  ####
+# After we've read up to a certain point in each file, the number of items
+# we've read from each file will differ by $FLD (could be 0)
+my $File_Length_Difference = 0;
+
+#ed diff outputs hunks *backwards*, so we need to save hunks when doing ed diff
+my @Ed_Hunks = ();
+########################
+
+my $usage = << "ENDUSAGE";
+Usage: $0 [{-c | -C lines -e | -f | -u | -U lines}] oldfile newfile
+    -c do a context diff with 3 lines of context
+    -C do a context diff with 'lines' lines of context (implies -c)
+    -e create a script for the ed editor to change oldfile to newfile
+    -f like -e but in reverse order
+    -u do a unified diff with 3 lines of context
+    -U do a unified diff with 'lines' lines of context (implies -u)
+    -q report only whether or not the files differ
+
+By default it will do an "old-style" diff, with output like UNIX diff
+ENDUSAGE
+
+my $Context_Lines = 0; # lines of context to print. 0 for old-style diff
+my $Diff_Type = "OLD"; # by default, do standard UNIX diff
+my ($opt_c, $opt_u, $opt_e, $opt_f, $opt_q);
+while ($ARGV[0] =~ /^-/) {
+  my $opt = shift;
+  last if $opt eq '--';
+  if ($opt =~ /^-C(.*)/) {
+    $Context_Lines = $1 || shift;
+    $opt_c = 1;
+    $Diff_Type = "CONTEXT";
+  } elsif ($opt =~ /^-c$/) {
+    $Context_Lines = 3;
+    $opt_c = 1;
+    $Diff_Type = "CONTEXT";
+  } elsif ($opt =~ /^-e$/) {
+    $opt_e = 1;
+    $Diff_Type = "ED";
+  } elsif ($opt =~ /^-f$/) {
+    $opt_f = 1;
+    $Diff_Type = "REVERSE_ED";
+  } elsif ($opt =~ /^-U(.*)$/) {
+    $Context_Lines = $1 || shift;
+    $opt_u = 1;
+    $Diff_Type = "UNIFIED";
+  } elsif ($opt =~ /^-u$/) {
+    $Context_Lines = 3;
+    $opt_u = 1;
+    $Diff_Type = "UNIFIED";
+  } elsif ($opt =~ /^-q$/) {
+    $Context_Lines = 0;
+    $opt_q = 1;
+    $opt_e = 1;
+    $Diff_Type = "ED";
+  } else {
+    $opt =~ s/^-//;
+    bag("Illegal option -- $opt");
+  }
+}
+
+if ($opt_q and grep($_,($opt_c, $opt_f, $opt_u)) > 1) {
+    bag("Combining -q with other options is nonsensical");
+}
+
+if (grep($_,($opt_c, $opt_e, $opt_f, $opt_u)) > 1) {
+    bag("Only one of -c, -u, -f, -e are allowed");
+}
+
+bag($usage) unless @ARGV == 2;
+
+######## DO THE DIFF!
+my ($file1, $file2) = @ARGV;
+
+my ($char1, $char2); # string to print before file names
+if ($Diff_Type eq "CONTEXT") {
+    $char1 = '*' x 3; $char2 = '-' x 3;
+} elsif ($Diff_Type eq "UNIFIED") {
+    $char1 = '-' x 3; $char2 = '+' x 3;
+}
+
+open (F1, $file1) or bag("Couldn't open $file1: $!");
+open (F2, $file2) or bag("Couldn't open $file2: $!");
+my (@f1, @f2);
+chomp(@f1 = <F1>);
+close F1;
+chomp(@f2 = <F2>);
+close F2;
+
+# diff yields lots of pieces, each of which is basically a Block object
+my $diffs = diff(\@f1, \@f2);
+exit 0 unless @$diffs;
+
+if ($opt_q and @$diffs) {
+    print "Files $file1 and $file2 differ\n";
+    exit 1;
+}
+
+if ($Diff_Type =~ /UNIFIED|CONTEXT/) {
+    my @st = stat($file1);
+    my $MTIME = 9;
+    print "$char1 $file1\t", scalar localtime($st[$MTIME]), "\n";
+    @st = stat($file2);
+    print "$char2 $file2\t", scalar localtime($st[$MTIME]), "\n";
+}
+
+my ($hunk,$oldhunk);
+# Loop over hunks. If a hunk overlaps with the last hunk, join them.
+# Otherwise, print out the old one.
+foreach my $piece (@$diffs) {
+    $hunk = new Hunk ($piece, $Context_Lines);
+    next unless $oldhunk; # first time through
+
+    # Don't need to check for overlap if blocks have no context lines
+    if ($Context_Lines && $hunk->does_overlap($oldhunk)) {
+	$hunk->prepend_hunk($oldhunk);
+    } else {
+	$oldhunk->output_diff(\@f1, \@f2, $Diff_Type);
+    }
+
+} continue {
+    $oldhunk = $hunk;
+}
+
+# print the last hunk
+$oldhunk->output_diff(\@f1, \@f2, $Diff_Type);
+
+# Print hunks backwards if we're doing an ed diff
+map {$_->output_ed_diff(\@f1, \@f2, $Diff_Type)} @Ed_Hunks if @Ed_Hunks;
+
+exit 1;
+# END MAIN PROGRAM
+
+sub bag {
+  my $msg = shift;
+  $msg .= "\n";
+  warn $msg;
+  exit 2;
+}
+
+########
+# Package Hunk. A Hunk is a group of Blocks which overlap because of the
+# context surrounding each block. (So if we're not using context, every
+# hunk will contain one block.)
+{
+package Hunk;
+
+sub new {
+# Arg1 is output from &LCS::diff (which corresponds to one Block)
+# Arg2 is the number of items (lines, e.g.,) of context around each block
+#
+# This subroutine changes $File_Length_Difference
+#
+# Fields in a Hunk:
+# blocks      - a list of Block objects
+# start       - index in file 1 where first block of the hunk starts
+# end         - index in file 1 where last block of the hunk ends
+#
+# Variables:
+# before_diff - how much longer file 2 is than file 1 due to all hunks
+#               until but NOT including this one
+# after_diff  - difference due to all hunks including this one
+    my ($class, $piece, $context_items) = @_;
+
+    my $block = new Block ($piece); # this modifies $FLD!
+
+    my $before_diff = $File_Length_Difference; # BEFORE this hunk
+    my $after_diff = $before_diff + $block->{"length_diff"};
+    $File_Length_Difference += $block->{"length_diff"};
+
+    # @remove_array and @insert_array hold the items to insert and remove
+    # Save the start & beginning of each array. If the array doesn't exist
+    # though (e.g., we're only adding items in this block), then figure
+    # out the line number based on the line number of the other file and
+    # the current difference in file lenghts
+    my @remove_array = $block->remove;
+    my @insert_array = $block->insert;
+    my ($a1, $a2, $b1, $b2, $start1, $start2, $end1, $end2);
+    $a1 = @remove_array ? $remove_array[0 ]->{"item_no"} : -1;
+    $a2 = @remove_array ? $remove_array[-1]->{"item_no"} : -1;
+    $b1 = @insert_array ? $insert_array[0 ]->{"item_no"} : -1;
+    $b2 = @insert_array ? $insert_array[-1]->{"item_no"} : -1;
+
+    $start1 = $a1 == -1 ? $b1 - $before_diff : $a1;
+    $end1   = $a2 == -1 ? $b2 - $after_diff  : $a2;
+    $start2 = $b1 == -1 ? $a1 + $before_diff : $b1;
+    $end2   = $b2 == -1 ? $a2 + $after_diff  : $b2;
+
+    # At first, a hunk will have just one Block in it
+    my $hunk = {
+	    "start1" => $start1,
+	    "start2" => $start2,
+	    "end1" => $end1,
+	    "end2" => $end2,
+	    "blocks" => [$block],
+              };
+    bless $hunk, $class;
+
+    $hunk->flag_context($context_items);
+
+    return $hunk;
+}
+
+# Change the "start" and "end" fields to note that context should be added
+# to this hunk
+sub flag_context {
+    my ($hunk, $context_items) = @_;
+    return unless $context_items; # no context
+
+    # add context before
+    my $start1 = $hunk->{"start1"};
+    my $num_added = $context_items > $start1 ? $start1 : $context_items;
+    $hunk->{"start1"} -= $num_added;
+    $hunk->{"start2"} -= $num_added;
+
+    # context after
+    my $end1 = $hunk->{"end1"};
+    $num_added = ($end1+$context_items > $#f1) ?
+                  $#f1 - $end1 :
+                  $context_items;
+    $hunk->{"end1"} += $num_added;
+    $hunk->{"end2"} += $num_added;
+}
+
+# Is there an overlap between hunk arg0 and old hunk arg1?
+# Note: if end of old hunk is one less than beginning of second, they overlap
+sub does_overlap {
+    my ($hunk, $oldhunk) = @_;
+    return "" unless $oldhunk; # first time through, $oldhunk is empty
+
+    # Do I actually need to test both?
+    return ($hunk->{"start1"} - $oldhunk->{"end1"} <= 1 ||
+            $hunk->{"start2"} - $oldhunk->{"end2"} <= 1);
+}
+
+# Prepend hunk arg1 to hunk arg0
+# Note that arg1 isn't updated! Only arg0 is.
+sub prepend_hunk {
+    my ($hunk, $oldhunk) = @_;
+
+    $hunk->{"start1"} = $oldhunk->{"start1"};
+    $hunk->{"start2"} = $oldhunk->{"start2"};
+
+    unshift (@{$hunk->{"blocks"}}, @{$oldhunk->{"blocks"}});
+}
+
+
+# DIFF OUTPUT ROUTINES. THESE ROUTINES CONTAIN DIFF FORMATTING INFO...
+sub output_diff {
+# First arg is the current hunk of course
+# Next args are refs to the files
+# last arg is type of diff
+    my $diff_type = $_[-1];
+    my %funchash  = ("OLD"        => \&output_old_diff,
+                     "CONTEXT"    => \&output_context_diff,
+		     "ED"         => \&store_ed_diff,
+		     "REVERSE_ED" => \&output_ed_diff,
+                     "UNIFIED"    => \&output_unified_diff,
+	            );
+    if (exists $funchash{$diff_type}) {
+        &{$funchash{$diff_type}}(@_); # pass in all args
+    } else {die "unknown diff type $diff_type"}
+}
+
+sub output_old_diff {
+# Note that an old diff can't have any context. Therefore, we know that
+# there's only one block in the hunk.
+    my ($hunk, $fileref1, $fileref2) = @_;
+    my %op_hash = ('+' => 'a', '-' => 'd', '!' => 'c');
+
+    my @blocklist = @{$hunk->{"blocks"}};
+    warn ("Expecting one block in an old diff hunk!") if scalar @blocklist != 1;
+    my $block = $blocklist[0];
+    my $op = $block->op; # +, -, or !
+
+    # Calculate item number range.
+    # old diff range is just like a context diff range, except the ranges
+    # are on one line with the action between them.
+    my $range1 = $hunk->context_range(1);
+    my $range2 = $hunk->context_range(2);
+    my $action = $op_hash{$op} || warn "unknown op $op";
+    print "$range1$action$range2\n";
+
+    # If removing anything, just print out all the remove lines in the hunk
+    # which is just all the remove lines in the block
+    if ($block->remove) {
+	my @outlist = @$fileref1[$hunk->{"start1"}..$hunk->{"end1"}];
+	map {$_ = "< $_\n"} @outlist; # all lines will be '< text\n'
+	print @outlist;
+    }
+
+    print "---\n" if $op eq '!'; # only if inserting and removing
+    if ($block->insert) {
+	my @outlist = @$fileref2[$hunk->{"start2"}..$hunk->{"end2"}];
+	map {$_ = "> $_\n"} @outlist; # all lines will be '> text\n'
+	print @outlist;
+    }
+}
+
+sub output_unified_diff {
+    my ($hunk, $fileref1, $fileref2) = @_;
+    my @blocklist;
+
+    # Calculate item number range.
+    my $range1 = $hunk->unified_range(1);
+    my $range2 = $hunk->unified_range(2);
+    print "@@ -$range1 +$range2 @@\n";
+
+    # Outlist starts containing the hunk of file 1.
+    # Removing an item just means putting a '-' in front of it.
+    # Inserting an item requires getting it from file2 and splicing it in.
+    #    We splice in $num_added items. Remove blocks use $num_added because
+    # splicing changed the length of outlist.
+    #    We remove $num_removed items. Insert blocks use $num_removed because
+    # their item numbers---corresponding to positions in file *2*--- don't take
+    # removed items into account.
+    my $low = $hunk->{"start1"};
+    my $hi = $hunk->{"end1"};
+    my ($num_added, $num_removed) = (0,0);
+    my @outlist = @$fileref1[$low..$hi];
+    map {s/^/ /} @outlist; # assume it's just context
+
+    foreach my $block (@{$hunk->{"blocks"}}) {
+	foreach my $item ($block->remove) {
+	    my $op = $item->{"sign"}; # -
+	    my $offset = $item->{"item_no"} - $low + $num_added;
+	    $outlist[$offset] =~ s/^ /$op/;
+	    $num_removed++;
+	}
+	foreach my $item ($block->insert) {
+	    my $op = $item->{"sign"}; # +
+	    my $i = $item->{"item_no"};
+	    my $offset = $i - $hunk->{"start2"} + $num_removed;
+	    splice(@outlist,$offset,0,"$op$$fileref2[$i]");
+	    $num_added++;
+	}
+    }
+
+    map {s/$/\n/} @outlist; # add \n's
+    print @outlist;
+
+}
+
+sub output_context_diff {
+    my ($hunk, $fileref1, $fileref2) = @_;
+    my @blocklist;
+
+    print "***************\n";
+    # Calculate item number range.
+    my $range1 = $hunk->context_range(1);
+    my $range2 = $hunk->context_range(2);
+
+    # Print out file 1 part for each block in context diff format if there are
+    # any blocks that remove items
+    print "*** $range1 ****\n";
+    my $low = $hunk->{"start1"};
+    my $hi  = $hunk->{"end1"};
+    if (@blocklist = grep {$_->remove} @{$hunk->{"blocks"}}) {
+	my @outlist = @$fileref1[$low..$hi];
+	map {s/^/  /} @outlist; # assume it's just context
+	foreach my $block (@blocklist) {
+	    my $op = $block->op; # - or !
+	    foreach my $item ($block->remove) {
+		$outlist[$item->{"item_no"} - $low] =~ s/^ /$op/;
+	    }
+	}
+	map {s/$/\n/} @outlist; # add \n's
+	print @outlist;
+    }
+
+    print "--- $range2 ----\n";
+    $low = $hunk->{"start2"};
+    $hi  = $hunk->{"end2"};
+    if (@blocklist = grep {$_->insert} @{$hunk->{"blocks"}}) {
+	my @outlist = @$fileref2[$low..$hi];
+	map {s/^/  /} @outlist; # assume it's just context
+	foreach my $block (@blocklist) {
+	    my $op = $block->op; # + or !
+	    foreach my $item ($block->insert) {
+		$outlist[$item->{"item_no"} - $low] =~ s/^ /$op/;
+	    }
+	}
+	map {s/$/\n/} @outlist; # add \n's
+	print @outlist;
+    }
+}
+
+sub store_ed_diff {
+# ed diff prints out diffs *backwards*. So save them while we're generating
+# them, then print them out at the end
+    my $hunk = shift;
+    unshift @Ed_Hunks, $hunk;
+}
+
+sub output_ed_diff {
+# This sub is used for ed ('diff -e') OR reverse_ed ('diff -f').
+# last arg is type of diff
+    my $diff_type = $_[-1];
+    my ($hunk, $fileref1, $fileref2) = @_;
+    my %op_hash = ('+' => 'a', '-' => 'd', '!' => 'c');
+
+    # Can't be any context for this kind of diff, so each hunk has one block
+    my @blocklist = @{$hunk->{"blocks"}};
+    warn ("Expecting one block in an ed diff hunk!") if scalar @blocklist != 1;
+    my $block = $blocklist[0];
+    my $op = $block->op; # +, -, or !
+
+    # Calculate item number range.
+    # old diff range is just like a context diff range, except the ranges
+    # are on one line with the action between them.
+    my $range1 = $hunk->context_range(1);
+    $range1 =~ s/,/ / if $diff_type eq "REVERSE_ED";
+    my $action = $op_hash{$op} || warn "unknown op $op";
+    print ($diff_type eq "ED" ? "$range1$action\n" : "$action$range1\n");
+
+    if ($block->insert) {
+	my @outlist = @$fileref2[$hunk->{"start2"}..$hunk->{"end2"}];
+	map {s/$/\n/} @outlist; # add \n's
+	print @outlist;
+	print ".\n"; # end of ed 'c' or 'a' command
+    }
+}
+
+sub context_range {
+# Generate a range of item numbers to print. Only print 1 number if the range
+# has only one item in it. Otherwise, it's 'start,end'
+# Flag is the number of the file (1 or 2)
+    my ($hunk, $flag) = @_;
+    my ($start, $end) = ($hunk->{"start$flag"},$hunk->{"end$flag"});
+    $start++; $end++;  # index from 1, not zero
+    my $range = ($start < $end) ? "$start,$end" : $end;
+    return $range;
+}
+
+sub unified_range {
+# Generate a range of item numbers to print for unified diff
+# Print number where block starts, followed by number of lines in the block
+# (don't print number of lines if it's 1)
+    my ($hunk, $flag) = @_;
+    my ($start, $end) = ($hunk->{"start$flag"},$hunk->{"end$flag"});
+    $start++; $end++;  # index from 1, not zero
+    my $length = $end - $start + 1;
+    my $first = $length < 2 ? $end : $start; # strange, but correct...
+    my $range = $length== 1 ? $first : "$first,$length";
+    return $range;
+}
+} # end Package Hunk
+
+########
+# Package Block. A block is an operation removing, adding, or changing
+# a group of items. Basically, this is just a list of changes, where each
+# change adds or deletes a single item.
+# (Change could be a separate class, but it didn't seem worth it)
+{
+package Block;
+sub new {
+# Input is a chunk from &Algorithm::LCS::diff
+# Fields in a block:
+# length_diff - how much longer file 2 is than file 1 due to this block
+# Each change has:
+# sign        - '+' for insert, '-' for remove
+# item_no     - number of the item in the file (e.g., line number)
+# We don't bother storing the text of the item
+#
+    my ($class,$chunk) = @_;
+    my @changes = ();
+
+# This just turns each change into a hash.
+    foreach my $item (@$chunk) {
+	my ($sign, $item_no, $text) = @$item;
+	my $hashref = {"sign" => $sign, "item_no" => $item_no};
+	push @changes, $hashref;
+    }
+
+    my $block = { "changes" => \@changes };
+    bless $block, $class;
+
+    $block->{"length_diff"} = $block->insert - $block->remove;
+    return $block;
+}
+
+
+# LOW LEVEL FUNCTIONS
+sub op {
+# what kind of block is this?
+    my $block = shift;
+    my $insert = $block->insert;
+    my $remove = $block->remove;
+
+    $remove && $insert and return '!';
+    $remove and return '-';
+    $insert and return '+';
+    warn "unknown block type";
+    return '^'; # context block
+}
+
+# Returns a list of the changes in this block that remove items
+# (or the number of removals if called in scalar context)
+sub remove { return grep {$_->{"sign"} eq '-'} @{shift->{"changes"}}; }
+
+# Returns a list of the changes in this block that insert items
+sub insert { return grep {$_->{"sign"} eq '+'} @{shift->{"changes"}}; }
+
+} # end of package Block
diff --git a/Master/tlpkg/tlperl/lib/Algorithm/htmldiff.pl b/Master/tlpkg/tlperl/lib/Algorithm/htmldiff.pl
new file mode 100755
index 00000000000..fdc81021582
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Algorithm/htmldiff.pl
@@ -0,0 +1,100 @@
+#!/usr/bin/perl -w
+# diffs two files and writes an HTML output file.
+use strict;
+use CGI qw(:standard :html3);
+use Algorithm::Diff 'traverse_sequences';
+use Text::Tabs;
+
+my ( @a, @b );
+
+# Take care of whitespace.
+sub preprocess
+{
+	my $arrayRef = shift;
+	chomp(@$arrayRef);
+	@$arrayRef = expand(@$arrayRef);
+}
+
+# This will be called with both lines are the same
+sub match
+{
+	my ( $ia, $ib ) = @_;
+	print pre( $a[$ia] ), "\n";
+}
+
+# This will be called when there is a line in A that isn't in B
+sub only_a
+{
+	my ( $ia, $ib ) = @_;
+	print pre( { -class => 'onlyA' }, $a[$ia] ), "\n";
+}
+
+# This will be called when there is a line in B that isn't in A
+sub only_b
+{
+	my ( $ia, $ib ) = @_;
+	print pre( { -class => 'onlyB' }, $b[$ib] ), "\n";
+}
+
+# MAIN PROGRAM
+
+# Check for two arguments.
+print "usage: $0 file1 file2 > diff.html\n" if @ARGV != 2;
+
+$tabstop = 4;    # For Text::Tabs
+
+# Read each file into an array.
+open FH, $ARGV[0];
+@a = <FH>;
+close FH;
+
+open FH, $ARGV[1];
+@b = <FH>;
+close FH;
+
+# Expand whitespace
+preprocess( \@a );
+preprocess( \@b );
+
+# inline style
+my $style = <<EOS;
+	PRE {
+		margin-left: 24pt; 
+		font-size: 12pt;
+	    font-family: Courier, monospaced;
+		white-space: pre
+    }
+	PRE.onlyA { color: red }
+	PRE.onlyB { color: blue }
+EOS
+
+# Print out the starting HTML
+print
+
+  # header(),
+  start_html(
+	{
+		-title => "$ARGV[0] vs. $ARGV[1]",
+		-style => { -code => $style }
+	}
+  ),
+  h1(
+	{ -style => 'margin-left: 24pt' },
+	span( { -style => 'color: red' }, $ARGV[0] ),
+	span(" <i>vs.</i> "),
+	span( { -style => 'color: blue' }, $ARGV[1] )
+  ),
+  "\n";
+
+# And compare the arrays
+traverse_sequences(
+	\@a,    # first sequence
+	\@b,    # second sequence
+	{
+		MATCH     => \&match,     # callback on identical lines
+		DISCARD_A => \&only_a,    # callback on A-only
+		DISCARD_B => \&only_b,    # callback on B-only
+	}
+);
+
+print end_html();