File Coverage

blib/lib/MetaCPAN/API.pm

Criterion	Covered	Total	%
statement	74	74	100.0
branch	21	22	95.4
condition	6	8	75.0
subroutine	17	17	100.0
pod	2	2	100.0
total	120	123	97.5

use strict;
use warnings;
package MetaCPAN::API;
# ABSTRACT: A comprehensive, DWIM-featured API to MetaCPAN (DEPRECATED)
$MetaCPAN::API::VERSION = '0.50';
use Moo;
use Types::Standard qw;
use namespace::autoclean;

use Carp;
use JSON;
use Try::Tiny;
use HTTP::Tiny;
use URI::Escape 'uri_escape';

with qw/
    MetaCPAN::API::Author
    MetaCPAN::API::Distribution
    MetaCPAN::API::Favorite
    MetaCPAN::API::File
    MetaCPAN::API::Autocomplete
    MetaCPAN::API::Module
    MetaCPAN::API::POD
    MetaCPAN::API::Rating
    MetaCPAN::API::Release
    MetaCPAN::API::Source
/;

has base_url => (
    is      => 'ro',
    isa     => Str,
    default => sub{'http://api.metacpan.org/v0'},
);

has ua => (
    is  => 'ro',
    lazy => 1,
    builder => '_build_ua',
    isa => InstanceOf['HTTP::Tiny'],
);

has ua_args => (
    is      => 'ro',
    isa     => ArrayRef,
    default => sub {
        my $version = $MetaCPAN::API::VERSION || 'xx';
        return [ agent => "MetaCPAN::API/$version" ];
    },
);

sub _build_ua {
    my $self = shift;
    return HTTP::Tiny->new( @{ $self->ua_args } );
}

sub fetch {
    my $self    = shift;
    my $url     = shift;
    my $extra   = $self->_build_extra_params(@_);
    my $base    = $self->base_url;
    my $req_url = $extra ? "$base/$url?$extra" : "$base/$url";

    my $result  = $self->ua->get($req_url);
    return $self->_decode_result( $result, $req_url );
}

sub post {
    my $self  = shift;
    my $url   = shift;
    my $query = shift;
    my $base  = $self->base_url;

    defined $url
        or croak 'First argument of URL must be provided';

    ref $query and ref $query eq 'HASH'
        or croak 'Second argument of query hashref must be provided';

    my $query_json = to_json( $query, { canonical => 1 } );
    my $result     = $self->ua->request(
        'POST',
        "$base/$url",
        {
            headers => { 'Content-Type' => 'application/json' },
            content => $query_json,
        }
    );

    return $self->_decode_result( $result, $url, $query_json );
}

sub _decode_result {
    my $self = shift;
    my ( $result, $url, $original ) = @_;
    my $decoded_result;

    ref $result and ref $result eq 'HASH'
        or croak 'First argument must be hashref';

    defined $url
        or croak 'Second argument of a URL must be provided';

    if ( defined ( my $success = $result->{'success'} ) ) {
        my $reason = $result->{'reason'} || '';
        $reason .= ( defined $original ? " (request: $original)" : '' );

        $success or croak "Failed to fetch '$url': $reason";
    } else {
        croak 'Missing success in return value';
    }

    defined ( my $content = $result->{'content'} )
        or croak 'Missing content in return value';

    try   { $decoded_result = decode_json $content }
    catch { croak "Couldn't decode '$content': $_" };

    return $decoded_result;
}

sub _build_extra_params {
    my $self = shift;

    @_ % 2 == 0
        or croak 'Incorrect number of params, must be key/value';
    my %extra = @_;

    # if it's deep, JSON encoding needs to be involved
    if (scalar grep { ref } values %extra) {
        my $query_json = to_json( \%extra, { canonical => 1 } );
        %extra = ( source => $query_json );
    }

    my $extra = join '&', map {
        "$_=" . uri_escape( $extra{$_} )
    } sort keys %extra;

    return $extra;
}

1;

__END__