No description
This repository has been archived on 2026-08-22. You can view files and clone it, but you cannot make any changes to its state, such as pushing and creating new issues, pull requests or comments.
  • Perl 82.4%
  • Raku 17.6%
Find a file
Repository files (latest commit first)
Filename Latest commit message Latest commit date
2017-04-12 09:52:41 +02:00
lib/Mojo Converted to mojolicious 2017-04-12 09:52:41 +02:00
t git ship start 2017-04-11 20:52:57 +02:00
.gitignore git ship start 2017-04-11 20:52:57 +02:00
.perltidyrc Add basic repo files 2017-04-11 20:54:25 +02:00
.ship.conf git ship start 2017-04-11 20:52:57 +02:00
.travis.yml Add basic repo files 2017-04-11 20:54:25 +02:00
Changes git ship start 2017-04-11 20:52:57 +02:00
cpanfile git ship start 2017-04-11 20:52:57 +02:00
MANIFEST.SKIP git ship start 2017-04-11 20:52:57 +02:00
README.pod git ship start 2017-04-11 20:52:57 +02:00

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;