|
| 1 | +use strict; |
| 2 | +use warnings; |
| 3 | +use v5.36; |
| 4 | + |
| 5 | +use Getopt::Long; |
| 6 | + |
| 7 | +use MetaCPAN::Logger qw< :log :dlog >; |
| 8 | + |
| 9 | +use Ref::Util qw< is_hashref is_ref >; |
| 10 | +use HTTP::Request::Common qw< GET >; |
| 11 | +use URI::Escape qw< uri_escape >; |
| 12 | +use Text::CSV_XS (); |
| 13 | +use Net::GitHub::V4 (); |
| 14 | + |
| 15 | +use MetaCPAN::ES; |
| 16 | +use MetaCPAN::Ingest qw< |
| 17 | + config |
| 18 | + read_url |
| 19 | + ua |
| 20 | +>; |
| 21 | + |
| 22 | +# setup |
| 23 | +my $rt_summary_url //= 'https://rt.cpan.org/Public/bugs-per-dist.tsv'; |
| 24 | +my $gh_issues_url |
| 25 | + //= 'https://api.github.com/repos/%s/%s/issues?per_page=100'; |
| 26 | +
|
| 27 | +$ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = 0; |
| 28 | +
|
| 29 | +my $config = config(); |
| 30 | +my $gh_token = $config->{github_token}; ### TODO: add to config |
| 31 | +
|
| 32 | +# Some issue with rt.cpan.org's cert |
| 33 | +
|
| 34 | +my $gh_graphql = Net::GitHub::V4->new( |
| 35 | + ( $gh_token ? ( access_token => $gh_token ) : () ) ); |
| 36 | +
|
| 37 | +my $es = MetaCPAN::ES->new( index => "cpan", type => "distribution" ); |
| 38 | +my $bulk = $es->bulk(); |
| 39 | +
|
| 40 | +check_all_distributions(); |
| 41 | +index_rt_bugs(); |
| 42 | +index_github_bugs(); |
| 43 | +
|
| 44 | +1; |
| 45 | +
|
| 46 | +### |
| 47 | +
|
| 48 | +# make sure all distributions have an entry |
| 49 | +sub check_all_distributions () { |
| 50 | + my $es_release = MetaCPAN::ES->new( type => "release" ); |
| 51 | + my $scroll_release = $es_release->scroll( |
| 52 | + fields => ['distribution'], |
| 53 | + body => { |
| 54 | + query => { |
| 55 | + not => { term => { status => 'backpan' } }, |
| 56 | + } |
| 57 | + }, |
| 58 | + ); |
| 59 | +
|
| 60 | + my %dists; |
| 61 | +
|
| 62 | + while ( my $release = $scroll_release->next ) { |
| 63 | + my $d = $release->{'fields'}{'distribution'}[0]; |
| 64 | + $d or next; |
| 65 | +
|
| 66 | + log_debug { sprintf( "Adding missing distribution record: %s", $d ) }; |
| 67 | +
|
| 68 | + $dists{$d} = { name => $d }; |
| 69 | + } |
| 70 | +
|
| 71 | + _bulk_update( \%dists ); |
| 72 | +} |
| 73 | +
|
| 74 | +# rt issues are counted for all dists (the download tsv contains everything). |
| 75 | +sub index_rt_bugs () { |
| 76 | + log_debug {'Fetching RT bugs'}; |
| 77 | +
|
| 78 | + my $ua = ua(); |
| 79 | + my $resp = $ua->request( GET $rt_summary_url ); |
| 80 | +
|
| 81 | + log_error { $resp->status_line } unless $resp->is_success; |
| 82 | +
|
| 83 | + # NOTE: This is sending a byte string. |
| 84 | + my $summary = _parse_tsv( $resp->content ); |
| 85 | +
|
| 86 | + log_info {"writing rt data"}; |
| 87 | +
|
| 88 | + _bulk_update($summary); |
| 89 | +} |
| 90 | +
|
| 91 | +sub _parse_tsv ($tsv) { |
| 92 | + $tsv |
| 93 | + =~ s/^#\s*(dist\s.+)/$1/m; # uncomment the field spec for Text::CSV_XS |
| 94 | + $tsv =~ s/^#.*\n//mg; |
| 95 | + |
| 96 | + open my $fh, '<', \$tsv; |
| 97 | + |
| 98 | + # NOTE: This is byte-oriented. |
| 99 | + my $tsv_parser = Text::CSV_XS->new( { sep_char => "\t" } ); |
| 100 | + $tsv_parser->header($fh); |
| 101 | + |
| 102 | + my %summary; |
| 103 | + while ( my $row = $tsv_parser->getline_hr($fh) ) { |
| 104 | + $summary{ $row->{dist} }{'bugs'}{'rt'} = { |
| 105 | + source => _rt_dist_url( $row->{dist} ), |
| 106 | + active => $row->{active}, |
| 107 | + closed => $row->{inactive}, |
| 108 | + map { $_ => $row->{$_} + 0 } |
| 109 | + grep { not /^(dist|active|inactive)$/ } |
| 110 | + keys %$row, |
| 111 | + }; |
| 112 | + } |
| 113 | + |
| 114 | + return \%summary; |
| 115 | +} |
| 116 | + |
| 117 | +sub _rt_dist_url ($d) { |
| 118 | + return sprintf( 'https://rt.cpan.org/Public/Dist/Display.html?Name=%s', |
| 119 | + uri_escape($d) ); |
| 120 | +} |
| 121 | + |
| 122 | +# gh issues are counted for any dist with a github url in `resources.bugtracker.web`. |
| 123 | +sub index_github_bugs () { |
| 124 | + log_debug {'Fetching GitHub issues'}; |
| 125 | + |
| 126 | + my $es_release = MetaCPAN::ES->new( type => "release" ); |
| 127 | + my $scroll_release = $es_release->scroll( |
| 128 | + body => { |
| 129 | + query => { |
| 130 | + and => [ |
| 131 | + { term => { status => 'latest' } }, |
| 132 | + { |
| 133 | + or => [ |
| 134 | + { |
| 135 | + prefix => { |
| 136 | + "resources.bugtracker.web" => |
| 137 | + 'http://github.com/' |
| 138 | + } |
| 139 | + }, |
| 140 | + { |
| 141 | + prefix => { |
| 142 | + "resources.bugtracker.web" => |
| 143 | + 'https://github.com/' |
| 144 | + } |
| 145 | + }, |
| 146 | + ], |
| 147 | + } |
| 148 | + ], |
| 149 | + } |
| 150 | + }, |
| 151 | + ); |
| 152 | + |
| 153 | + log_debug { sprintf( "Found %s repos", $scroll_release->total ) }; |
| 154 | + |
| 155 | + my $json = JSON::MaybeXS->new( allow_nonref => 1 ); |
| 156 | + |
| 157 | + my %summary; |
| 158 | + |
| 159 | +RELEASE: while ( my $r = $scroll_release->next ) { |
| 160 | + my $resources = $r->resources; |
| 161 | + my ( $user, $repo, $source ) |
| 162 | + = _gh_user_repo_from_resources($resources); |
| 163 | + next unless $user; |
| 164 | + |
| 165 | + log_debug {"Retrieving issues from $user/$repo"}; |
| 166 | + |
| 167 | + my $data |
| 168 | + = $gh_graphql->query( _gh_graphql_query( $json, $user, $repo ) ); |
| 169 | + |
| 170 | + if ( my $error = $data->{errors} ) { |
| 171 | + for my $error (@$error) { |
| 172 | + my $log_message = sprintf "[%s] %s", $r->{distribution}, |
| 173 | + $error->{message}; |
| 174 | + if ( $error->{type} eq 'NOT_FOUND' ) { |
| 175 | + delete $summary{ $r->{distribution} }{bugs}{github}; |
| 176 | + log_info {$log_message}; |
| 177 | + } |
| 178 | + else { |
| 179 | + log_error {$log_message}; |
| 180 | + } |
| 181 | + next RELEASE; |
| 182 | + } |
| 183 | + } |
| 184 | + |
| 185 | + my $open = $data->{data}{repository}{openIssues}{totalCount} |
| 186 | + + $data->{data}{repository}{openPullRequests}{totalCount}; |
| 187 | + |
| 188 | + my $closed = $data->{data}{repository}{closedIssues}{totalCount} |
| 189 | + + $data->{data}{repository}{closedPullRequests}{totalCount}; |
| 190 | + |
| 191 | + my $rec = { |
| 192 | + active => $open, |
| 193 | + open => $open, |
| 194 | + closed => $closed, |
| 195 | + source => $source, |
| 196 | + |
| 197 | + }; |
| 198 | + |
| 199 | + $summary{ $r->{distribution} }{bugs}{github} = $rec; |
| 200 | + } |
| 201 | + |
| 202 | + log_info {"writing github data"}; |
| 203 | + |
| 204 | + _bulk_update( \%summary ); |
| 205 | +} |
| 206 | + |
| 207 | +# Try (recursively) to find a github url in the resources hash. |
| 208 | +# FIXME: This should check bugtracker web exclusively, or at least first. |
| 209 | +sub _gh_user_repo_from_resources ($resources) { |
| 210 | + my ( $user, $repo, $source ); |
| 211 | + |
| 212 | + for my $k ( keys %{$resources} ) { |
| 213 | + my $v = $resources->{$k}; |
| 214 | + |
| 215 | + if ( !is_ref($v) |
| 216 | + && $v |
| 217 | + =~ /^(https?|git):\/\/github\.com\/([^\/]+)\/([^\/]+?)(\.git)?\/?$/ |
| 218 | + ) |
| 219 | + { |
| 220 | + return ( $2, $3, $v ); |
| 221 | + } |
| 222 | + |
| 223 | + ( $user, $repo, $source ) = _gh_user_repo_from_resources($v) |
| 224 | + if is_hashref($v); |
| 225 | + |
| 226 | + return ( $user, $repo, $source ) if $user; |
| 227 | + } |
| 228 | + |
| 229 | + return (); |
| 230 | +} |
| 231 | + |
| 232 | +sub _gh_graphql_query ( $json, $user, $repo ) { |
| 233 | + sprintf <<END_QUERY, map $json->encode($_), $user, $repo; |
| 234 | +query { |
| 235 | + repository(owner: %s, name: %s) { |
| 236 | + openIssues: issues(states: OPEN) { |
| 237 | + totalCount |
| 238 | + } |
| 239 | + closedIssues: issues(states: CLOSED) { |
| 240 | + totalCount |
| 241 | + } |
| 242 | + openPullRequests: pullRequests(states: OPEN) { |
| 243 | + totalCount |
| 244 | + } |
| 245 | + closedPullRequests: pullRequests(states: [CLOSED, MERGED]) { |
| 246 | + totalCount |
| 247 | + } |
| 248 | + } |
| 249 | +} |
| 250 | +END_QUERY |
| 251 | +} |
| 252 | + |
| 253 | +sub _bulk_update ($records) { |
| 254 | + for my $d ( keys %$records ) { |
| 255 | + $bulk->update( { |
| 256 | + id => $d, |
| 257 | + doc => $records->{$d}, |
| 258 | + doc_as_upsert => 1, |
| 259 | + } ); |
| 260 | + } |
| 261 | +} |
| 262 | + |
| 263 | +__END__ |
| 264 | +
|
| 265 | +=pod |
| 266 | +
|
| 267 | +=head1 SYNOPSIS |
| 268 | +
|
| 269 | + # bin/tickets |
| 270 | +
|
| 271 | +=head1 DESCRIPTION |
| 272 | +
|
| 273 | +Tracks the number of issues and the source, if the issue |
| 274 | +tracker is RT or Github it fetches the info and updates |
| 275 | +out ES information. |
| 276 | +
|
| 277 | +This can then be accessed here: |
| 278 | +
|
| 279 | +http://fastapi.metacpan.org/v1/distribution/Moose |
| 280 | +http://fastapi.metacpan.org/v1/distribution/HTTP-BrowserDetect |
| 281 | +
|
| 282 | +=cut |
0 commit comments