package LIMS::Controller::Roles::Diff; use Moose::Role; use Data::Dumper; use Algorithm::Diff qw/traverse_sequences/; has string => ( is => 'ro', isa => 'ArrayRef[Str]', lazy => 1, # needed to avoid 'Can't use an undefined value as an ARRAY reference' default => sub { [] }, traits => ['Array'], handles => { add_to_string => 'push', join_string => 'join', clear_string => 'clear', }, ); has span => ( is => 'ro', isa => 'ArrayRef[Str]', lazy => 1, # needed to avoid 'Can't use an undefined value as an ARRAY reference' default => sub { [] }, traits => ['Array'], handles => { add_to_span => 'push', join_span => 'join', clear_span => 'clear', }, ); has current_class => ( is => 'rw', isa => 'Str', default => q{} ); # uses Algorithm::Diff:traverse_sequences() to calculate difference sub do_diff { my ($self, $pre_edit, $post_edit) = @_; # warn Dumper ($pre_edit, $post_edit); # substitute ¬ for new-lines(s) to preserve line-breaks through split # spaces either side are essential or re-formatting gets screwed $pre_edit =~ s/(\r\n)+/ ¬ /g; $post_edit =~ s/(\r\n)+/ ¬ /g; my @before = split /\s+/, $pre_edit; # warn Dumper($before, @before); my @after = split /\s+/, $post_edit; # warn Dumper($after, @after); # set default class: $self->current_class('normal'); # warn $self->current_class; traverse_sequences(\@before, \@after, { MATCH => sub { $self->colourise($before[$_[0]]) }, DISCARD_A => sub { $self->colourise($before[$_[0]], 'del' ) }, DISCARD_B => sub { $self->colourise($after[$_[1]], 'add' ) }, }); # send empty str to force any remaining entries from 'span' array: # $self->colourise("",'end'); # only needed if using add_to_span() method my $colourised_diffs = $self->join_string(' '); # reset string: $self->clear_string; return $colourised_diffs; } sub _this_method_in_use { return 1; } # colourises changed strings - based on R. Schwartz Unix Review Column 35 # see http://www.stonehenge.com/merlyn/UnixReview/col35.html sub colourise { my ($self, $word, $class) = @_; # $class optional # don't need to apply styles to html line-break aliases: $self->add_to_string($word) and return if $word eq '¬'; $class ||= 'normal'; # $class optional # this works, but each individually diff'ed word is enclosed in tags, # also breaks up words with common background & strike-through: if ( _this_method_in_use() ) { my $q = $self->query; # highlight $word if $class != 'normal': $word = $q->span({-class => $class}, $word) if $class ne 'normal'; $self->add_to_string($word); return; } # method below works better, but relies on position of "\n" markers for # correct html spacing - so do not modify - also not formatting correctly yet $self->add_to_span($word); my $current_class = $self->current_class; if ($class ne $current_class) { # warn $class; warn $current_class; my $span = $self->join_span(' '); my $q = $self->query; $self->add_to_string( $q->span({-class => $current_class}, $span ) ); # set new class: $self->current_class($class); # reset phrase: $self->clear_span; } } 1;