File Coverage

blib/lib/HTML/ExtractText.pm

Criterion	Covered	Total	%
statement	85	86	98.8
branch	28	32	87.5
condition	12	15	80.0
subroutine	19	20	95.0
pod	7	7	100.0
total	151	160	94.3

package HTML::ExtractText;

use strict;
use warnings;

our $VERSION = '1.002002'; # VERSION

use Try::Tiny;
use Scalar::Util qw/blessed/;
use Carp qw/croak/;
use Devel::TakeHashArgs;
use Mojo::DOM;
use overload q|""|  => sub { shift->error        },
             q|%{}| => sub { shift->last_results };

sub new {
    my $self = bless [], shift;
    get_args_as_hash( \@_, \ my %args,
        {   # these are optional with defaults
            separator        => "\n",
            ignore_not_found => 1,
        },
        [ ], # these are mandatory (none, ATM)
        [ qw/separator ignore_not_found/ ], # only these args are valid ones
    ) or croak $@;

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

    return $self;
}

sub extract {
    my ( $self, $what, $html, $obj ) = @_;

    $self->error( undef );
    $self->last_results( undef );

    ref $what eq 'HASH'
        or return $self->_set_error('First argument to '
                . 'extract_text() must be a hashref');

    defined $html
        or return $self->_set_error('Second argument to extract_text() is '
                    . 'an undef, expected HTML');

    if ( defined $obj ) {
        blessed $obj
           or return $self->_set_error('Third argument must be an object');

        for ( keys %$what ) {
            $obj->can($_)
                or return $self->_set_error(
                    'The object your provided does not implement the ->'
                    . $_ . '() method that you requested in the first'
                    . ' argument',
                );
        }
    }


    my $dom = Mojo::DOM->new( $html );

    my $did_have_error = 0;
    for my $selector ( sort keys %$what ) {
        my $result;

        try {
            my @results
            = $dom->find( $what->{ $selector } )->map(sub{
                my $tag = $_->tag;
                return $_->all_text unless $tag =~ /input|img/;

                return $_->attr('alt')//''
                    if $tag eq 'img' or
                    ($tag eq 'input' and ($_->attr('type')//'') eq 'image');

                return $_->attr('value')//'';
            })->each;

            $self->extra_processing( \@results, $dom, $selector, $what );

            die "NOT FOUND\n"
                if not @results and not $self->ignore_not_found;

            if ( defined (my $sep = $self->separator) ) {
                $result = join $sep, @results;
            }
            else {
                $result = [ @results ];
            }

        } catch {
            chomp($_);
            $self->error("ERROR: [$selector]: $_");
            $result = "ERROR: $_";
            $did_have_error = 1;
        };

        $what->{ $selector } = $result;
    }

    if ( defined $obj ) {
        for ( keys %$what ) {
            $obj->$_( $what->{ $_ } );
        }
    }

    $self->last_results( $what );

    if ( $did_have_error ) {
        return;
    }
    else {
        return $what;
    }
}

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

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

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

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

sub _set_error {
    my ( $self, $error ) = @_;
    $self->error( $error );
    return;
}

sub extra_processing {
    # this is for overriding in subclasses
}



q|
Programming is 10% science, 20% ingenuity,
and 70% getting the ingenuity to work with the science.
|;

__END__