File Coverage

blib/lib/WWW/xkcd.pm

Criterion	Covered	Total	%
statement	80	80	100.0
branch	22	22	100.0
condition			n/a
subroutine	17	17	100.0
pod	4	4	100.0
total	123	123	100.0

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

my $can_async = try   { require AnyEvent; require AnyEvent::HTTP; 1 }
                catch { 0 };

sub new {
    my $class = shift;
    my %args  = (
        baseurl  => 'http://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
        croak 'AnyEvent and AnyEvent::HTTP are required for async mode'
            unless $can_async;

        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 ref $_[0];

    if ($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 = try   { decode_json $json                }
               catch { croak "Can't decode '$json': $_" };

    return $data;
}

1;

__END__