File Coverage

blib/lib/CGI/Wiki/Plugin/Diff.pm

Criterion	Covered	Total	%
statement	21	105	20.0
branch	0	26	0.0
condition	0	22	0.0
subroutine	7	15	46.6
pod	7	7	100.0
total	35	175	20.0

package CGI::Wiki::Plugin::Diff;

use strict;
use warnings;

our $VERSION = '0.09';

use base 'CGI::Wiki::Plugin';
use Algorithm::Diff;
use VCS::Lite;
use Params::Validate::Dummy ();
use Module::Optional qw(Params::Validate
        validate validate_pos SCALAR SCALARREF ARRAYREF HASHREF UNDEF);

sub new {
    my $class = shift;
    my %par = validate( @_, {
        metadata_separator => { type => SCALAR, default => "\n"} ,
    	line_number_format => { type => SCALAR, default => "== Line \$_ ==\n" },
        word_matcher => { type => SCALARREF, default => qr(
            &.+?;                   #HTML special characters e.g. <
            |               #Line breaks
            |\w+\s*       	    #Word with trailing spaces
            |.                      #Any other single character
        )xsi },
    	} );
    bless \%par, $class;
}

sub differences {
    my $self = shift;
    my %args = validate( @_, {
        node          => { type => SCALAR},
        left_version  => { type => SCALAR},
        right_version => { type => SCALAR},
        meta_include  => { type => ARRAYREF, optional => 1 },
        meta_exclude  => { type => ARRAYREF, optional => 1 } });

    my ($node, $v1, $v2)  = @args{ qw( node left_version right_version) };
    my $store = $self->datastore;
    my $fmt = $self->formatter;

    my %ver1 = $store->retrieve_node( name => $node, version => $v1);
    my %ver2 = $store->retrieve_node( name => $node, version => $v2);

    my $verstring1 = "Version ".$ver1{version};
    my $verstring2 = "Version ".$ver2{version};

    my $el1 = VCS::Lite->new($verstring1,undef,
    	$self->content_escape($ver1{content}).
    	$self->{metadata_separator}.
	$self->serialise_metadata($ver1{metadata},
		@args{qw(meta_include meta_exclude)}));
    my $el2 = VCS::Lite->new($verstring2,undef,
    	$self->content_escape($ver2{content}).
    	$self->{metadata_separator}.
	$self->serialise_metadata($ver2{metadata},
		@args{qw(meta_include meta_exclude)}));
    my %pag = %ver1;
    $pag{left_version} = $verstring1;
    $pag{right_version} = $verstring2;
    $pag{content} = $fmt->format($ver1{content});
    my $dlt = $el1->delta($el2)
	or return %pag;

    my @out;

    for ($dlt->hunks) {
    	my ($lin1,$lin2,$out1,$out2);
	for (@$_) {
	    my ($ind,$line,$text) = @$_;
	    if ($ind ne '+') {
		$lin1 ||= $line;
		$out1 .= $text;
	    }
	    if ($ind ne '-') {
		$lin2 ||= $line;
		$out2 .= $text;
	    }
	}
    	push @out,{ left => $self->line_number($lin1),
		right => $self->line_number($lin2) };
	my ($text1,$text2) = $self->intradiff($out1,$out2);
	push @out,{left => $text1,
		right => $text2};
    }

    $pag{diff} = \@out;
    %pag;
}

sub line_number {
    my $self = shift;

    local ($_) = validate_pos(@_, {type => SCALAR | UNDEF, optional => 1} );
    return '' unless defined $_;

    my $fmt = '"'. $self->{line_number_format} . '"';
    eval $fmt;
}

sub serialise_metadata {
    my $self = shift;
    my ($all_meta,$include,$exclude) = validate_pos ( @_,
        { type => HASHREF },
        { type => ARRAYREF | UNDEF, optional => 1 },
        { type => ARRAYREF | UNDEF, optional => 1 },
            );
    $include ||= [keys %$all_meta];
    $exclude ||= [qw(comment username
         __categories__checksum __locales__checksum)] ;

    my %metadata = map {$_,$all_meta->{$_}} @$include;
    delete $metadata{$_} for @$exclude;

    join $self->{metadata_separator},
        map {"$_='".join (',',sort @{$metadata{$_}})."'"}
            sort keys %metadata;
}

sub content_escape {
    my $self = shift;
    my ($str) = validate_pos( @_, { type => SCALAR } );

    $str =~ s/&/&/g;
    $str =~ s/
    $str =~ s/>/>/g;
    $str =~ s!\s*?\n!\n!gs;

    $str;
}

sub intradiff {
    my $self = shift;
    my ($str1,$str2) = validate_pos( @_, {type => SCALAR|UNDEF },
                                         {type => SCALAR|UNDEF });

    return (qq{$str1},"") unless $str2;
    return ("",qq{$str2}) unless $str1;
    my $re_wordmatcher = $self->{word_matcher};
    my @diffs = Algorithm::Diff::sdiff([$str1 =~ /$re_wordmatcher/sg]
    	,[$str2 =~ /$re_wordmatcher/sg], sub {$self->get_token(@_)});
    my $out1 = '';
    my $out2 = '';
    my ($mode1,$mode2);

    for (@diffs) {
    	my ($ind,$c1,$c2) = @$_;

	my $newmode1 = $ind =~ /[c\-]/;
	my $newmode2 = $ind =~ /[c+]/;
	$out1 .= '' if $newmode1 && !$mode1;
	$out2 .= '' if $newmode2 && !$mode2;
	$out1 .= '' if !$newmode1 && $mode1;
	$out2 .= '' if !$newmode2 && $mode2;
	($mode1,$mode2) = ($newmode1,$newmode2);
	$out1 .= $c1;
	$out2 .= $c2;
    }
    $out1 .= '' if $mode1;
    $out2 .= '' if $mode2;

    ($out1,$out2);
}

sub get_token {
    my ($self,$str) = @_;

    $str =~ /^(\S*)\s*$/;	# Match all but trailing whitespace

    $1 || $str;
}

1;
__END__