File Coverage

blib/lib/HTML/Similarity.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package HTML::Similarity;

use strict;
use warnings;
use Data::Dumper;

use HTML::DOM;
use Algorithm::LCS;

sub new {
    my $class = shift;
    bless {
	   dom_x => new HTML::DOM,
	   dom_y => new HTML::DOM,
	   lcs => Algorithm::LCS->new,
	  } => $class;
}

sub _serialize_tree {
    my $self = shift;
    my $node = shift;

    return unless $node->can('tagName');

    my @serialization;

    push @serialization, $node->tagName;
    for my $d ($node->childNodes) {
	push @serialization, $self->_serialize_tree($d);
    }
    return @serialization;
}

sub calculate_similarity {
    my $self = shift;
    my $x = shift || return 0;
    my $y = shift || return 0;

    my $dom_x = $self->{dom_x};
    my $dom_y = $self->{dom_y};

    $dom_x->open();
    $dom_x->write($x);
    $dom_x->close;

    $dom_y->open();
    $dom_y->write($y);
    $dom_y->close;

    my @seq_x = $self->_serialize_tree($dom_x->documentElement);
    my @seq_y = $self->_serialize_tree($dom_y->documentElement);

    my @lcs = $self->{lcs}->LCS(\@seq_x, \@seq_y);
    return 2 * (scalar @lcs) / (scalar(@seq_x) + scalar(@seq_y));
}

1;
__END__