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 1S2V2A-0000O9-5L for garchives@archives.gentoo.org; Tue, 28 Feb 2012 21:56:34 +0000 Received: from pigeon.gentoo.org (localhost [127.0.0.1]) by pigeon.gentoo.org (Postfix) with SMTP id 505A6E076D; Tue, 28 Feb 2012 21:55:52 +0000 (UTC) Received: from smtp.gentoo.org (smtp.gentoo.org [140.211.166.183]) by pigeon.gentoo.org (Postfix) with ESMTP id 1155EE076D for ; Tue, 28 Feb 2012 21:55:51 +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 263DA1B401E for ; Tue, 28 Feb 2012 21:55:51 +0000 (UTC) Received: from localhost.localdomain (localhost [127.0.0.1]) by hornbill.gentoo.org (Postfix) with ESMTP id 08876E5411 for ; Tue, 28 Feb 2012 21:55:48 +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: <1330465712.77d2781c0c39aefb6411714dbd374a0640b60191.kent@gentoo> Subject: [gentoo-commits] proj/perl-overlay:master commit in: scripts/ X-VCS-Repository: proj/perl-overlay X-VCS-Files: scripts/aggregate_tree.pl X-VCS-Directories: scripts/ X-VCS-Committer: kent X-VCS-Committer-Name: Kent Fredric X-VCS-Revision: 77d2781c0c39aefb6411714dbd374a0640b60191 X-VCS-Branch: master Date: Tue, 28 Feb 2012 21:55:48 +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: fb18c738-6595-4da8-81b3-025528066039 X-Archives-Hash: 8a13a9f3f13957ddcb0829ccee34f9a4 commit: 77d2781c0c39aefb6411714dbd374a0640b60191 Author: Kent Fredric gmail com> AuthorDate: Tue Feb 28 21:48:32 2012 +0000 Commit: Kent Fredric gmail com> CommitDate: Tue Feb 28 21:48:32 2012 +0000 URL: http://git.overlays.gentoo.org/gitweb/?p=3Dproj/perl-overlay.= git;a=3Dcommit;h=3D77d2781c [scripts:new] aggregate_tree.pl, harvest data int= o a big JSON file/list of dists --- scripts/aggregate_tree.pl | 138 +++++++++++++++++++++++++++++++++++++++= ++++++ 1 files changed, 138 insertions(+), 0 deletions(-) diff --git a/scripts/aggregate_tree.pl b/scripts/aggregate_tree.pl new file mode 100755 index 0000000..d4c5bfa --- /dev/null +++ b/scripts/aggregate_tree.pl @@ -0,0 +1,138 @@ +#!/usr/bin/env perl + +eval 'echo "Called with something not perl"' && exit 1 # Non-Perl pro= tection. + if 0; + +use 5.14.2; +use strict; +use warnings; + +use FindBin; +use lib "$FindBin::Bin/lib"; +use env::gentoo::perl_experimental; +use optparse; +use utf8; +use Data::Dump qw( pp ); +use Gentoo::Overlay; + +# FILENAME: aggregate_tree.pl +# CREATED: 29/02/12 07:37:54 by Kent Fredric (kentnl) +# ABSTRACT: Connect all the cpan id's from the metadata.xml + +use XML::Smart; + +my $env =3D env::gentoo::perl_experimental->new(); +my $opts =3D optparse->new( + argv =3D> \@ARGV, + help =3D> sub { print ; return }, +); +my $root =3D $env->root; +use Path::Class::Dir; + +if ( defined $opts->long_opts->{root} ) { + $root =3D Path::Class::Dir->new( $opts->long_opts->{root} ); +} +my $overlay =3D Gentoo::Overlay->new( path =3D> $root ); + +use JSON; + +my $data; + +my $packages =3D $data->{ $overlay->name } =3D {}; + +my $encoder =3D JSON->new()->pretty->utf8->canonical; + +my $dest =3D \*STDOUT; +if ( not $opts->long_opts->{output} or $opts->long_opts->{output} eq '-'= ) { + $dest =3D \*STDOUT; +} +else { + use Path::Class::File; + my $file =3D Path::Class::File->new( $opts->long_opts->{output} )->abs= olute(); + $dest =3D $file->openw( iomode =3D> ':utf8' ); +} + +$overlay->iterate( + 'packages' =3D> sub { + my ( $self, $c ) =3D @_; + my $CP =3D $c->{category_name} . '/' . $c->{package_name}; + my $xmlfile =3D $root->subdir( $c->{category_name}, $c->{package_nam= e} )->file('metadata.xml'); + if ( not -e $xmlfile ) { + warn "No metadata.xml for $CP\n"; + return; + } + + # warn "Processing $xmlfile\n"; + my $XML =3D XML::Smart->new( $xmlfile->absolute()->stringify() ); + if ( not exists $XML->{pkgmetadata} ) { + + # warn " missing in $xmlfile\n"; + return; + } + if ( not exists $XML->{pkgmetadata}->{upstream} ) { + + # warn "/ missing in $xmlfile\n"; + return; + } + if ( not exists $XML->{pkgmetadata}->{upstream}->{'remote-id'} ) { + + # warn "// missing in $xmlfile\n= "; + return; + } + if ( not exists $XML->{pkgmetadata}->{upstream}->{'remote-id'}->{typ= e} ) { + + # warn "remote type not specified for $CP"; + return; + } + if ( not $XML->{pkgmetadata}->{upstream}->{'remote-id'}->{type} eq '= cpan' ) { + + # warn "$CP: Not a CPAN remote: " . $XML->{pkgmetadata}-= >{upstream}->{'remote-id'}->{type} ; + return; + } + my $upstream =3D $XML->{pkgmetadata}->{upstream}->{'remote-id'}->con= tent(); + $packages->{$upstream} =3D $CP; + } +); + +my $out; +if ( not $opts->long_opts->{format} ) { + $opts->long_opts->{format} =3D "JSON"; +} +if ( $opts->long_opts->{format} eq "JSON" ) { + $out =3D $encoder->encode($data); +} +elsif ( $opts->long_opts->{format} eq 'distlist' ) { + $out =3D join "\n", keys %{$packages}; +} +else { + die "Unknown format type " . $opts->long_opts->{format}; +} + +$dest->print($out); + +0; + +__DATA__ + +This script scrapes the perl repository and finds all the metadata.xml f= iles + and makes a mapping file connecting categories to upstream dists. + +Usage: + + aggregate_tree.pl + + By default uses the perl-experimental overlay as a working dir, and em= its JSON to stdout + + aggregate_tree.pl=20 + =20 + --root=3D"/path/to/some/root" + + Specifiy another root to scan ( ie: /usr/portage ) + =20 + --format=3DJSON # Emit JSON ( Default ) + --format=3Ddistlist # Emit a list of CPAN Dist Names + + --output=3D- # Write to standard output ( Default )= =20 + --output=3D"/path/to/file" # Write to the specified file + +