Gentoo Archives: gentoo-commits

From: Kent Fredric <kentfredric@×××××.com>
To: gentoo-commits@l.g.o
Subject: [gentoo-commits] proj/perl-overlay:master commit in: scripts/
Date: Fri, 22 Jun 2012 07:34:44
Message-Id: 1340349551.94de4825f65caa983f0c816917c872e68c67bcd9.kent@gentoo
1 commit: 94de4825f65caa983f0c816917c872e68c67bcd9
2 Author: Kent Fredric <kentfredric <AT> gmail <DOT> com>
3 AuthorDate: Fri Jun 22 07:19:11 2012 +0000
4 Commit: Kent Fredric <kentfredric <AT> gmail <DOT> com>
5 CommitDate: Fri Jun 22 07:19:11 2012 +0000
6 URL: http://git.overlays.gentoo.org/gitweb/?p=proj/perl-overlay.git;a=commit;h=94de4825
7
8 [scripts/aggregate_tree] refactor to use the new Gentoo::Overlay::Group::INI class, loadable via --from-ini, which enables processing multiple repositories into a single output file
9
10 ---
11 scripts/aggregate_tree.pl | 201 +++++++++++++++++++++++++--------------------
12 1 files changed, 112 insertions(+), 89 deletions(-)
13
14 diff --git a/scripts/aggregate_tree.pl b/scripts/aggregate_tree.pl
15 index f8f797e..1e7e92a 100755
16 --- a/scripts/aggregate_tree.pl
17 +++ b/scripts/aggregate_tree.pl
18 @@ -21,116 +21,139 @@ use Gentoo::Overlay;
19
20 use XML::Smart;
21
22 -my $env = env::gentoo::perl_experimental->new();
23 -my $opts = optparse->new(
24 - argv => \@ARGV,
25 - help => sub { print <DATA>; return },
26 -);
27 -my $root = $env->root;
28 -use Path::Class::Dir;
29 -
30 -if ( defined $opts->long_opts->{root} ) {
31 - $root = Path::Class::Dir->new( $opts->long_opts->{root} );
32 -}
33 -my $overlay = Gentoo::Overlay->new( path => $root );
34 +my ( $env, $packages, $cat );
35 +main();
36 +
37 +sub main {
38 + $env = env::gentoo::perl_experimental->new();
39 + my $opts = optparse->new(
40 + argv => \@ARGV,
41 + help => sub { print <DATA>; return },
42 + );
43 + my $tree;
44 +
45 + if ( $opts->long_opts->{'from-ini'} ) {
46 + require Gentoo::Overlay::Group::INI;
47 + $tree = Gentoo::Overlay::Group::INI->load_named('aggregate_tree')->overlay_group;
48 + }
49 + else {
50 + require Gentoo::Overlay::Group;
51 + $tree = Gentoo::Overlay::Group->new();
52 + $tree->add_overlay( set_root( $opts->long_opts->{root} ));
53 + }
54
55 -my $overlay_name = $overlay->name;
56 -use JSON;
57 + $packages = {};
58
59 -my $data;
60 + my $dest = open_output( $opts->long_opts->{output} );
61
62 -my $packages = $data->{ $overlay_name } = {};
63 + $|++;
64 + $tree->iterate(
65 + 'packages' => \&handle_package
66 + );
67
68 -my $encoder = JSON->new()->pretty->utf8->canonical;
69 + $dest->print( make_format( $opts->long_opts->{format} ) );
70
71 -my $dest = \*STDOUT;
72 -if ( not $opts->long_opts->{output} or $opts->long_opts->{output} eq '-' ) {
73 - $dest = \*STDOUT;
74 }
75 -else {
76 - use Path::Class::File;
77 - my $file = Path::Class::File->new( $opts->long_opts->{output} )->absolute();
78 - $dest = $file->openw( iomode => ':utf8' );
79 +
80 +sub set_root {
81 + my ($root) = @_;
82 + return $env->root unless defined $root;
83 + require Path::Class::Dir;
84 + return Path::Class::Dir->new($root);
85 }
86
87 -my $cat;
88 -$|++;
89 -$overlay->iterate(
90 - 'packages' => sub {
91 - my ( $self, $c ) = @_;
92 - my $CP = $c->{category_name} . '/' . $c->{package_name};
93 - my $xmlfile = $root->subdir( $c->{category_name}, $c->{package_name} )->file('metadata.xml');
94 - if ( not -e $xmlfile ) {
95 - warn "\e[31mNo metadata.xml for $CP\e[0m\n";
96 - return;
97 - }
98 - if( not $cat or $c->{category_name} ne $cat ) {
99 - *STDERR->print("\nProcessing " . $c->{category_name} . " :");
100 - $cat = $c->{category_name};
101 - }
102 - *STDERR->print(".");
103 - my $XML = XML::Smart->new( $xmlfile->absolute()->stringify() );
104 - if ( not exists $XML->{pkgmetadata} ) {
105 - warn "\e[31m<pkgmetadata> missing in $xmlfile\e[0m\n";
106 - return;
107 - }
108 - if ( not exists $XML->{pkgmetadata}->{upstream} ) {
109 - # warn "<pkgmetadata>/<upstream> missing in $xmlfile\n";
110 - return;
111 - }
112 - if ( not exists $XML->{pkgmetadata}->{upstream}->{'remote-id'} ) {
113 +sub open_output {
114 + my ($output) = @_;
115 + return \*STDOUT if not defined $output;
116 + return \*STDOUT if $output eq '-';
117 + require Path::Class::File;
118 + my $file = Path::Class::File->new($output)->absolute();
119 + return $file->openw( iomode => ':utf8' );
120 +}
121
122 - # warn "<pkgmetadata>/<upstream>/<remote-id> missing in $xmlfile\n";
123 - return;
124 - }
125 - for my $remote ( @{ $XML->{pkgmetadata}->{upstream}->{'remote-id'} } ) {
126 +sub make_format {
127 + my ($format) = @_;
128 + $format ||= 'JSON';
129 + if ( $format eq 'JSON' ) {
130 + goto &make_format_json;
131 + }
132 + if ( $format eq 'distlist' ) {
133 + goto &make_format_distlist;
134 + }
135 + die "Unknown format type " . $format;
136 +}
137
138 - next if not exists $remote->{type};
139 - next unless $remote->{type} eq 'cpan';
140 +sub make_format_json {
141 + require JSON;
142 + my $encoder = JSON->new()->pretty->utf8->canonical;
143 + return $encoder->encode($packages);
144 +}
145
146 - my $upstream = $remote->content();
147 +sub make_format_distlist {
148 + return join qq{\n}, keys %{$packages};
149 +}
150
151 - if ( not defined $packages->{$upstream} ) {
152 - $packages->{$upstream} = [];
153 - }
154 - my $versions = [];
155 - my $record = {
156 - category => $c->{category_name},
157 - package => $c->{package_name},
158 - repository => $overlay_name,
159 - versions_gentoo => $versions,
160 - };
161 - $c->{package}->iterate( ebuilds => sub {
162 +sub handle_package {
163 + my ( $self, $c ) = @_;
164 + my $CP = $c->{category_name} . '/' . $c->{package_name};
165 + my $xmlfile = $c->{package}->path->file('metadata.xml');
166 + if ( not -e $xmlfile ) {
167 + warn "\e[31mNo metadata.xml for $CP\e[0m\n";
168 + return;
169 + }
170 + if ( not $cat or $c->{category_name} ne $cat ) {
171 + *STDERR->print( "\nProcessing " . $c->{category_name} . " :" );
172 + $cat = $c->{category_name};
173 + }
174 + *STDERR->print(".");
175 + my $XML = XML::Smart->new( $xmlfile->absolute()->stringify() );
176 + if ( not exists $XML->{pkgmetadata} ) {
177 + warn "\e[31m<pkgmetadata> missing in $xmlfile\e[0m\n";
178 + return;
179 + }
180 + if ( not exists $XML->{pkgmetadata}->{upstream} ) {
181 +
182 + # warn "<pkgmetadata>/<upstream> missing in $xmlfile\n";
183 + return;
184 + }
185 + if ( not exists $XML->{pkgmetadata}->{upstream}->{'remote-id'} ) {
186 +
187 + # warn "<pkgmetadata>/<upstream>/<remote-id> missing in $xmlfile\n";
188 + return;
189 + }
190 + for my $remote ( @{ $XML->{pkgmetadata}->{upstream}->{'remote-id'} } ) {
191 +
192 + next if not exists $remote->{type};
193 + next unless $remote->{type} eq 'cpan';
194 +
195 + my $upstream = $remote->content();
196 +
197 + if ( not defined $packages->{$upstream} ) {
198 + $packages->{$upstream} = [];
199 + }
200 + my $versions = [];
201 + my $record = {
202 + category => $c->{category_name},
203 + package => $c->{package_name},
204 + repository => $c->{overlay_name},
205 + versions_gentoo => $versions,
206 + };
207 + $c->{package}->iterate(
208 + ebuilds => sub {
209 my ( $self, $d ) = @_;
210 my $version = $d->{ebuild_name};
211 - my $p = $c->{package_name};
212 + my $p = $c->{package_name};
213 $version =~ s/\.ebuild$//;
214 $version =~ s/^\Q${p}\E-//;
215 push @{$versions}, $version;
216 - });
217 - push @{ $packages->{$upstream} }, $record;
218 + }
219 + );
220 + push @{ $packages->{$upstream} }, $record;
221
222 - *STDERR->print("\e[32m $CP -> $upstream\e[0m ");
223 - }
224 + *STDERR->print("\e[32m $CP -> $upstream\e[0m ");
225 }
226 -);
227
228 -my $out;
229 -if ( not $opts->long_opts->{format} ) {
230 - $opts->long_opts->{format} = "JSON";
231 -}
232 -if ( $opts->long_opts->{format} eq "JSON" ) {
233 - $out = $encoder->encode($packages);
234 }
235 -elsif ( $opts->long_opts->{format} eq 'distlist' ) {
236 - $out = join "\n", keys %{$packages};
237 -}
238 -else {
239 - die "Unknown format type " . $opts->long_opts->{format};
240 -}
241 -
242 -$dest->print($out);
243 -
244 0;
245
246 __DATA__