File Coverage

blib/lib/HTML/Feature/Engine/TagStructure.pm

Criterion	Covered	Total	%
statement	121	125	96.8
branch	19	32	59.3
condition	17	36	47.2
subroutine	10	10	100.0
pod	1	1	100.0
total	168	204	82.3

package HTML::Feature::Engine::TagStructure;
use strict;
use warnings;
use base qw(HTML::Feature::Engine);
use HTML::TreeBuilder;
use Statistics::Lite qw(statshash);
use HTML::Feature::Result;

sub run {
    my $self = shift;
    my $c    = shift;
    my $html_ref = shift;
    $self->_tag_cleaning($c, $html_ref);
    return $self->_score($c, $html_ref);
}

sub _tag_cleaning {
    my $self = shift;
    my $c    = shift;
    my $html_ref = shift;
    return unless $html_ref && $$html_ref;

    # preprocessing
    $$html_ref =~ s{}{}xmsg;
    $$html_ref =~ s{]*>.*?<\/script>}{}xmgs;
    $$html_ref =~ s{ }{ }xmg;
    $$html_ref =~ s{"}{\'}xmg;
    $$html_ref =~ s{\r\n}{\n}xmg;
    $$html_ref =~ s{^\s*(.+)$}{$1}xmg;
    $$html_ref =~ s{^\t*(.+)$}{$1}xmg;

    # control code ( 0x00 - 0x1F, and 0x7F on ascii)
    for ( 0 .. 31 ) {
        my $control_code = '\x' . sprintf( "%x", $_ );
        $$html_ref =~ s{$control_code}{}xmg;
    }
    $$html_ref =~ s{\x7f}{}xmg;
}

sub _score {
    my $self = shift;
    my $c    = shift;
    my $html_ref = shift;
    my $root = HTML::TreeBuilder->new_from_content( $$html_ref );
    my $result = HTML::Feature::Result->new;

    my $data;

    if ( my $title = $root->find("title") ) {
        $result->title($title->as_text);
    }

    if ( my $desc = $root->look_down( _tag => 'meta', name => 'description' ) )
    {
        my $string = $desc->attr('content');
        $string =~ s{}{}xms;
        $result->desc($string);
    }

    my $i = 0;
    my @ratio;
    my @depth;
    my @order;
    my $CACHE = $c->{cache} ? {} : undef;
    for my $node ( $root->look_down( "_tag", qr/body|center|td|div/i ) ) {
        my $html_length = bytes::length( $node->as_HTML );
        my $text        = $node->as_text;
        my $text_length = bytes::length($text);
        my $text_ration = $text_length / ( $html_length + 0.001 );

        next
          if (  $c->{max_bytes}
            and $c->{max_bytes} =~ /^[\d]+$/
            && $text_length > $c->{max_bytes} );
        next
          if (  $c->{min_bytes}
            and $c->{min_bytes} =~ /^[\d]+$/
            and $text_length < $c->{min_bytes} );

        my $a_count       = 0;
        my $a_length      = 0;
        my $option_count  = 0;
        my $option_length = 0;
        my %node_hash = (
            text => '',
            a_length => 0,
            short_string_length => 0
        );

        $self->_walk_tree( $node, \%node_hash, $CACHE );

        $node_hash{a_length}            ||= 0;
        $node_hash{option_length}       ||= 0;
        $node_hash{short_string_length} ||= 0;
        $node_hash{text}                ||= $text;

        next if $node_hash{text} !~ /[^ ]+/;

        $data->[$i]->{text} = $node_hash{text};

        push(
            @ratio,
            (
                $text_length -
                  $node_hash{a_length} -
                  $node_hash{option_length} -
                  $node_hash{short_string_length}
              ) * $text_ration
        );
        push( @depth, $node->depth() );

        $data->[$i]->{element} = $node;

        $i++;
    }
    undef $CACHE;

    for ( 0 .. $i ) {
        push( @order, log( $i - $_ + 1 ) );
    }

    my %ratio = statshash @ratio;
    my %depth = statshash @depth;
    my %order = statshash @order;

    # avoid memory leak
    $root->delete() unless $c->{element_flag};

    my @sorted =
      sort { $data->[$b]->{score} <=> $data->[$a]->{score} }
      map {

        my $ratio_std =
          ( ($ratio[$_] || 0) - ($ratio{mean} || 0) ) / ( $ratio{stddev} + 0.001 );
        my $depth_std =
          ( ($depth[$_] || 0) - ($depth{mean} || 0) ) / ( $depth{stddev} + 0.001 );
        my $order_std =
          ( ($order[$_] || 0) - ($order{mean} || 0) ) / ( $order{stddev} + 0.001 );

        $data->[$_]->{score} = $ratio_std + $depth_std + $order_std;
        $_;
      } ( 0 .. $i );
    $data->[ $sorted[0] ]->{text} =~ s/ $//s;

    $result->text($data->[ $sorted[0] ]->{text});

    if ($c->{element_flag}) {
        $result->root($root);
        $result->element($data->[ $sorted[0] ]->{element});
    }

    if ( $c->{enc_type} ) {
        $result->title( Encode::encode( $c->{enc_type}, $result->title ) );
        $result->desc( Encode::encode( $c->{enc_type}, $result->desc ) );
        $result->text( Encode::encode( $c->{enc_type}, $result->text ) );
    }

    return $result;
}

sub _walk_tree {
    my $self          = shift;
    my $node          = shift;
    my $node_hash_ref = shift;
    my $CACHE         = shift;

    my $data = $CACHE->{ $node };
    if ( ! $data) {
        $data = {
            text => '',
            a_length => 0,
            short_string_length => 0,
        };

        if ( ref $node ) {
            my $text_len = bytes::length( $node->as_text );
            my $tag      = $node->tag;
            $data->{text_length} = $text_len;

            if ( $tag =~ /p|br|hr|tr|ul|li|ol|dl|dd/ ) {
                $data->{text} = "\n";
            }
            if ( $tag =~ /a|dt|th|option/) {
                $data->{a_length} += $text_len;
            }

            if ( $text_len < 20 ) {
                $data->{short_string_length} += $text_len;
            }
        }
        else {
            $data->{text} = $node . " ";
        }

        $CACHE->{ $node } = $data;
    }

    $node_hash_ref->{text}                .= $data->{text};
    $node_hash_ref->{a_length}            += $data->{a_length};
    $node_hash_ref->{short_string_length} += $data->{short_string_length};

    if (ref $node) {
        $self->_walk_tree( $_, $node_hash_ref, $CACHE )
            for $node->content_list();
    }

}

1;

__END__