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 1ShyOB-0003og-IA for garchives@archives.gentoo.org; Fri, 22 Jun 2012 07:34:44 +0000 Received: from pigeon.gentoo.org (localhost [127.0.0.1]) by pigeon.gentoo.org (Postfix) with SMTP id 05011E0CED; Fri, 22 Jun 2012 07:34:34 +0000 (UTC) Received: from smtp.gentoo.org (smtp.gentoo.org [140.211.166.183]) by pigeon.gentoo.org (Postfix) with ESMTP id B8BF7E0CED for ; Fri, 22 Jun 2012 07:34:34 +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 B8FBB1B4009 for ; Fri, 22 Jun 2012 07:34:33 +0000 (UTC) Received: from localhost.localdomain (localhost [127.0.0.1]) by hornbill.gentoo.org (Postfix) with ESMTP id 83441E5435 for ; Fri, 22 Jun 2012 07:34:32 +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: <1340349551.94de4825f65caa983f0c816917c872e68c67bcd9.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: 94de4825f65caa983f0c816917c872e68c67bcd9 X-VCS-Branch: master Date: Fri, 22 Jun 2012 07:34:32 +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: b426531b-d26f-4e23-af9e-09615798ca43 X-Archives-Hash: 3f9e346445b5b040dcf4170f61da7215 commit: 94de4825f65caa983f0c816917c872e68c67bcd9 Author: Kent Fredric gmail com> AuthorDate: Fri Jun 22 07:19:11 2012 +0000 Commit: Kent Fredric gmail com> CommitDate: Fri Jun 22 07:19:11 2012 +0000 URL: http://git.overlays.gentoo.org/gitweb/?p=3Dproj/perl-overlay.= git;a=3Dcommit;h=3D94de4825 [scripts/aggregate_tree] refactor to use the new Gentoo::Overlay::Group::= INI class, loadable via --from-ini, which enables processing multiple rep= ositories into a single output file --- scripts/aggregate_tree.pl | 201 +++++++++++++++++++++++++--------------= ------ 1 files changed, 112 insertions(+), 89 deletions(-) diff --git a/scripts/aggregate_tree.pl b/scripts/aggregate_tree.pl index f8f797e..1e7e92a 100755 --- a/scripts/aggregate_tree.pl +++ b/scripts/aggregate_tree.pl @@ -21,116 +21,139 @@ use Gentoo::Overlay; =20 use XML::Smart; =20 -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 ); +my ( $env, $packages, $cat ); +main(); + +sub main { + $env =3D env::gentoo::perl_experimental->new(); + my $opts =3D optparse->new( + argv =3D> \@ARGV, + help =3D> sub { print ; return }, + ); + my $tree; + + if ( $opts->long_opts->{'from-ini'} ) { + require Gentoo::Overlay::Group::INI; + $tree =3D Gentoo::Overlay::Group::INI->load_named('aggregate_tree')-= >overlay_group; + } + else { + require Gentoo::Overlay::Group; + $tree =3D Gentoo::Overlay::Group->new(); + $tree->add_overlay( set_root( $opts->long_opts->{root} )); + } =20 -my $overlay_name =3D $overlay->name; -use JSON; + $packages =3D {}; =20 -my $data; + my $dest =3D open_output( $opts->long_opts->{output} ); =20 -my $packages =3D $data->{ $overlay_name } =3D {}; + $|++; + $tree->iterate( + 'packages' =3D> \&handle_package + ); =20 -my $encoder =3D JSON->new()->pretty->utf8->canonical; + $dest->print( make_format( $opts->long_opts->{format} ) ); =20 -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' ); + +sub set_root { + my ($root) =3D @_; + return $env->root unless defined $root; + require Path::Class::Dir; + return Path::Class::Dir->new($root); } =20 -my $cat; -$|++; -$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 "\e[31mNo metadata.xml for $CP\e[0m\n"; - return; - } - if( not $cat or $c->{category_name} ne $cat ) { - *STDERR->print("\nProcessing " . $c->{category_name} . " :"); - $cat =3D $c->{category_name}; - } - *STDERR->print("."); - my $XML =3D XML::Smart->new( $xmlfile->absolute()->stringify() ); - if ( not exists $XML->{pkgmetadata} ) { - warn "\e[31m missing in $xmlfile\e[0m\n"; - return; - } - if ( not exists $XML->{pkgmetadata}->{upstream} ) { - # warn "/ missing in $xmlfile\n"; - return; - } - if ( not exists $XML->{pkgmetadata}->{upstream}->{'remote-id'} ) { +sub open_output { + my ($output) =3D @_; + return \*STDOUT if not defined $output; + return \*STDOUT if $output eq '-'; + require Path::Class::File; + my $file =3D Path::Class::File->new($output)->absolute(); + return $file->openw( iomode =3D> ':utf8' ); +} =20 - # warn "// missing in $xmlfile\n= "; - return; - } - for my $remote ( @{ $XML->{pkgmetadata}->{upstream}->{'remote-id'} }= ) { +sub make_format { + my ($format) =3D @_; + $format ||=3D 'JSON'; + if ( $format eq 'JSON' ) { + goto &make_format_json; + } + if ( $format eq 'distlist' ) { + goto &make_format_distlist; + } + die "Unknown format type " . $format; +} =20 - next if not exists $remote->{type}; - next unless $remote->{type} eq 'cpan'; +sub make_format_json { + require JSON; + my $encoder =3D JSON->new()->pretty->utf8->canonical; + return $encoder->encode($packages); +} =20 - my $upstream =3D $remote->content(); +sub make_format_distlist { + return join qq{\n}, keys %{$packages}; +} =20 - if ( not defined $packages->{$upstream} ) { - $packages->{$upstream} =3D []; - } - my $versions =3D []; - my $record =3D { - category =3D> $c->{category_name}, - package =3D> $c->{package_name}, - repository =3D> $overlay_name, - versions_gentoo =3D> $versions, - }; - $c->{package}->iterate( ebuilds =3D> sub { +sub handle_package { + my ( $self, $c ) =3D @_; + my $CP =3D $c->{category_name} . '/' . $c->{package_name}; + my $xmlfile =3D $c->{package}->path->file('metadata.xml'); + if ( not -e $xmlfile ) { + warn "\e[31mNo metadata.xml for $CP\e[0m\n"; + return; + } + if ( not $cat or $c->{category_name} ne $cat ) { + *STDERR->print( "\nProcessing " . $c->{category_name} . " :" ); + $cat =3D $c->{category_name}; + } + *STDERR->print("."); + my $XML =3D XML::Smart->new( $xmlfile->absolute()->stringify() ); + if ( not exists $XML->{pkgmetadata} ) { + warn "\e[31m missing in $xmlfile\e[0m\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; + } + for my $remote ( @{ $XML->{pkgmetadata}->{upstream}->{'remote-id'} } )= { + + next if not exists $remote->{type}; + next unless $remote->{type} eq 'cpan'; + + my $upstream =3D $remote->content(); + + if ( not defined $packages->{$upstream} ) { + $packages->{$upstream} =3D []; + } + my $versions =3D []; + my $record =3D { + category =3D> $c->{category_name}, + package =3D> $c->{package_name}, + repository =3D> $c->{overlay_name}, + versions_gentoo =3D> $versions, + }; + $c->{package}->iterate( + ebuilds =3D> sub { my ( $self, $d ) =3D @_; my $version =3D $d->{ebuild_name}; - my $p =3D $c->{package_name}; + my $p =3D $c->{package_name}; $version =3D~ s/\.ebuild$//; $version =3D~ s/^\Q${p}\E-//; push @{$versions}, $version; - }); - push @{ $packages->{$upstream} }, $record; + } + ); + push @{ $packages->{$upstream} }, $record; =20 - *STDERR->print("\e[32m $CP -> $upstream\e[0m "); - } + *STDERR->print("\e[32m $CP -> $upstream\e[0m "); } -); =20 -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($packages); } -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; =20 __DATA__