File Coverage

blib/lib/HTML/ExtractText/Extra.pm

Criterion	Covered	Total	%
statement	43	43	100.0
branch	14	18	77.7
condition			n/a
subroutine	10	10	100.0
pod	3	3	100.0
total	70	74	94.5

package HTML::ExtractText::Extra;

use strict;
use warnings;

our $VERSION = '1.001003'; # VERSION

use parent 'HTML::ExtractText';

use Devel::TakeHashArgs;
use Carp qw/croak/;

sub new {
    my $class = shift;

    get_args_as_hash( \@_, \ my %args,
        {   # these are optional with defaults
            whitespace       => 1,
            nbsp             => 1,
        },
    ) or croak $@;

    my $self = $class->SUPER::new;

    $self->$_( $args{$_} ) for keys %args;

    return $self;
}

sub _extract {
    my ( $self, $dom, $selector, $what ) = @_;

    my $want = $what->{ $selector };
    my $find = $want;

    if ( ref $want eq 'ARRAY' ) {
        $find = $want->[0];
    }

    my @results = $dom->find( $find )->map(sub{ $self->_process })->each;

    for ( @results ) {
        $self->nbsp       and tr/\x{00A0}/ /;
        $self->whitespace and s/^\s+|\s+$//g;
        if ( ref $want eq 'ARRAY' ) {
            if ( ref $want->[1] eq 'Regexp' ) {
                s/$want->[1]//g;
            }
            elsif ( ref $want->[1] eq 'CODE' ) {
                $_ = $want->[1]->( $_ );
            }
        }
    }

    return @results;
}

sub whitespace {
    my $self = shift;
    if ( @_ ) { $self->[0]->{WHITESPACE} = shift; }
    return $self->[0]->{WHITESPACE};
}

sub nbsp {
    my $self = shift;
    if ( @_ ) { $self->[0]->{nbsp} = shift; }
    return $self->[0]->{nbsp};
}

q|
I called the janitor the other day to see what he could do about my
dingy linoleum floor. He said he would have been happy to loan me a
polisher, but that he hadn't the slightest idea what he had done with
it. I told him not to worry about it--that as a programmer
it wasn't the first time I had experienced a buffer
allocation failure due to a memory error.
|;

__END__