No description
- Perl 82.4%
- Raku 17.6%
| Filename | Latest commit message | Latest commit date |
|---|---|---|
| lib/Mojo | ||
| t | ||
| .gitignore | ||
| .perltidyrc | ||
| .ship.conf | ||
| .travis.yml | ||
| Changes | ||
| cpanfile | ||
| MANIFEST.SKIP | ||
| README.pod | ||
package Mojo::MetaCPAN;
use Mojo::Base -base;
use Carp 'croak';
use MetaCPAN::Client::Pod;
use MetaCPAN::Client::ResultSet;
use Mojo::Loader 'load_class';
use Mojo::UserAgent;
use Mojo::Util 'url_escape';
our $TODAY_FILTER = {range => {date => {from => "now/1d+0h"}}};
our $VERSION = '0.01';
has ua => sub { Mojo::UserAgent->new->max_redirects(3) };
sub all {
my $self = shift;
my $type = shift || 'missing';
my $params = shift;
croak 'all: unsupported type "$type"'
unless grep { $type eq $_ } qw(authors distributions modules releases favorites ratings mirrors files);
croak "all: params must be a hashref" unless $params and ref $params eq 'HASH';
$type =~ s/s$//;
return $self->$type({__MATCH_ALL__ => 1}, $params, @_);
}
sub author { shift->_get_or_search(author => @_); }
sub autocomplete {
my $cb = ref $_[-1] eq 'CODE' ? pop : undef;
my $self = shift;
my $q = shift;
my $res;
state $process = sub {
[map { $_->{fields} } @{$_[0]->{hits}{hits}}];
};
# blocking
return $process->($self->_fetch('/search/autocomplete?q=' . url_escape($q))) unless $cb;
# non-blocking
return $self->_fetch(
'/search/autocomplete?q=' . url_escape($q),
sub {
my ($self, $err, $res) = @_;
$self->$fcb($err, $err ? [] : $process->($res));
}
);
}
sub distribution { shift->_get_or_search(distribution => @_); }
sub download_url { shift->_get(download_url => @_); }
sub favorite { shift->_get_or_search(favorite => @_); }
sub file { shift->_get_or_search(file => @_); }
sub mirror { shift->_get_or_search(mirror => @_); }
sub module { shift->_get_or_search(module => @_); }
sub permission { shift->_get_or_search(permission => @_); }
sub pod {
my $self = shift;
my $name = shift;
my $params = shift || {};
# TODO
return MetaCPAN::Client::Pod->new({request => $self->request, name => $name, %$params});
}
sub rating { shift->_get_or_search(rating => @_); }
sub recent {
my $self = shift;
my $size = shift || 100;
return $self->_recent(size => 1000, filter => $TODAY_FILTER, @_) if $size eq 'today';
return $self->_recent(size => $size, @_);
}
sub release { shift->_get_or_search(release => @_); }
sub rev_deps {
my $cb = ref $_[-1] eq 'CODE' ? pop : undef;
my ($self, $dist) = (shift, shift);
$dist =~ s/::/-/g;
state $process = sub {
return (items => $_[0]->{hits}{hits}, type => 'release');
};
my @fetch = (
"/search/reverse_dependencies/$dist",
{
size => 5000,
query => {match_all => {}},
filter => {and => [{term => {'status' => 'latest'}}, {term => {'authorized' => 1}},]},
}
);
# blocking
return MetaCPAN::Client::ResultSet->new($process->($self->_fetch(@fetch))) unless $cb;
# non-blocking
return $self->_fetch(
@fetch,
sub {
my ($self, $err, $res) = @_;
$self->$cb($err, $err ? undef : MetaCPAN::Client::ResultSet->new($process->($res)));
}
);
}
sub _get {
my $cb = ref $_[-1] eq 'CODE' ? pop : undef;
my $self = shift;
my $type = shift;
my $arg = shift;
my $params = shift;
my $fields_filter = $self->_read_fields($params);
my $response = $self->_fetch(sprintf("%s/%s%s", $type, $arg, $fields_filter || ''), $cb);
$type = 'DownloadURL' if $type eq 'download_url';
my $class = 'MetaCPAN::Client::' . ucfirst($type);
my $e = load_class $class;
die $e if $e;
return $class->new_from_request($response, $self);
}
sub _read_fields {
my $self = shift;
my $params = shift;
$params or return;
my $fields = delete $params->{fields};
$fields or return;
if (ref $fields eq 'ARRAY') {
grep { ref $_ } @$fields and croak "fields array should not contain any refs.";
return sprintf("?fields=%s", join q{,} => @$fields);
}
elsif (!ref $fields) {
return "?fields=$fields";
}
croak "invalid param: fields";
}
sub _search {
my $self = shift;
my $type = shift;
my $args = shift;
my $params = shift;
$params ||= {};
my $scroller = $self->ssearch($type, $args, $params);
return MetaCPAN::Client::ResultSet->new(scroller => $scroller, type => $type,);
}
sub _get_or_search {
my $self = shift;
my $type = shift;
my $arg = shift;
my $params = shift;
ref $arg eq 'HASH' and return $self->_search($type, $arg, $params);
defined $arg and !ref($arg) and return $self->_get($type, $arg, $params);
croak "$type: invalid args (takes scalar value or search parameters hashref)";
}
sub _recent {
my $self = shift;
my @args = @_;
my $res;
eval {
$res
= $self->fetch('/release/_search',
{from => 0, query => {match_all => {}}, @args, sort => [{'date' => {order => "desc"}}],});
1;
} or do {
warn $@;
return _empty_result_set('release');
};
return MetaCPAN::Client::ResultSet->new(items => $res->{'hits'}{'hits'}, type => 'release',);
}
sub _empty_result_set {
my $type = shift;
return MetaCPAN::Client::ResultSet->new(items => [], type => $type,);
}
1;