########################################### # SDiff.pm # Mike Schilli, 2002 (m@perlmeister.com) ########################################### require Exporter; our $VERSION = "0.01"; our @ISA = qw(Exporter AutoLoader); our @EXPORT_OK = qw( sdiff ); use Algorithm::Diff qw(traverse_sequences); ########################################### sub sdiff { ########################################### my($a1, $a2, $setr, $context) = @_; my (@res, $prev); $prev = ""; @res = (); traverse_sequences( $a1, $a2, { MATCH => sub { my($i,$j) = @_; push @res, [$a1->[$i], $a2->[$j], "u"]; $prev = "MATCH"; }, DISCARD_A => sub { my($i,$j) = @_; if($prev eq "DISCARD_B") { $res[$#res]->[0] = $a1->[$i]; $res[$#res]->[2] = "c"; } else { push @res, [$a1->[$i], "", "d"]; mark_window($setr, $#res, $context) if $setr; } $prev = "DISCARD_A"; }, DISCARD_B => sub { my($i,$j) = @_; if($prev eq "DISCARD_A") { $res[$#res]->[1] = $a2->[$j]; $res[$#res]->[2] = "c"; } else { push @res, ["", $a2->[$j], "i"]; mark_window($setr, $#res, $context) if $setr; } $prev = "DISCARD_B"; }, } ); # Limit set to extent of array if($setr) { $$setr = $$setr->intersect("0-$#res"); } return \@res; } ########################################### sub mark_window { ########################################### my($setr, $idx, $window) = @_; my $from = $idx - $window; $from = 0 if $from < 0; my $to = $idx + $window; $$setr = $$setr->union("$from-$to"); } 1;