File Coverage

blib/lib/CCCP/HTML/Truncate.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 CCCP::HTML::Truncate;

use strict;
use warnings;

use XML::LibXML;
use Encode qw();

our $VERSION = '0.04';

$CCCP::HTML::Truncate::enc = 'utf-8';

# ------------------------ EXTEND XML::LibXML::Element -----------------
# return serialize XML::LibXML::Element in correct encoding
sub XML::LibXML::Element::html {
    my ($node, $actualEncoding) = @_;

    # correct decode
    my $f = Encode::find_encoding($CCCP::HTML::Truncate::enc || $node->ownerDocument->encoding() || $node->ownerDocument->actualEncoding());

    return $f->encode($node->toString,Encode::FB_XMLCREF);
}

# ---------------------------------------- MAIN --------------------------------------------

# parser obj
my $lx;

sub _init_parser {
    return if $lx;
    $lx = XML::LibXML->new();
    $lx->recover_silently(1);
}

# truncate html
sub truncate {
    my ($class,$html_str,$length,$elips) = @_;

    return unless $html_str;

    $elips ||= "...";

    $length ||= 0;
    $length =~ /(\d+)/;
    $length = $1 ? $1 : 0;
    return '' unless $length;
    $html_str =~ s/&/&/gm;
    return $html_str if length $html_str < $length;

    my $f = Encode::find_encoding($CCCP::HTML::Truncate::enc);
    $html_str = $f->decode($html_str);
    $elips = $f->decode($elips);

    $class->_init_parser();
    my $root = $lx->parse_html_string($html_str);
    my ($body) = $root->documentElement()->findnodes('//body');
    return '' unless $body;

    my $add_elips = 0;
    foreach ($body->ownerDocument->findnodes('//child::text()')) {
        if ($length>0) {
            my $str = $_->to_literal;
            my $new_str = substr($str,0,$length);
            $length -= length $str;
            if ($length < 1 and not $add_elips) {
                $new_str .= $elips;
                $add_elips++;
                # and skip all another text child
                my $text_parent = $_->parentNode;
                if ($_->nodePath =~ /\[(\d+)]$/) {
                    foreach my $skip_text ($text_parent->findnodes(sprintf('//child::text()[position()>%d]',$1))) {
                        $_->setData('');
                    };
                }
            };
            $_->setData($new_str);
        } else {
            my $parent = $_->parentNode;
            # add elips
            unless ($add_elips) {
                $add_elips++;
                my $elips_el = XML::LibXML::Element->new('span');
                $elips_el->appendTextNode($elips);
                $parent->addChild($elips_el);
            };
            # skip body
            if ($parent->isSameNode($body)) {
                $_->unbindNode();
            } else {
                my @childs = $parent->findnodes($parent->nodePath.'//child::text()');
                $#childs > 0 ? $_->unbindNode() : $parent->unbindNode();
            }
        }
    };

    my $ret = $body->html();
    $ret =~ s/^()?|(<\/p>)?<\/body>$//igm;
    return $ret;
}

1;
__END__