File Coverage

blib/lib/WWW/xkcd.pm

Criterion	Covered	Total	%
statement	81	81	100.0
branch	22	24	91.6
condition	3	5	60.0
subroutine	14	14	100.0
pod	4	4	100.0
total	124	128	96.8

package WWW::xkcd;
# ABSTRACT: Synchronous and asynchronous interfaces to xkcd comics
$WWW::xkcd::VERSION = '0.009';
use strict;
use warnings;
use Carp;
use JSON::MaybeXS;
use HTTP::Tiny;

my $can_async = eval { require AnyEvent; require AnyEvent::HTTP; 1 };

sub new {
    my $class = shift;
    my %args  = (
        'baseurl'  => 'https://xkcd.com',
        'infopath' => 'info.0.json',
        @_,
    );

    return bless { %args }, $class;
}

sub fetch_metadata {
    my $self           = shift;
    my $base           = $self->{'baseurl'};
    my $path           = $self->{'infopath'};
    my ( $comic, $cb ) = $self->_parse_args(@_);

    my $url = defined $comic ? "$base/$comic/$path" : "$base/$path";

    if ($cb) {
        # this is async
        $can_async
            or croak 'AnyEvent and AnyEvent::HTTP are required for async mode';

        AnyEvent::HTTP::http_get( $url, sub {
            my $body = shift;
            my $meta = $self->_decode_json($body);

            return $cb->($meta);
        } );

        return 0;
    }

    # this is sync
    my $result = HTTP::Tiny->new->get($url);

    $result->{'success'} or croak "Can't fetch $url: " .
        $result->{'reason'};

    my $meta = $self->_decode_json( $result->{'content'} );

    return $meta;
}

sub fetch_random {
    my $self           = shift;
    my $callback       = shift;

    if ( $callback && ref $callback ) {
        $self->fetch_metadata( sub {
            my $metadata = shift;
            my $random   = int(rand($metadata->{'num'})) + 1;
            return $self->fetch($random, $callback);
        } );
        return 0;
    }

    my $metadata       = $self->fetch_metadata;
    my $random         = int(rand($metadata->{'num'})) + 1;
    return $self->fetch($random);
}

sub fetch {
    my $self           = shift;
    my $base           = $self->{'baseurl'};
    my $path           = $self->{'infopath'};
    my ( $comic, $cb ) = $self->_parse_args(@_);

    if ($cb) {
        $self->fetch_metadata( $comic, sub {
            my $meta = shift;
            my $img  = $meta->{'img'};

            AnyEvent::HTTP::http_get( $img, sub {
                my $img_data = shift;

                # call original callback
                return $cb->( $img_data, $meta );
            } );
        } );

        return 0;
    }

    my $meta   = $self->fetch_metadata($comic);
    my $img    = $meta->{'img'};
    my $result = HTTP::Tiny->new->get($img);

    $result->{'success'} or croak "Can't fetch $img: " .
        $result->{'reason'};

    return ( $result->{'content'}, $meta );
}

sub _parse_args {
    my $self = shift;
    my @args = @_;
    my ( $comic, $cb );

    # @_ = $num, $cb
    # @_ = $num
    # @_ = $cb
    if ( @_ == 2 ) {
        ( $comic, $cb ) = @_;
    } elsif ( @_ == 1 ) {
        if ( ref $_[0] ) {
            $cb = $_[0];
        } else {
            $comic = $_[0];
        }
    }

    return ( $comic, $cb );
}

sub _decode_json {
    my $self = shift;
    my $json = shift;
    my $data = {};

    defined $json or $json = '';

    eval { $data = decode_json $json; 1; } or do {
        my $error = $@ || 'Zombie error';
        croak "Can't decode JSON content '$json': $error";
    };

    return $data;
}

1;

__END__