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__ |