File Coverage

blib/lib/HTML/AsText/Fix.pm

Criterion	Covered	Total	%
statement	42	46	91.3
branch	14	18	77.7
condition	4	13	30.7
subroutine	9	9	100.0
pod	3	3	100.0
total	72	89	80.9

package HTML::AsText::Fix;
# ABSTRACT: extends HTML::Element::as_text() to render text properly

use strict;
use warnings;

use HTML::Tree;
use Monkey::Patch qw(:all);

our $VERSION = '0.003'; # VERSION


my $block_tags = {
    map { $_ => 1 } qw(
        p
        h1 h2 h3 h4 h5 h6
        dl dt dd
        ol ul li
        dir
        address
        blockquote
        center
        del
        div
        hr
        ins
        noscript script
        pre
    )
};

my $nillio = [];


sub as_text {

    # Yet another iteratively implemented traverser
    my ( $this, %options ) = @_;
    my $skip_dels = $options{'skip_dels'} || 0;
    my $lf = defined( $options{'lf_char'} )
        ? $options{'lf_char'}
        : $/;
    my $zwsp = defined( $options{'zwsp_char'} )
        ? $options{'zwsp_char'}
        : "\x{200b}";                    # zero-width space (ZWSP)

    my (@pile) = ($this);
    my $tag;
    my $text = '';
    while (@pile) {
        if ( !defined( $pile[0] ) ) {    # undef!
                                         # no-op
        }
        elsif ( !ref( $pile[0] ) ) {     # text bit!  save it!
            $text .= shift @pile;
        }
        else {                           # it's a ref -- traverse under it
            $this = shift @pile;
            $tag = $this->{'_tag'};
            my @rest = @{ $this->{'_content'} || $nillio };

            if ( exists $block_tags->{$tag} ) {
                push @rest, $lf;
            }
            elsif ( $tag eq 'br' ) {
                push @rest, $lf;
            }
            else {
                push @rest, $zwsp;
            }

            unshift @pile, @rest
                unless $tag eq 'style'
                    or $tag eq 'script'
                    or ( $skip_dels and $tag eq 'del' );
        }
    }

    if ( $options{'trim'} ) {
        my $extra_chars = $options{'extra_chars'} || '';
        $text =~ s/[\n\r\f\t\x{a0}${extra_chars}\x{20}]+$//sx;
        $text =~ s/^[\n\r\f\t\x{a0}${extra_chars}\x{20}]+//sx;
        $text =~ s/[\x{a0}${extra_chars}\x{20}]/ /gx;
    }

    return $text;
}


sub global {
    my ( %options ) = @_;
    return patch_package 'HTML::Element', as_text => sub {
        shift; # $original
        as_text( @_, %options );
    };
}


sub object {
    my ( $obj, %options ) = @_;
    return patch_object $obj, as_text => sub {
        shift; # $original
        my $self = shift;
        as_text( $self, @_, %options );
    };
}


1;

__END__