RSS Git Download  Clone
Raw Blame History
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 <span> 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;