File Coverage

blib/lib/String/ShowHTMLDiff.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package String::ShowHTMLDiff;

use strict;

require Exporter;

use vars qw/@ISA %EXPORT_TAGS @EXPORT_OK @EXPORT $VERSION/;

@ISA = qw(Exporter);

%EXPORT_TAGS = ( 'all' => [ qw(
    html_colored_diff
) ] );

@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

@EXPORT = qw(

);

$VERSION = '0.01';

use Algorithm::Diff qw/sdiff/;

sub html_colored_diff {
    my ($string, $changed_string, $options) = @_;
    $options ||= {};
    my %colors = (
        '-' => $options->{'-'} || 'diff_minus',
        '+' => $options->{'+'} || 'diff_plus',
        'u' => $options->{'u'} || 'diff_unchanged',
    );
    my $context_re = $options->{context} || qr/.*/;
    my $gap        = $options->{gap}     || '';

    my @sdiff = sdiff(map {[split //, $_]} $string, $changed_string);
    my @html;
    my $first_while_loop = 1;
    while (@sdiff and my ($mod, $s1, $s2) = @{shift @sdiff}) {
        if ($mod =~ /[+-]/) {
            push @html, _colored($s1 || $s2, $colors{$mod});
        } else {  # Must be either a change or a part of unchanged characters
                  # So take a look, whether there are more chars that should be
                  # handled in a row
            while (@sdiff && $sdiff[0]->[0] eq $mod) {
                $s1 .= $sdiff[0]->[1];          # if so, join all chars from the old
                                                # string to $s1
                $s2 .= $sdiff[0]->[2];          # and from the new to $s2
                shift @sdiff;                   # The information of this element
                                                # is already in $s1, $s2 and $mod
                                                # and thus unnecessary now
            }
            if ($mod eq 'u') {
                my $unchanged_part = _construct_glue(
                    $s1, $context_re, $gap, $first_while_loop, @sdiff==0
                );
                push @html, _colorize_string($unchanged_part, $colors{'u'});
            } else {
                push @html,
                    _colorize_string($s1, $colors{'-'}),
                    _colorize_string($s2, $colors{'+'});
            }
        }
        $first_while_loop = 0;
    }
    return join "", @html;
}

sub _colored {
	my($text, $style) = @_;
	return "$text";
}

# call with _colorize_string($string, $color)
sub _colorize_string { join "", map {_colored($_,$_[1])} split //, $_[0] }

sub _construct_glue {
    my ($full_string, $context_re, $gap, $at_beginning, $at_end) = @_;
    my ($start) = $full_string =~ /^($context_re)/;
    my ($end)   = $full_string =~ /($context_re)$/;
    $_ ||= "" for ($start, $end);

    # Return now the shorter string of either a constructed context with a gap
    # string or the normal string between the two differences
    my $start_gap_end = $start . $gap . $end;
    return length($start_gap_end) < length($full_string)
        ? $start_gap_end
        : $full_string;
}

1;
__END__