From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from pigeon.gentoo.org ([208.92.234.80] helo=lists.gentoo.org) by finch.gentoo.org with esmtp (Exim 4.60) (envelope-from ) id 1SH1HK-0002xQ-QE for garchives@archives.gentoo.org; Sun, 08 Apr 2012 23:12:15 +0000 Received: from pigeon.gentoo.org (localhost [127.0.0.1]) by pigeon.gentoo.org (Postfix) with SMTP id 322C1E0AF4; Sun, 8 Apr 2012 23:12:02 +0000 (UTC) Received: from smtp.gentoo.org (smtp.gentoo.org [140.211.166.183]) by pigeon.gentoo.org (Postfix) with ESMTP id DC795E0AF2 for ; Sun, 8 Apr 2012 23:12:01 +0000 (UTC) Received: from hornbill.gentoo.org (hornbill.gentoo.org [94.100.119.163]) (using TLSv1 with cipher AECDH-AES256-SHA (256/256 bits)) (No client certificate requested) by smtp.gentoo.org (Postfix) with ESMTPS id 0F8D51B403D for ; Sun, 8 Apr 2012 23:12:01 +0000 (UTC) Received: from localhost.localdomain (localhost [127.0.0.1]) by hornbill.gentoo.org (Postfix) with ESMTP id BBB56E5402 for ; Sun, 8 Apr 2012 23:11:59 +0000 (UTC) From: "Kent Fredric" To: gentoo-commits@lists.gentoo.org Content-type: text/plain; charset=UTF-8 Reply-To: gentoo-dev@lists.gentoo.org, "Kent Fredric" Message-ID: <1333926029.cf746e3c3f2fe8dca044012cca603464688cd289.kent@gentoo> Subject: [gentoo-commits] proj/perl-overlay:master commit in: scripts/, scripts/lib/ X-VCS-Repository: proj/perl-overlay X-VCS-Files: scripts/lib/optparse.pm scripts/package_map_all.pl X-VCS-Directories: scripts/ scripts/lib/ X-VCS-Committer: kent X-VCS-Committer-Name: Kent Fredric X-VCS-Revision: cf746e3c3f2fe8dca044012cca603464688cd289 X-VCS-Branch: master Date: Sun, 8 Apr 2012 23:11:59 +0000 (UTC) Precedence: bulk List-Post: List-Help: List-Unsubscribe: List-Subscribe: List-Id: Gentoo Linux mail X-BeenThere: gentoo-commits@lists.gentoo.org Content-Transfer-Encoding: quoted-printable X-Archives-Salt: 360da1b5-7722-4f48-b62f-35c5f06c2cde X-Archives-Hash: e480e1d9f3b5231b36dc4874fb1b3815 commit: cf746e3c3f2fe8dca044012cca603464688cd289 Author: Kent Fredric gmail com> AuthorDate: Sun Apr 8 23:00:29 2012 +0000 Commit: Kent Fredric gmail com> CommitDate: Sun Apr 8 23:00:29 2012 +0000 URL: http://git.overlays.gentoo.org/gitweb/?p=3Dproj/perl-overlay.= git;a=3Dcommit;h=3Dcf746e3c [scripts] add package_map_all which creates a JSON listing of all basic m= etadata of all available versions of all tracked packages --- scripts/lib/optparse.pm | 17 ++++- scripts/package_map_all.pl | 184 ++++++++++++++++++++++++++++++++++++++= ++++++ 2 files changed, 199 insertions(+), 2 deletions(-) diff --git a/scripts/lib/optparse.pm b/scripts/lib/optparse.pm index 296184b..a12ccc9 100644 --- a/scripts/lib/optparse.pm +++ b/scripts/lib/optparse.pm @@ -12,8 +12,20 @@ use Moose; has 'help' =3D> ( isa =3D> 'CodeRef', is =3D> 'rw', required =3D> 1 ); has 'argv' =3D> ( isa =3D> 'ArrayRef', is =3D> 'rw', required =3D> 1 ); =20 -has 'long_opts' =3D> ( isa =3D> 'HashRef', is =3D> 'rw', 'lazy_build' = =3D> 1 ); -has 'opts' =3D> ( isa =3D> 'HashRef', is =3D> 'rw', lazy_build = =3D> 1 ); +has 'long_opts' =3D> ( isa =3D> 'HashRef', is =3D> 'rw', 'lazy_build' = =3D> 1 , + traits =3D> [qw( Hash )], + handles =3D> {=20 + has_long_opt =3D> 'exists', + long_opt =3D> 'get', + }, +); +has 'opts' =3D> ( isa =3D> 'HashRef', is =3D> 'rw', lazy_build = =3D> 1,=20 + traits =3D> [qw( Hash )], + handles =3D> {=20 + has_opt =3D> 'exists', + opt =3D> 'get', + }, +); has 'extra_opts' =3D> ( isa =3D> 'ArrayRef', is =3D> 'rw', 'lazy_build' = =3D> 1 ); =20 sub _build_extra_opts { @@ -21,6 +33,7 @@ sub _build_extra_opts { return [ grep { $_ !~ /^--(.+)/ and $_ !~ /^-(\w+)/ } @{ $self->argv }= ]; } =20 + sub _build_opts { my $self =3D shift; my $hash =3D {}; diff --git a/scripts/package_map_all.pl b/scripts/package_map_all.pl new file mode 100755 index 0000000..62a9c5b --- /dev/null +++ b/scripts/package_map_all.pl @@ -0,0 +1,184 @@ +#!/usr/bin/env perl + +eval 'echo "Called with something not perl"' && exit 1 # Non-Perl pro= tection. + if 0; + +use 5.12.2; +use strict; +use warnings; + +use FindBin; +use lib "$FindBin::Bin/lib"; + +use env::gentoo::perl_experimental; +use metacpan qw( mcpan ); +use Try::Tiny; +use utf8; +use optparse; +use Path::Class::Dir; +my $optparse =3D optparse->new( + argv =3D> \@ARGV, + help =3D> sub { print help(); }, +); + +my $env =3D env::gentoo::perl_experimental->new(); +my $root =3D $env->root; + +if ( $optparse->has_long_opt('root') ) { + $root =3D Path::Class::Dir->new( $optparse->long_opt('root') ); +} + +my $size =3D 300; + +my $metadata =3D $root->subdir( 'metadata', 'perl' ); +my $distmap =3D $metadata->subdir('distmap'); +#my $distinfo =3D $metadata->subdir('distinfo'); +$distinfo->mkpath(); +my (@json_files) =3D grep { not $_->is_dir and $_->basename =3D~ /\.json= $/ } $distmap->children(); + +use JSON; +my $decoder =3D JSON->new()->utf8->relaxed; +my $encoder =3D JSON->new()->pretty->utf8->canonical; + +my %lookup; + +{ + for my $file (@json_files) { + say "* Reading " . $file->relative; + my $hash =3D $decoder->decode( scalar $file->slurp ); + say " Found " . ( scalar keys %{$hash} ) . " repositories indexed i= n " . $file->relative; + for my $repo ( keys %{$hash} ) { + my $nodes =3D $hash->{$repo}; + say " ${repo}: " . ( scalar keys %{$nodes} ) . " distributions"; + $lookup{$_}++ for keys %{$nodes}; + } + } + say "* Found: " . ( scalar keys %lookup ) . " unique distributions"; + my ( @dup ) =3D grep { $lookup{$_} > 1 } keys %lookup; + if ( @dup > 0 ) { + say " " . ( scalar @dup ) ." items listed more than once"; + say " > $_" for @dup; + } +} + +my @dists =3D keys %lookup; + +my $search =3D {}; +$search->{query} =3D { constant_score =3D> { filter =3D> { terms =3D> {=20 + distribution =3D> [ @dists ]=20 +} } } }; +$search->{sort} =3D [ { 'date' =3D> 'desc', }, ]; +$search->{size} =3D $size; +$search->{fields} =3D [ + qw( + abstract + archive + author + authorized + date + distribution + download_url + license + maturity + name + status + version + ) +]; + +$ENV{WWW_MECH_NOCACHE} =3D 1; + +my $results_string =3D mcpan->ua->request( + 'POST', + mcpan->base_url . 'release/_search?search_type=3Dscan&scroll=3D30s&siz= e=3D' . $size, + { + content =3D> $encoder->encode( $search ), + } +); + +say $results_string->{content}; + +my $results =3D $decoder->decode( $results_string->{content} ); +my $scroll_id =3D $results->{_scroll_id}; + +my $total_results =3D $results->{hits}->{total}; + +say "Found: $total_results releases"; + + +my $dtree; +my $seen =3D 0; + +while( 1 ) {=20 + my ( $result, $scroll ) =3D scroll( $scroll_id ); + last unless scalar @{$result->{hits}->{hits}}; + collate_resultset( $result ); + $scroll_id =3D $scroll; + say "Seen $seen of $total_results"; +} + +for my $package ( sort keys %{$dtree} ) { + say "Sorting $package"; + $dtree->{$package} =3D [ sort { $b->{date} cmp $a->{date} } @{ $dtree-= >{$package} } ]; +} + +my $fh =3D $metadata->file('distinfo.json')->openw; +$fh->print( $encoder->encode( $dtree )); + +exit 0; + +sub scroll { + my ( $id ) =3D @_ ; + my $result =3D mcpan->ua->request( + 'GET', + 'http://api.metacpan.org/_search/scroll/?scroll=3D30s&size=3D' . $si= ze . '&scroll_id=3D' . $id + ); + + my $data =3D $decoder->decode( $result->{content} ); + return $data, $data->{_scroll_id}; +} + +sub collate_resultset { + my ( $results ) =3D @_; + for my $result ( @{ $results->{hits}->{hits} } ) { + if ( not $result->{fields} ) { + $result->{fields} =3D $result->{_source}; + } + delete $result->{fields}->{dependency} if exists $result->{fields}->= {dependency}; + my $fields =3D $result->{fields}; + + my $cversion =3D $fields->{name}; + my $cdistrib =3D $fields->{distribution}; + $cversion =3D~ s/^${cdistrib}-//; + $seen++; + $fields->{version_canon} =3D $cversion; + $fields->{version_gentoo} =3D scalar try { gv( $cversion, { lax =3D>= 1 } ) }; + $fields->{archive_canon} =3D $fields->{author} . '/' . $fields->{ar= chive}; + #say $fields->{author} . '/' . $fields->{archive}; + $dtree->{$cdistrib} =3D [] unless exists $dtree->{$cdistrib}; + push @{ $dtree->{$cdistrib} }, $fields; + } +} + +# Utils + +sub gv { require Gentoo::PerlMod::Version; goto \&Gentoo::PerlMod::Versi= on::gentooize_version } + +sub help { + return <<"EOF"; +package_map_all.pl + +USAGE: + + package_map_all.pl [--help] + + ie: + + package_map_all.pl + + --help Show this message + +EOF + +} +