File Coverage

blib/lib/WWW/HTMLTagAttributeCounter.pm

Criterion	Covered	Total	%
statement	50	57	87.7
branch	15	22	68.1
condition	3	5	60.0
subroutine	11	12	91.6
pod	3	3	100.0
total	82	99	82.8

package WWW::HTMLTagAttributeCounter;

use warnings;
use strict;

our $VERSION = '0.0104';

use LWP::UserAgent;
use HTML::TokeParser::Simple;
use overload q|""| => sub { shift->result_readable };

use base 'Class::Accessor::Grouped';
__PACKAGE__->mk_group_accessors( simple => qw/
    ua
    result
    error
/);

sub new {
    my ( $class, %args ) = @_;

    $args{ua} ||= LWP::UserAgent->new(
        timeout => 30,
        agent   => 'Opera 9.5',
    );

    my $self = bless {}, $class;
    $self->ua( $args{ua} );

    return $self;
}

sub count {
    my ( $self, $where, $what, $type, ) = @_;

    $self->$_(undef)
        for qw/error result/;

    $what = [ $what ]
        unless ref $what eq 'ARRAY';

    defined $type
        or $type = 'tag';

    my $content;
    if ( ref $where eq 'SCALAR' ) {
        $content = $$where;
    }
    else {
        $where =~ m{^https?://}
            or $where = "http://$where";

        my $response = $self->ua->get( $where );

        $response->is_success
            or return $self->_set_error( $response );

        $content = $response->decoded_content;
    }

    return $self->result( $self->_count( $what, $type, $content ) );
}

sub result_readable {
    my $result = shift->result;

    my @out;
    for ( sort keys %$result ) {
        push @out, "$result->{$_} $_";
    }

    return $out[0]
        if @out == 1;

    return (join q|, |, @out[0..$#out-1]) . ' and ' . $out[-1];
}

sub _count {
    my ( $self, $what, $type, $content ) = @_;

    my $p = HTML::TokeParser::Simple->new( \$content );
    my $count = {};
    while ( my $t = $p->get_token ) {
        next
            unless $t->is_start_tag;

        if ( $type eq 'tag' ) {
            for ( @$what ) {
                $t->is_start_tag($_)
                    and $count->{$_}++;
            }
        }
        elsif ( $type eq 'attr') {
            for ( @$what ) {
                defined $t->get_attr($_)
                    and $count->{$_}++;
            }
        }
    }

    defined $count->{$_}
        or $count->{$_} = 0
            for @$what;

    return $count;
}

sub _set_error {
    my ( $self, $response ) = @_;
    $self->error('Network error: ' . $response->status_line );
    return;
}

1;
__END__