File Coverage

blib/lib/Catmandu/Importer/getJSON.pm

Criterion	Covered	Total	%
statement	94	104	90.3
branch	37	52	71.1
condition	9	21	42.8
subroutine	23	24	95.8
pod	4	4	100.0
total	167	205	81.4

package Catmandu::Importer::getJSON;

our $VERSION = '0.50';
our $CACHE;

use Catmandu::Sane;
use Moo;
use JSON;
use Furl;
use Scalar::Util qw(blessed);
use URI::Template;

with 'Catmandu::Importer';

has url     => (
    is  => 'rw',
    trigger => sub {
        $_[0]->{url} = _url_template_or_url($_[1])
    }
);

has from    => ( is => 'ro');
has timeout => ( is => 'ro', default => sub { 10 } );
has agent   => ( is => 'ro' );
has proxy   => ( is => 'ro' );
has dry     => ( is => 'ro' );
has headers => (
    is => 'ro',
    default => sub { [ 'Accept' => 'application/json' ] }
);
has wait    => ( is => 'ro' );
has cache   => ( is => 'ro', trigger => 1 );
has client  => (
    is => 'ro',
    lazy => 1,
    builder => sub {
        Furl->new(
            map { $_ => $_[0]->{$_} } grep { defined $_[0]->{$_} }
            qw(timeout agent proxy),
        )
    }
);
has json => ( is => 'ro', default => sub { JSON->new->utf8(1) } );
has time => ( is => 'rw' );
has warn => ( is => 'ro', default => sub { 1 } );

sub _url_template_or_url {
    my ($url) = @_;

    if (!blessed $url) {
        $url = URI::Template->new($url);
    }

    if ($url->isa('URI::Template')) {
        unless ( my @variables = $url->variables ) {
            $url = URI->new("$url");
        }
    }
    return $url;
}


{
    package Importer::getJSON::MemoryCache;
    use JSON;
    our $JSON = JSON->new->utf8;
    sub new { bless {}, $_[0] }
    sub get { eval { $JSON->decode($_[0]->{$_[1]}) } }
    sub set { $_[0]->{$_[1]} = ref $_[2] ? $JSON->encode($_[2]) : '' }
}
$CACHE = Importer::getJSON::MemoryCache->new;

{
    package Importer::getJSON::FileCache;
    use JSON;
    use Catmandu::Util qw(read_json);
    use Digest::MD5 qw(md5_hex);
    our $JSON = JSON->new->utf8;
    sub new {
        my ($class, $dir) = @_;
        $dir =~ s{/$}{};
        bless { dir => $dir }, $class
    }
    sub file {
        my ($self, $url) = @_;
        $self->{dir}.'/'.md5_hex($url).'.json';
    }
    sub get { eval { read_json($_[0]->file($_[1])) } }
    sub set {
        my ($self, $url, $data) = @_;
        open my $fh, ">", $self->file($url);
        print $fh (ref $data ? $JSON->encode($data) : '');
    }
}

sub _trigger_cache {
    my ($self, $cache) = @_;

    if (blessed $cache and $cache->can('get') and $cache->can('set')) {
        # use cache object
    } elsif ($cache and -d $cache) {
        $cache = Importer::getJSON::FileCache->new($cache);
    } elsif ($cache) {
        $cache = $CACHE;
    }

    $self->{cache} = $cache;
}

sub generator {
    my ($self) = @_;

    if ($self->from) {
        return sub {
            state $data = do {
                my $r = $self->request($self->from);
                (ref $r // '') eq 'ARRAY' ? $r : [$r];
            };
            return shift @$data;
        }
    }

    sub {
        state $fh = $self->fh;
        state $data;

        if ( $data and ref $data eq 'ARRAY' and @$data ) {
            return shift @$data;
        }

        my $url;
        until ( $url ) {
            my $line = <$fh> // return;
            chomp $line;
            $line =~ s/^\s+|\s+$//g;
            next if $line eq ''; # ignore empty lines

            my $request = eval { $self->request_hook($line) };
            $url = $self->construct_url($request);
            warn "failed to construct URL: $line\n" if !$url and $self->warn;
        }

        $data = $self->request($url);

        return (ref $data // '') eq 'ARRAY' ? shift @$data : $data;
    }
}

sub request_hook {
    my ($self, $line) = @_;
    return $line =~ /^\s*{/ ? $self->json->decode($line) : $line;
}

sub construct_url {
    my $self    = shift;
    my $url     = @_ > 1 ? _url_template_or_url(shift) : $self->url;
    my $request = shift;

    # Template or query variables
    if (ref $request and not blessed $request) {
        return unless blessed $url;
        if ($url->isa('URI::Template')) {
            $url = $url->process($request);
        } else {
            $url = $url->clone;
            $url->query_form($request);
        }
        return $url;
    } elsif (blessed $request and $request->isa('URI::URL')) {
        return $request;
    } elsif ( $request =~ /^https?:\/\// ) { # plain URL
        return URI->new($request);
    } elsif ( $request  =~ /^\// ) { # URL path (and optional query)
        $url = "$url";
        $url =~ s{/$}{};
        $request =~ s{\s+$}{};
        return URI->new($url . $request);
    }

    return;
}

sub request {
    my ($self, $url) = @_;

    $self->log->debug($url);

    my $json = '';

    if ( $self->dry ) {
        return { url => "$url" };
    }

    if ( $self->cache ) {
        $json = $self->cache->get($url);
        if (defined $json) {
            return ref $json ? $json : undef;
        }
    }

    if ( $self->wait and $self->time ) {
        my $elapsed = ($self->time // time) - time;
        sleep( $self->wait - $elapsed );
    }
    $self->time(time);

    my $response = $self->client->get($url, $self->headers);
    if ($response->is_success) {
        my $content = $response->decoded_content;
        my $data    = $self->json->decode($content);
        $json       = $self->response_hook($data);
     } else {
        warn "request failed: $url\n" unless !$self->warn;
        if ($response->status =~ /^4/) {
            $json = '';
        } else {
            return;
        }
    }

    if ( $self->cache ) {
        $self->cache->set($url, $json);
    }

    return ref $json ? $json : undef;
}

sub response_hook { $_[1] }

1;
__END__