File Coverage

blib/lib/PAUSE/Permissions/MetaCPAN.pm
Criterion Covered Total %
statement 17 72 23.6
branch 0 18 0.0
condition 0 8 0.0
subroutine 6 9 66.6
pod 2 2 100.0
total 25 109 22.9


line stmt bran cond sub pod time code
1             package PAUSE::Permissions::MetaCPAN 0.100;
2 1     1   66247 use v5.16;
  1         4  
3 1     1   6 use warnings;
  1         2  
  1         26  
4              
5 1     1   5 use Carp ();
  1         2  
  1         19  
6 1     1   718 use HTTP::Tiny 0.055;
  1         48075  
  1         39  
7 1     1   760 use IO::Socket::SSL 1.42;
  1         46576  
  1         8  
8 1     1   978 use JSON::PP ();
  1         15364  
  1         679  
9              
10             sub new {
11 0     0 1   my ($class, %args) = @_;
12 0   0       my $http = $args{http} || do {
13             my $agent = sprintf "%s/%s", $class =~ s/::/-/gr, $class->VERSION;
14             HTTP::Tiny->new(verify_SSL => 1, agent => $agent);
15             };
16 0   0       my $url = $args{url} || "https://fastapi.metacpan.org/v1/permission/_search";
17 0           bless { http => $http, url => $url }, $class;
18             }
19              
20             sub get {
21 0     0 1   my ($self, %args) = @_;
22              
23 0 0 0       Carp::croak "either author or modules is required" if !$args{author} && !$args{modules};
24              
25 0 0         if (my $author = $args{author}) {
26 0           my $hit = $self->_query(%args);
27 0           my %hit = (owner => [], co_maintainer => []);
28 0           for my $module (@$hit) {
29 0 0         if ($module->{owner} eq $author) {
30 0           push @{$hit{owner}}, $module;
  0            
31             } else {
32 0           push @{$hit{co_maintainer}}, $module;
  0            
33             }
34             }
35 0           return \%hit;
36             }
37              
38 0           my @hit;
39 0           my @module = @{$args{modules}}; # must copy
  0            
40             # elasticsearch may return "too_many_clauses: maxClauseCount is set to 1024"
41 0           while (my @m = splice @module, 0, 1024) {
42 0           my $hit = $self->_query(modules => \@m);
43 0           push @hit, @$hit;
44             }
45 0           my %hit;
46 0           for my $module (@{$args{modules}}) {
  0            
47 0           my ($found) = grep { $_->{module_name} eq $module} @hit;
  0            
48 0           $hit{$module} = $found;
49             }
50 0           return \%hit;
51             }
52              
53             sub _query {
54 0     0     my ($self, %args) = @_;
55              
56 0           my %bool;
57 0 0         if (my $author = $args{author}) {
    0          
58             $bool{should} = [
59 0           { term => { owner => $author } },
60             { term => { co_maintainers => $author } },
61             ];
62 0           $bool{minimum_should_match} = 1;
63             } elsif (my $modules = $args{modules}) {
64             $bool{should} = [
65 0           map +{ term => { module_name => $_ } }, @$modules
66             ];
67 0           $bool{minimum_should_match} = 1;
68             }
69              
70 0           my $from = 0;
71 0           my $times = 0;
72 0           my @hit;
73 0           while (1) {
74 0           $times++;
75 0 0         Carp::croak "too many request for $self->{url}" if $times > 6;
76 0           my $payload = {
77             query => { bool => \%bool },
78             sort => [ { module_name => 'asc' } ],
79             size => 2000,
80             from => $from,
81             };
82 0           my $body = JSON::PP::encode_json $payload;
83             my $res = $self->{http}->post($self->{url}, {
84 0           'content-type' => 'application/json',
85             'content-length' => length $body,
86             content => $body,
87             });
88 0 0         if ($res->{status} == 404) {
    0          
89 0           last;
90             } elsif (!$res->{success}) {
91 0           Carp::croak "$res->{status} $res->{reason}, $self->{url}\n$res->{content}";
92             }
93 0           my $json = JSON::PP::decode_json $res->{content};
94 0           my $total = $json->{hits}{total};
95 0           push @hit, map $_->{_source}, @{$json->{hits}{hits}};
  0            
96 0 0         last if @hit >= $total;
97 0           $from = @hit;
98             }
99 0           \@hit;
100             }
101              
102             1;
103             __END__