File Coverage

blib/lib/WWW/GetPageTitle.pm

Criterion	Covered	Total	%
statement	15	33	45.4
branch	0	10	0.0
condition	0	3	0.0
subroutine	5	7	71.4
pod	2	2	100.0
total	22	55	40.0

package WWW::GetPageTitle;

use warnings;
use strict;

our $VERSION = '0.0104';

use LWP::UserAgent;
use HTML::Entities;
use base 'Class::Data::Accessor';
__PACKAGE__->mk_classaccessors( qw/
    error
    title
    ua
    uri
/);

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

    $self->ua(
        $args{ua}
        ||
        LWP::UserAgent->new(
            agent    => "Mozilla",
            timeout  => 30,
            max_size => 2000,
        )
    );

    return $self;
}

sub get_title {
    my ( $self, $uri ) = @_;

    $uri = "http://$uri"
        unless $uri =~ m{^(?:https?|ftps?)://}i;

    $self->uri( $uri );

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

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

    unless ( $response->is_success ) {
        $self->error("Network error: " . $response->status_line );
        return;
    }

    my $title = $response->title;

    unless ( defined $title ) {
        ( $title ) = $response->decoded_content =~ m|]*>(.+?)|si;
        decode_entities( $title )
            if defined $title;
    }

    $title = 'N/A'
        unless defined $title;

    return $self->title( $title );
}

1;
__END__