Re: Finding changed words

[tye]

And combining merlyn's and my answers I give you:

#!/usr/bin/perl -w

use strict;

use Algorithm::Diff qw( traverse_sequences );

exit main();

{
    my( $outState, %markUp, %htmlEnt );
    BEGIN {
        %markUp= (
            same => ['',''],
            new => ['<strong>','</strong>'],
            old => ['<font size="-1"><strike>','</strike></font>'],
        );
        %htmlEnt= ( "<"=>"lt", "&"=>"amp", ">"=>"gt",
                    "["=>"#91", "]"=>"#93" );
    }
    sub output {
        my( $style, $text )= @_;
        if(  ! defined $outState  ) {
            print $markUp{ $outState= $style }[0];
        } elsif(  $style ne $outState  ) {
            print $markUp{$outState}[1], $markUp{$style}[0];
            $outState= $style;
        }
        $text =~ s#([][<>&])#&$htmlEnt{$1};#g;
        $text =~ s#\n#<br>\n#g;
        print $text;
    }
}

sub flush {
    my( $meth, $rOld, $rNew )= @_;
    return   if  "" eq $$rOld  &&  "" eq $$rNew;
    if(  "" eq $$rOld  ) {
        output( "new", $$rNew );
    } elsif(  "" eq $$rNew  ) {
        output( "old", $$rOld );
    } elsif(  ! $meth  ) {
        output( "old", $$rOld );
        output( "new", $$rNew );
    } else {
        my( $meth, $old, $new )= &$meth( $rOld, $rNew );
        compare( $meth, $old, $new );
    }
    $$rOld= $$rNew= "";
}

sub compare {
    my( $meth, $old, $new )= @_;
    my( $oldTemp, $newTemp )= ( "", "" );
    traverse_sequences( $old, $new, {
        MATCH => sub {      flush( $meth, \$oldTemp, \$newTemp );
                            output( "same", $old->[$_[0]] ) },
        DISCARD_A => sub {  $oldTemp .= $old->[$_[0]] },
        DISCARD_B => sub {  $newTemp .= $new->[$_[1]] },
    } );
    flush( $meth, \$oldTemp, \$newTemp );
}

sub SentToWord {
    my( $rOld, $rNew )= @_;
    return(
        undef,
        [ split /(?<=\s)(?=\S)/, $$rOld ],
        [ split /(?<=\s)(?=\S)/, $$rNew ],
    );
}

sub ParaToSent {
    my( $rOld, $rNew )= @_;
    return(
        \&SentToWord,
        [ split /(?<=[.?!]\s)/, $$rOld ],
        [ split /(?<=[.?!]\s)/, $$rNew ],
    );
}

sub main {
    die "Usage:  $0 old new >dif\n"    unless  2 == @ARGV;
    my( $old, $new );
    { local($/,@ARGV)= ('',$ARGV[0]); $old= [<>]; }
    { local($/,@ARGV)= ('',$ARGV[1]); $new= [<>]; }
    compare( \&ParaToSent, $old, $new );
    output( "same", "" );
    exit 0;
}

This compares non-HTML files in a way that produces HTML that shows the differences.

Update: I added support for quoting [ and ] and (temporailly) put some sample output from this on my home node.

        - tye (but my friends call me "Tye")