File Coverage

blib/lib/MetaCPAN/API/Tiny.pm

Criterion	Covered	Total	%
statement	113	127	88.9
branch	57	72	79.1
condition	20	37	54.0
subroutine	15	16	93.7
pod	9	9	100.0
total	214	261	81.9

package MetaCPAN::API::Tiny;
{
  $MetaCPAN::API::Tiny::VERSION = '1.131730';
}
use strict;
use warnings;
# ABSTRACT: A Tiny API client for MetaCPAN

use Carp;
use JSON::PP 'encode_json', 'decode_json';
use HTTP::Tiny;


sub new {
    my ($class, @args) = @_;

    $#_ % 2 == 0
        or croak 'Arguments must be provided as name/value pairs';

    my %params = @args;

    die 'ua_args must be an array reference'
        if $params{ua_args} && ref($params{ua_args}) ne 'ARRAY';

    my $self = +{
        base_url => $params{base_url} || 'http://api.metacpan.org/v0',
        ua => $params{ua} || HTTP::Tiny->new(
            $params{ua_args}
                ? @{$params{ua_args}}
                : (agent => 'MetaCPAN::API::Tiny/'
                    . ($MetaCPAN::API::VERSION || 'xx'))),
    };

    return bless($self, $class);
}

sub _build_extra_params {
    my $self = shift;

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

    my %extra = @_;
    my $ua = $self->{ua};

    foreach my $key (keys %extra)
    {
        # The implementation in HTTP::Tiny uses + instead of %20, fix that
        $extra{$key} = $ua->_uri_escape($extra{$key});
        $extra{$key} =~ s/\+/%20/g;
    }

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

    return $params;
}


# /source/{author}/{release}/{path}
sub source {
    my $self  = shift;
    my %opts  = @_ ? @_ : ();
    my $url   = '';
    my $error = "Provide 'author' and 'release' and 'path'";

    %opts or croak $error;

    if (
        defined ( my $author  = $opts{'author'}  ) &&
        defined ( my $release = $opts{'release'} ) &&
        defined ( my $path    = $opts{'path'}    )
      ) {
        $url = "source/$author/$release/$path";
    } else {
        croak $error;
    }

    $url = $self->{base_url} . "/$url";

    my $result = $self->{ua}->get($url);
    $result->{'success'}
        or croak "Failed to fetch '$url': " . $result->{'reason'};

    return $result->{'content'};
}


# /release/{distribution}
# /release/{author}/{release}
sub release {
    my $self  = shift;
    my %opts  = @_ ? @_ : ();
    my $url   = '';
    my $error = "Either provide 'distribution', or 'author' and 'release', " .
                "or 'search'";

    %opts or croak $error;

    my %extra_opts = ();

    if ( defined ( my $dist = $opts{'distribution'} ) ) {
        $url = "release/$dist";
    } elsif (
        defined ( my $author  = $opts{'author'}  ) &&
        defined ( my $release = $opts{'release'} )
      ) {
        $url = "release/$author/$release";
    } elsif ( defined ( my $search_opts = $opts{'search'} ) ) {
        ref $search_opts && ref $search_opts eq 'HASH'
            or croak $error;

        %extra_opts = %{$search_opts};
        $url        = 'release/_search';
    } else {
        croak $error;
    }

    return $self->fetch( $url, %extra_opts );
}


# /pod/{module}
# /pod/{author}/{release}/{path}
sub pod {
    my $self  = shift;
    my %opts  = @_ ? @_ : ();
    my $url   = '';
    my $error = "Either provide 'module' or 'author and 'release' and 'path'";

    %opts or croak $error;

    if ( defined ( my $module = $opts{'module'} ) ) {
        $url = "pod/$module";
    } elsif (
        defined ( my $author  = $opts{'author'}  ) &&
        defined ( my $release = $opts{'release'} ) &&
        defined ( my $path    = $opts{'path'}    )
      ) {
        $url = "pod/$author/$release/$path";
    } else {
        croak $error;
    }

    # check content-type
    my %extra = ();
    if ( defined ( my $type = $opts{'content-type'} ) ) {
        $type =~ m{^ text/ (?: html|plain|x-pod|x-markdown ) $}x
            or croak 'Incorrect content-type provided';

        $extra{headers}{'content-type'} = $type;
    }

    $url = $self->{base_url}. "/$url";

    my $result = $self->{ua}->get( $url, \%extra );
    $result->{'success'}
        or croak "Failed to fetch '$url': " . $result->{'reason'};

    return $result->{'content'};
}


# /module/{module}
sub module {
    my $self = shift;
    my $name = shift;

    $name or croak 'Please provide a module name';

    return $self->fetch("module/$name");
}


# file() is a synonym of module
sub file { goto &module }


# /author/{author}
sub author {
    my $self = shift;
    my ( $pause_id, $url, %extra_opts );

    if ( @_ == 1 ) {
        $url = 'author/' . shift;
    } elsif ( @_ == 2 ) {
        my %opts = @_;

        if ( defined $opts{'pauseid'} ) {
            $url = "author/" . $opts{'pauseid'};
        } elsif ( defined $opts{'search'} ) {
            my $search_opts = $opts{'search'};

            ref $search_opts && ref $search_opts eq 'HASH'
                or croak "'search' key must be hashref";

            %extra_opts = %{$search_opts};
            $url        = 'author/_search';
        } else {
            croak 'Unknown option given';
        }
    } else {
        croak 'Please provide an author PAUSEID or a "search"';
    }

    return $self->fetch( $url, %extra_opts );
}



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 = encode_json( $query );
    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';

    eval { $decoded_result = decode_json $content; 1 }
    or do { croak "Couldn't decode '$content': $@" };

    return $decoded_result;
}

1;

__END__