File Coverage

blib/lib/WWW/XKCD/AsText.pm

Criterion	Covered	Total	%
statement	59	67	88.0
branch	19	26	73.0
condition	21	35	60.0
subroutine	11	12	91.6
pod	2	2	100.0
total	112	142	78.8

package WWW::XKCD::AsText;

use warnings;
use strict;

our $VERSION = '0.003';

use Carp;
use URI;
use LWP::UserAgent;
use HTML::TokeParser::Simple;
use HTML::Entities;
use base 'Class::Data::Accessor';
__PACKAGE__->mk_classaccessors( qw(
    ua
    timeout
    uri
    error
    text
));

sub new {
    my $class = shift;
    croak "Must have even number of arguments to new()"
        if @_ & 1;

    my %args = @_;
    $args{ +lc } = delete $args{ $_ } for keys %args;

    $args{timeout} ||= 30;
    $args{ua} ||= LWP::UserAgent->new(
        timeout => $args{timeout},
        agent   => 'Mozilla/5.0 (X11; U; Linux x86_64; en-US; rv:1.8.1.12)'
                    .' Gecko/20080207 Ubuntu/7.10 (gutsy) Firefox/2.0.0.12',
    );

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

    return $self;
}

sub retrieve {
    my ( $self, $id ) = @_;
    croak "Undefined ID argument to retrieve()"
        unless defined $id;

    $id =~ s/\s+//g;

    croak "ID number... must be a NUMBER"
        if $id =~ /\D/;

    $self->$_(undef)
        for qw(uri text error);

    my $comic_uri = $self->uri( URI->new("http://xkcd.com/$id/") );

    my $text_uri = URI->new('http://www.ohnorobot.com/transcribe.pl');
    $text_uri->query_form(
        comicid => 'apKHvCCc66NMg',
        url     => $comic_uri,
    );

    my $response = $self->ua->get( $text_uri );
    if ( $response->is_success ) {
        my $final_text = $self->_parse( $response->content );
        $final_text =~ s/\s*\n\s*/\n\n/g;
        return $final_text;
    }
    else {
        return $self->_set_error('Network error: ' . $response->status_line);
    }
}

sub _parse {
    my ( $self, $content ) = @_;
    my $parser = HTML::TokeParser::Simple->new( \$content );

    my %nav = (
        get_text_from_textarea => 0,
        level               => 0,
        look_for_p          => 0,
        is_p                => 0,
    );
    my $text = '';
    while ( my $t = $parser->get_token ) {
        if (
            $t->is_start_tag('textarea')
            and defined $t->get_attr('name')
            and $t->get_attr('name') eq 'transcription'
        ) {
            @nav{ qw(get_text_from_textarea  level) } = ( 1, 1 );
        }
        elsif ( $t->is_start_tag('td') ) {
            @nav{ qw(look_for_p  level) } = ( 1, 2 );
        }
        elsif (
            $nav{look_for_p} == 1
            and $t->is_text
            and $t->as_is =~ /Here's the transcription for this comic/
        ) {
            @nav{ qw(look_for_p  level) } = ( 2, 3 );
        }
        elsif ( $nav{look_for_p} == 2 and $t->is_start_tag('p') ) {
            @nav{ qw(is_p level) } = ( 1, 4 );
        }
        elsif ( $nav{is_p} and $t->is_text ) {
            $text .= $t->as_is;
        }
        elsif ( $nav{is_p} and $t->is_start_tag('BR') ) {
            $text .= "\n";
        }
        elsif ( $nav{is_p} and $t->is_end_tag('p') ) {
            return $self->text( decode_entities($text) );
        }
        elsif ( $nav{get_text_from_textarea} == 1
            and $t->is_end_tag('textarea')
        ) {
            return $self->_set_error(
                q|Doesn't seem to be any text for this comic|
            );
        }
        elsif ( $nav{get_text_from_textarea} == 1 and $t->is_text ) {
            return $self->text( decode_entities($t->as_is) );
        }
    }
    return $self->_set_error(q|Doesn't seem to be any text for this comic|);
}

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


1;
__END__