File Coverage

blib/lib/PerlIO/via/StripHTML.pm

Criterion	Covered	Total	%
statement	27	27	100.0
branch	9	12	75.0
condition	2	3	66.6
subroutine	9	9	100.0
pod	0	2	0.0
total	47	53	88.6

package PerlIO::via::StripHTML;

require 5.008;
use strict;
use warnings;
use HTML::Parser 3.00;

our $VERSION = 0.04;

sub PUSHED {
    my ($class, $mode) = @_;
    return -1 if $mode ne 'r';
    # The following variables are updated / accessed via the closures below
    my $buffer = ''; # internal buffer for this layer
    my %inside = ();
    bless {
	buffer => sub : lvalue { $buffer },
	parser => new HTML::Parser(
	    api_version => 3,
	    marked_sections => 1,
	    start_h => [
		sub {
		    $buffer .= "\n"   if $_[0] =~ /^[bt]r$/;
		    $buffer .= "\n\n" if $_[0] eq 'p';
		    ++$inside{$_[0]};
		},
		'tagname',
	    ],
	    end_h => [
		sub { --$inside{$_[0]} },
		'tagname',
	    ],
	    text_h => [
		sub {
		    $buffer .= $_[0] unless $inside{script} || $inside{style};
		},
		'dtext',
	    ],
	),
    }, $class;
}

sub FILL {
    my ($self, $fh) = @_;
    my $line = <$fh>;
    return undef unless defined $line;
    $self->{buffer}->() = '';
    $self->{parser}->parse($line) or return undef;
    $self->{parser}->eof;
    return $self->{buffer}->();
}

1;

__END__