1 | package Mkcd::Group; |
---|
2 | |
---|
3 | my $VERSION = '2.0.2'; |
---|
4 | |
---|
5 | use strict; |
---|
6 | use File::NCopy qw(copy); |
---|
7 | use File::Path; |
---|
8 | use Mkcd::Disc; |
---|
9 | use Mkcd::List; |
---|
10 | use Mkcd::Build; |
---|
11 | use Mkcd::Tools qw(cleanrpmsrate printTable printDiscsFile readBatchFile printBatchFile log_); |
---|
12 | use Mkcd::Package qw(genDeps getSize); |
---|
13 | use MDK::Common qw(any); |
---|
14 | #use Mkcd::Optimize qw(print_conflict_matrix); |
---|
15 | |
---|
16 | =head1 NAME |
---|
17 | |
---|
18 | Group - mkcd module |
---|
19 | |
---|
20 | =head1 SYNOPSYS |
---|
21 | |
---|
22 | require Mkcd::Group; |
---|
23 | |
---|
24 | =head1 DESCRIPTION |
---|
25 | |
---|
26 | C<Mkcd::Group> include the mkcd high level disc building routines. |
---|
27 | |
---|
28 | =head1 SEE ALSO |
---|
29 | |
---|
30 | mkcd |
---|
31 | |
---|
32 | =head1 COPYRIGHT |
---|
33 | |
---|
34 | Copyright (C) 2000,2001,2002,2003,2004 Mandrakesoft <warly@mandrakesoft.com> |
---|
35 | |
---|
36 | This program is free software; you can redistribute it and/or modify |
---|
37 | it under the terms of the GNU General Public License as published by |
---|
38 | the Free Software Foundation; either version 2, or (at your option) |
---|
39 | any later version. |
---|
40 | |
---|
41 | This program is distributed in the hope that it will be useful, |
---|
42 | but WITHOUT ANY WARRANTY; without even the implied warranty of |
---|
43 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
---|
44 | GNU General Public License for more details. |
---|
45 | |
---|
46 | You should have received a copy of the GNU General Public License |
---|
47 | along with this program; if not, write to the Free Software |
---|
48 | Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. |
---|
49 | |
---|
50 | =cut |
---|
51 | |
---|
52 | my $config; |
---|
53 | |
---|
54 | sub new { |
---|
55 | my ($class, $conf) = @_; |
---|
56 | $config = $conf; |
---|
57 | bless { |
---|
58 | config => $conf, |
---|
59 | list => new Mkcd::List($conf), |
---|
60 | build => new Mkcd::Build($conf), |
---|
61 | disc => new Mkcd::Disc($conf) |
---|
62 | }, $class; |
---|
63 | } |
---|
64 | |
---|
65 | # |
---|
66 | # group structure |
---|
67 | # |
---|
68 | # $group[group number]{list}{rpm/srpm} = { list => [[cd, repname, {options}],[], ...,[]] } |
---|
69 | # |
---|
70 | # $group[group number] |
---|
71 | # brokendeps => { |
---|
72 | # rpm_depending_on_non_listed_locales => 1 , |
---|
73 | # rpm_which_deps_are_broken => 2, |
---|
74 | # rpm_exluded_from_conf => 3 } |
---|
75 | # conflict => { $group_number => 1 } this group have common disc with generic like function with group $group_number. |
---|
76 | # depslistid => [ depslist id ] |
---|
77 | # depsrep => deps repository name |
---|
78 | # discdep |
---|
79 | # discdeps => { cd => { cds it depends on ] } |
---|
80 | # discrep |
---|
81 | # disc_impacted=> { cd => 1 } |
---|
82 | # done => { rpm => rep number } |
---|
83 | # installDisc => install disc for this group |
---|
84 | # filelist => [FILELIST] |
---|
85 | # list |
---|
86 | # lang => { locale1 => 1, locale2 => 1} |
---|
87 | # list_conflict=> { list => { type => { grp => { list => { type => 0/1 }}}}} |
---|
88 | # listmatrix |
---|
89 | # listmaxrep => { rpm/srpm => { list => max ordered rep_name number for list list } } |
---|
90 | # listrpm => { list => [ rpm ] } |
---|
91 | # listsize => { rpm => { list => total rpm size, ... } } |
---|
92 | # listsort |
---|
93 | # maxlist |
---|
94 | # maxrep => max ordered rep_name number |
---|
95 | # maxsize => rpm maxsize |
---|
96 | # nodeps => { list => 1} |
---|
97 | # options |
---|
98 | # orderedrep => { rpm/srpm => { "rep_name" => num } } |
---|
99 | # orderedlist => { rpm/srpm } |
---|
100 | # pkgdeps => { package_name => [depslist dependencies ] } |
---|
101 | # pkgrate => { rpm => rpmsrate_increase } |
---|
102 | # globrpm => [ "path1/rpm1" ... "pathn/rpmq" ] |
---|
103 | # rejected => { rpm => [ "error", "message" ] } |
---|
104 | # rep => { type => list => [ { "path" => [pkg list] } } ] |
---|
105 | # rep_pkg => { type => { "path" => [pkg list] } } |
---|
106 | # replist => { $type => [ [ cd, repname, num, [ [related list, related curdir] [] ] ], [], ..., []] } |
---|
107 | # reploc |
---|
108 | # revdeps => [ reversed depslist ] |
---|
109 | # rpmsrate => { rpmsrate } |
---|
110 | # rpmsratepath => rpmsrate path |
---|
111 | # score => [ score weight ] |
---|
112 | # scoredlist => { rpm_name => score } |
---|
113 | # size => { rpm_name => [filesize, list number, directory], ... } |
---|
114 | # srpmname => { srpm => srpm-version-release } |
---|
115 | # sourcerpm => { rpm => sourcerpm } |
---|
116 | # urpm => URPM::urpm |
---|
117 | # option added to urpm |
---|
118 | # rpmkey |
---|
119 | # sourcerpm |
---|
120 | # rpm |
---|
121 | # |
---|
122 | |
---|
123 | sub getGroups { |
---|
124 | my ($config, $lists) = @_; |
---|
125 | my (@list, %cd, %done, %list, %repname); |
---|
126 | log_("getGroups\n", $config->{verbose}, $config->{LOG}, 1); |
---|
127 | foreach my $i (keys %$lists) { |
---|
128 | log_("getGroups: disc $i\n", $config->{verbose}, $config->{LOG}, 2); |
---|
129 | $cd{$i} = 1; |
---|
130 | ref $config->{disc}[$i]{fastgeneric} or next; |
---|
131 | foreach my $f (@{$config->{disc}[$i]{fastgeneric}}) { |
---|
132 | my $repname = $f->[1]{repname}; |
---|
133 | my @k = keys %{$f->[1]}; |
---|
134 | ref $f->[1]{lists} or do { log_("ERROR getGroups: disc $i lists not defined for rep $repname\n", $config->{verbose}, $config->{LOG},3); next }; |
---|
135 | log_("getGroups: lists @{$f->[1]{lists}} repname $repname options (@k)\n", $config->{verbose}, $config->{LOG},3); |
---|
136 | foreach my $g_list (@{$f->[1]{lists}}) { |
---|
137 | log_("getGroups: list $g_list)\n", $config->{verbose}, $config->{LOG}, 3); |
---|
138 | my $idx; |
---|
139 | $idx = push @{$list[$g_list]}, [ $i, ${repname}, $f->[1], {} ]; |
---|
140 | push @{$repname{$i}{$repname}}, [ $g_list, $idx - 1 ]; |
---|
141 | log_("getGroups: cd $i repname $repname list $g_list\n", $config->{verbose}, $config->{LOG},3); |
---|
142 | $list{$g_list} = 0 |
---|
143 | } |
---|
144 | } |
---|
145 | } |
---|
146 | my @group; |
---|
147 | my $g = prepare_cloned_discs(\@group, \%done, $config, $lists); |
---|
148 | my %donerep; |
---|
149 | foreach my $i (keys %$lists) { |
---|
150 | my $t = $config->{disc}[$i]{function}{data}{installation}; |
---|
151 | log_("getGroups: disc $i ($t)\n", $config->{verbose}, $config->{LOG},2); |
---|
152 | ref $t and do { |
---|
153 | log_("getGroups: install disc for group $g => ($i)\n", $config->{verbose}, $config->{LOG},3); |
---|
154 | $group[$g]{installDisc} = $i; |
---|
155 | $group[$g]{options} = $t->[1]; |
---|
156 | $group[$g]{score} ||= $t->[1]{score} || [1,1,1]; |
---|
157 | ($group[$g]{maxrep}{rpm}, $group[$g]{maxlist}{rpm}) = addRepList("rpm", $group[$g], $g, $t->[1]{rpmsdir}, $donerep{$g}, \%done, \%list, \%cd, \%repname, $i, \@list); |
---|
158 | ($group[$g]{maxrep}{srpm}, $group[$g]{maxlist}{srpm}) = addRepList("srpm", $group[$g], $g, $t->[1]{srpmsdir}, $donerep{$g}, \%done, \%list, \%cd, \%repname, $i, \@list); |
---|
159 | my $struct_v = $config->{struct_version}; |
---|
160 | my $media_info = $config->{struct}{$struct_v}{media_info}; |
---|
161 | $group[$g]{rpmsratepath} ||= $t->[1]{rpmsrate} || "$t->[1]{install}/$media_info/rpmsrate"; |
---|
162 | log_("getGroups: using $group[$g]{rpmsratepath} as rpmsrate file\n", $config->{verbose}, $config->{LOG},4); |
---|
163 | $group[$g]{list} and $group[$g]{depsrep} = join '-', keys %{$group[$g]{list}}; |
---|
164 | log_("getGroups: $group[$g]{depsrep} defined as deps file directory\n", $config->{verbose}, $config->{LOG},4); |
---|
165 | if (ref $t->[1]{lang}) { |
---|
166 | foreach (@{$t->[1]{lang}}) { $group[$g]{lang}{$_} = 1 } |
---|
167 | } |
---|
168 | |
---|
169 | $group[$g]{discdeps}{$i} ||= {}; |
---|
170 | log_("getGroups DEBUG: discdep for group $g => ($group[$g]{discdep})\n", $config->{verbose}, $config->{LOG},5); |
---|
171 | $g++; |
---|
172 | } |
---|
173 | } |
---|
174 | my %alone; |
---|
175 | foreach (keys %list) { |
---|
176 | $list{$_} and next; |
---|
177 | log_("getGroups: searching alone groups list $_\n", $config->{verbose}, $config->{LOG},2); |
---|
178 | # FIXME not clean as now with the --group option of generic getAlone add new group |
---|
179 | $group[$g]{score} = [1,1,1]; |
---|
180 | $group[$g]{depsrep} = $_; |
---|
181 | $g = getAlone($list[$_], $_, \@group, $g, \%done, \%alone); |
---|
182 | $list{$_}++; |
---|
183 | log_("getGroups: adding a group $g for list $_\n", $config->{verbose}, $config->{LOG},2); |
---|
184 | $g++ |
---|
185 | } |
---|
186 | |
---|
187 | foreach my $i (keys %$lists) { |
---|
188 | $done{$i} and next; |
---|
189 | $done{$i} = {}; |
---|
190 | log_("getGroups: searching alone disc disc $i does not handled by any group, setting alone group\n", $config->{verbose}, $config->{LOG},2); |
---|
191 | $group[$g]{discdeps}{$i} ||= {}; |
---|
192 | log_("getGroups: adding a group $g for disc $i\n", $config->{verbose}, $config->{LOG},2); |
---|
193 | $g++ |
---|
194 | } |
---|
195 | |
---|
196 | for (my $i; $i < @group; $i++) { |
---|
197 | $group[$i]{orderedlist}{rpm} ||= []; |
---|
198 | foreach (@{$group[$i]{orderedlist}{rpm}}) { |
---|
199 | $group[$i]{list}{$_}{srpm} ||= [] |
---|
200 | } |
---|
201 | $group[$i]{orderedlist}{srpm} ||= []; |
---|
202 | log_("getGroups: ordered rpm list for group $i: @{$group[$i]{orderedlist}{rpm}}\n", $config->{verbose}, $config->{LOG},2); |
---|
203 | log_("getGroups: ordered srpm list for group $i: @{$group[$i]{orderedlist}{srpm}}\n", $config->{verbose}, $config->{LOG},2); |
---|
204 | } |
---|
205 | |
---|
206 | # $config->{verbose} and printTable(\@group); |
---|
207 | \@group |
---|
208 | } |
---|
209 | |
---|
210 | sub getAlone { |
---|
211 | my ($list, $ls, $groups, $g, $done, $alone) = @_; |
---|
212 | my $num = 1; |
---|
213 | $list or return; |
---|
214 | my $lnsort = 1; |
---|
215 | my $replist_list; |
---|
216 | my $group = $groups->[$g]; |
---|
217 | my $grp = $g; |
---|
218 | my $inc; |
---|
219 | foreach my $l (@$list) { |
---|
220 | my ($cd, $rep, $opt) = @$l; |
---|
221 | $done->{$cd}{$rep}{$ls} and next; |
---|
222 | log_("WARNING getAlone: rep $rep of list $_ does not belong to any installation disc, setting alone group $g\n", $config->{verbose}, $config->{LOG}, 1); |
---|
223 | my $type = $opt->{source} ? "srpm" : "rpm"; |
---|
224 | log_("getAlone: searching alone groups list $ls cd $cd rep $rep type $type\n", $config->{verbose}, $config->{LOG},1); |
---|
225 | if ($opt->{group}) { |
---|
226 | $num = 1; |
---|
227 | if ($alone->{$opt->{group}}) { |
---|
228 | $grp--; |
---|
229 | $g = $alone->{$opt->{group}}; |
---|
230 | log_("getAlone: using existing group $g\n", $config->{verbose}, $config->{LOG},1); |
---|
231 | $group = $groups->[$g] |
---|
232 | } else { |
---|
233 | if ($inc) { |
---|
234 | $grp++; |
---|
235 | log_("getAlone: creating a new group $g\n", $config->{verbose}, $config->{LOG},1); |
---|
236 | $groups->[$grp]{score} = [1,1,1]; |
---|
237 | $groups->[$grp]{depsrep} = $ls; |
---|
238 | } |
---|
239 | $g = $grp; |
---|
240 | $alone->{$opt->{group}} = $g; |
---|
241 | $group = $groups->[$g]; |
---|
242 | $inc = 1 |
---|
243 | } |
---|
244 | log_("getAlone: adding list $ls cd $cd rep $rep type $type in group $opt->{group} ($g)\n", $config->{verbose}, $config->{LOG},1); |
---|
245 | } |
---|
246 | $group->{list}{$ls}{$type} or push @{$group->{orderedlist}{$type}}, $ls; |
---|
247 | $group->{listmatrix}{$type}{$ls}{$ls} = 1; |
---|
248 | $config->{list}[$ls]{disc}{$cd}{$rep}{master} ||= $g; |
---|
249 | if (! exists $config->{disc}[$cd]{group_master}) { |
---|
250 | log_("getAlone: setting group $g as master of disc $cd\n", $config->{verbose}, $config->{LOG},2); |
---|
251 | $config->{disc}[$cd]{group_master} = $g; |
---|
252 | push @{$group->{master_of_disc}}, $cd |
---|
253 | } |
---|
254 | $config->{disc}[$cd]{group_list}{$g}{$ls}{$type} = 1; |
---|
255 | push @{$group->{list}{$ls}{$type}}, $l; |
---|
256 | push @{$group->{list_cd}{$ls}{$cd}{$type}}, $l; |
---|
257 | my $cur_num = \$group->{orderedrep}{$type}{"$cd/$rep"}; |
---|
258 | print "CUR_NUM group $group ($g) curnum $cur_num $$cur_num\n"; |
---|
259 | if (! $$cur_num) { |
---|
260 | $$cur_num = $num; |
---|
261 | $replist_list = { $ls => $l }; |
---|
262 | $group->{orderedrep}{$type}{"$cd/$rep"} = $num; |
---|
263 | $group->{replist}{$type}[$num-1] = [ $cd, $rep, $num, $replist_list ]; |
---|
264 | $num++ |
---|
265 | } else { |
---|
266 | $group->{replist}{$type}[$$cur_num-1][3]{$ls} = $l |
---|
267 | } |
---|
268 | print "CUR_NUM $cur_num $$cur_num\n"; |
---|
269 | foreach my $v (@{$config->{list}[$ls]{virtual}}) { |
---|
270 | my ($d_cd, $d_rep) = ($v->{disc}, $v->{repname}); |
---|
271 | log_("getAlone: setting disc_prereq for disc on disc $d_cd for list $ls disc $cd group $g\n", $config->{verbose}, $config->{LOG},2); |
---|
272 | $group->{disc_prereq}{$d_cd}++ |
---|
273 | } |
---|
274 | if (!$group->{listsort}{$ls}{$type}) { $group->{listsort}{$ls}{$type} = $lnsort++ }; |
---|
275 | $done->{$cd}{$rep}{$ls}++; |
---|
276 | log_("getAlone: searching alone groups group $g handle disc $l->[0]\n", $config->{verbose}, $config->{LOG},2); |
---|
277 | # FIXME discdeps may be deprecated for group as hdlists are built without reading real directories. |
---|
278 | $group->{discdeps}{$l->[0]} ||= {}; |
---|
279 | $group->{disc_impacted}{$l->[0]} = 1; |
---|
280 | log_("getAlone: setting nodeps flag for group $g list $ls\n", $config->{verbose}, $config->{LOG},3) if $opt->{nodeps}; |
---|
281 | $group->{nodeps}{$ls} = $opt->{nodeps}; |
---|
282 | $group->{options}{nodeps} = $opt->{nodeps} |
---|
283 | } |
---|
284 | $grp |
---|
285 | } |
---|
286 | |
---|
287 | sub addRepList { |
---|
288 | my ($type, $group, $g, $replist, $donerep, $done, $list, $disc, $repname, $i, $listTable) = @_; |
---|
289 | my $num = 1; |
---|
290 | my $lnsort = 1; |
---|
291 | my $replist_list; |
---|
292 | foreach (@$replist) { |
---|
293 | my ($cdlist, $cd, $name) = @$_; |
---|
294 | my $opt = $_->[3] || {}; |
---|
295 | log_("getGroups: group $g cd $cd repname $name list $cdlist noauto ($opt->{noauto})\n", $config->{verbose}, $config->{LOG},2); |
---|
296 | if ($donerep->{$type}{$cd}{$name}{$cdlist}) { |
---|
297 | log_("ERROR getGroups: $cd/$name/$cdlist is defined multiple time for group $g, ignoring\n", $config->{verbose}, $config->{LOG}); next } |
---|
298 | $donerep->{$type}{$cd}{$name}{$cdlist} = 1; |
---|
299 | if (!$disc->{$cd}) { log_("ERROR getGroups: disc $cd not in list, ignoring\n", $config->{verbose}, $config->{LOG}); next } |
---|
300 | my $ln = $repname->{$cd}{$name}; |
---|
301 | if (!$ln) { log_("ERROR getGroups: $name on disc $cd does not exist\n", $config->{verbose}, $config->{LOG}); next } |
---|
302 | my $cur_num = \$group->{orderedrep}{$type}{"$cd/$name"}; |
---|
303 | if (! $$cur_num) { |
---|
304 | $$cur_num = $num; |
---|
305 | $replist_list = {}; |
---|
306 | $group->{orderedrep}{$type}{"$cd/$name"} = $num; |
---|
307 | @{$group->{reverse_rep}{$type}{$num}}{'cd','name'} = ($cd, $name); |
---|
308 | log_("getGroups: reverse rep for $num type $type $group->{reverse_rep}{$type}{$num}{cd} - $group->{reverse_rep}{$type}{$num}{name}\n", $config->{verbose}, $config->{LOG},2); |
---|
309 | $group->{replist}{$type}[$num-1] = [ $cd, $name, $num, $replist_list ]; |
---|
310 | $num++ |
---|
311 | } else { |
---|
312 | $replist_list = $group->{replist}{$type}[$$cur_num-1][3] |
---|
313 | } |
---|
314 | $cd != $i and $group->{discdeps}{$i}{$cd}++; |
---|
315 | $group->{disc_impacted}{$cd} = 1; |
---|
316 | if ($cd != $i) { log_("getGroups: group $g handle disc $i\n", $config->{verbose}, $config->{LOG},2) } |
---|
317 | foreach my $l (@$ln) { |
---|
318 | my ($ls, $idx) = @$l; |
---|
319 | next if $cdlist && $cdlist != $ls; |
---|
320 | next if $replist_list->{$ls}; |
---|
321 | my $list_options = $listTable->[$ls][$idx][2]; |
---|
322 | if ($group->{listmaxrep}{$type}{$ls} < $group->{orderedrep}{$type}{"$cd/$name"}) { $group->{listmaxrep}{$type}{$ls} = $group->{orderedrep}{$type}{"$cd/$name"} } |
---|
323 | $group->{list}{$ls}{$type} or push @{$group->{orderedlist}{$type}}, $ls; |
---|
324 | foreach my $lst (@{$group->{orderedlist}{$type}}) { $group->{listmatrix}{$type}{$ls}{$lst} = 1 } |
---|
325 | foreach my $lst_ent (@$ln) { $group->{listmatrix}{$type}{$ls}{$lst_ent->[0]} = 1 } |
---|
326 | if (!$group->{listsort}{$ls}{$type}) { $group->{listsort}{$ls}{$type} = $lnsort++ }; |
---|
327 | my $curdir = [ $cd, $name, $list_options, $opt ]; |
---|
328 | push @{$group->{list}{$ls}{$type}}, $curdir; |
---|
329 | push @{$group->{list_cd}{$ls}{$cd}{$type}}, $curdir; |
---|
330 | $replist_list->{$ls} = $curdir; |
---|
331 | foreach my $v (@{$config->{list}[$ls]{virtual}}) { |
---|
332 | my ($d_cd, $d_rep) = ($v->{disc}, $v->{repname}); |
---|
333 | log_("addRepList: setting disc_prereq for disc on disc $d_cd for list $ls disc $cd group $g\n", $config->{verbose}, $config->{LOG},2); |
---|
334 | $group->{disc_prereq}{$d_cd}++ |
---|
335 | } |
---|
336 | if ($opt->{fixed}) { |
---|
337 | if (!$config->{list}[$ls]{disc}{$cd}{$name}{master}) { |
---|
338 | log_("WARNING addRepList: disc $cd rep $name has no master yet\n", $config->{verbose}, $config->{LOG},2) if !$config->{list}[$ls]{disc}{$cd}{$name}{master}; |
---|
339 | $config->{list}[$ls]{disc}{$cd}{$name}{master} = $g; |
---|
340 | } |
---|
341 | } else { |
---|
342 | # this group is the master for this rep |
---|
343 | log_("ERROR addRepList: group $g has already a master, overridding\n", $config->{verbose}, $config->{LOG},2) if $config->{list}[$ls]{disc}{$cd}{$name}{master}; |
---|
344 | $config->{list}[$ls]{disc}{$cd}{$name}{master} = $g; |
---|
345 | if (! exists $config->{disc}[$cd]{group_master}) { |
---|
346 | log_("addRepList: setting group $g as master of disc $cd\n", $config->{verbose}, $config->{LOG},2); |
---|
347 | $config->{disc}[$cd]{group_master} = $g; |
---|
348 | push @{$group->{master_of_disc}}, $cd |
---|
349 | } |
---|
350 | } |
---|
351 | $config->{disc}[$cd]{group_list}{$g}{$ls}{$type} = 1; |
---|
352 | $list->{$ls}++; |
---|
353 | $done->{$cd}{$name}{$ls}++; |
---|
354 | } |
---|
355 | } |
---|
356 | return $num,$lnsort |
---|
357 | } |
---|
358 | |
---|
359 | sub preCheck { |
---|
360 | # TODO |
---|
361 | # may not be necessary |
---|
362 | } |
---|
363 | |
---|
364 | sub orderGroups { |
---|
365 | my ($config, $groups, $lists, $acds) = @_; |
---|
366 | my @metagroups; |
---|
367 | my @tmpmetagroups; |
---|
368 | my @groupmeta; |
---|
369 | my $ok; |
---|
370 | my $check_group = sub { |
---|
371 | my ($i, $og, $cd) = @_; |
---|
372 | log_("orderGroups: checking group $i\n", $config->{verbose}, $config->{LOG},1); |
---|
373 | if (ref $groups->[$i]{master_of_disc}) { |
---|
374 | if ($groupmeta[$i] == $groupmeta[$og]) { |
---|
375 | log_("orderGroups: setting group $i different from $og cos of disc $cd\n", $config->{verbose}, $config->{LOG},5); |
---|
376 | $groupmeta[$i] = $groupmeta[$og] + 1; |
---|
377 | return 0; |
---|
378 | } |
---|
379 | } elsif ($groupmeta[$i] != $groupmeta[$og] && $og == $config->{disc}[$cd]{group_master}) { |
---|
380 | log_("orderGroups: setting group $i equal to $og cos of disc $cd\n", $config->{verbose}, $config->{LOG}, 5); |
---|
381 | $groupmeta[$i] = $groupmeta[$og]; |
---|
382 | return 0 |
---|
383 | } |
---|
384 | 1 |
---|
385 | }; |
---|
386 | # FIXME This algo can create empty metagroups |
---|
387 | while (!$ok) { |
---|
388 | log_("orderGroups: ordering metagroups\n", $config->{verbose}, $config->{LOG}, 4); |
---|
389 | $ok = 1; |
---|
390 | my %handled; |
---|
391 | for (my $i; $i < @$groups; $i++) { |
---|
392 | if ($groups->[$i]{installDisc}) { |
---|
393 | $lists->{$groups->[$i]{installDisc}} == 2 or next |
---|
394 | } |
---|
395 | log_("orderGroups: group $i (install disc $groups->[$i]{installDisc})\n", $config->{verbose}, $config->{LOG}, 6); |
---|
396 | foreach my $list (keys %{$groups->[$i]{list}}) { |
---|
397 | foreach my $type (keys %{$groups->[$i]{list}{$list}}) { |
---|
398 | foreach my $rep (@{$groups->[$i]{list}{$list}{$type}}) { |
---|
399 | my ($cd, $r) = ($rep->[0], $rep->[1]); |
---|
400 | $lists->{$cd} == 2 or next; |
---|
401 | my $og = $config->{disc}[$cd]{group_master}; |
---|
402 | $handled{$cd}{$og} = 1; |
---|
403 | $og == $i and next; |
---|
404 | log_("orderGroups: master of disc $cd/$r = ($og)\n", $config->{verbose}, $config->{LOG}, 8); |
---|
405 | $ok &&= $check_group->($i,$og,$cd); |
---|
406 | } |
---|
407 | } |
---|
408 | } |
---|
409 | } |
---|
410 | for (my $i; $i < @$groups; $i++) { |
---|
411 | foreach my $cd (keys %{$groups->[$i]{disc_prereq}}) { |
---|
412 | log_("ordreGroups: searching for disc_prereq for group $i disc $cd\n", $config->{verbose}, $config->{LOG}, 5); |
---|
413 | foreach (keys %{$handled{$cd}}) { |
---|
414 | $_ == $i and next; |
---|
415 | log_("ordreGroups: disc $cd handled by group $_\n", $config->{verbose}, $config->{LOG}, 5); |
---|
416 | # I do not want group to be set equal in prereq checking (this happen for alone groups when the CD is owned by another group) |
---|
417 | #$ok &&= $check_group->($i,$_,$cd); |
---|
418 | if ($groupmeta[$i] == $groupmeta[$_]) { |
---|
419 | log_("orderGroups: setting group $i different from $_ cos of disc $cd\n", $config->{verbose}, $config->{LOG}, 3); |
---|
420 | $groupmeta[$i] = $groupmeta[$_] + 1; |
---|
421 | $ok = 0 |
---|
422 | } |
---|
423 | } |
---|
424 | } |
---|
425 | } |
---|
426 | } |
---|
427 | for (my $i; $i < @$groups; $i++) { |
---|
428 | if ($groups->[$i]{installDisc}) { |
---|
429 | $lists->{$groups->[$i]{installDisc}} == 2 or next |
---|
430 | } |
---|
431 | log_("orderGroups: group $i metagroup $groupmeta[$i]\n", $config->{verbose}, $config->{LOG}, 8); |
---|
432 | push @{$tmpmetagroups[$groupmeta[$i]][0]}, $groups->[$i]; |
---|
433 | } |
---|
434 | my %donedisc; |
---|
435 | for (my $meta; $meta < @tmpmetagroups; $meta++) { |
---|
436 | my $mg = $tmpmetagroups[$meta]; |
---|
437 | my %cd; |
---|
438 | my %cdg; |
---|
439 | my %iogroup; |
---|
440 | my %cdiogroup; |
---|
441 | my $i = 1; |
---|
442 | foreach (@$acds) { $cd{$_} = $i; $cdiogroup{$_} = $i++ } |
---|
443 | my $grps = $mg->[0]; |
---|
444 | my $i = 0; |
---|
445 | foreach (0 .. $#$grps){ $iogroup{$_} = $i++ } |
---|
446 | my $loop; |
---|
447 | my $ok = 0; |
---|
448 | my %groups_conflict; |
---|
449 | my %old_values; |
---|
450 | while (!$ok && !$loop) { |
---|
451 | ordering_loop: { |
---|
452 | $ok = 1; |
---|
453 | # WARNING group number are not definitive here, they must not be saved! |
---|
454 | foreach my $gn (0 .. $#$grps) { |
---|
455 | my $g = $grps->[$gn]; |
---|
456 | log_("orderGroups: group $gn discs " . (join ' ', (keys %{$g->{discdeps}})) . " list " . join(' ', keys %{$g->{list}}) . "\n", $config->{verbose}, $config->{LOG}, 5); |
---|
457 | foreach my $cd (keys %{$g->{discdeps}}) { |
---|
458 | log_("orderGroups: disc $cd DONEDISC $donedisc{$cd} group $gn\n", $config->{verbose}, $config->{LOG}, 5); |
---|
459 | $donedisc{$cd} and next; |
---|
460 | if ($iogroup{$gn}) { |
---|
461 | log_("orderGroups: making disc $cd from group $gn in the same iogroup as group $gn ($iogroup{$gn})\n", $config->{verbose}, $config->{LOG}, 5); |
---|
462 | if ($iogroup{$gn} != $cdiogroup{$cd}) { |
---|
463 | if ($cdiogroup{$cd} == $old_values{$gn}) { |
---|
464 | log_("ERROR: orderGroups: loop in discs dependencies, taking manual order\n", $config->{verbose}, $config->{LOG}); |
---|
465 | $loop = 1; |
---|
466 | last ordering_loop |
---|
467 | } |
---|
468 | $old_values{$gn} = $iogroup{$gn}; |
---|
469 | $iogroup{$gn} = $cdiogroup{$cd}; |
---|
470 | foreach my $all_cd (keys %{$g->{discdeps}}) { |
---|
471 | $cdiogroup{$all_cd} = $iogroup{$gn}; |
---|
472 | } |
---|
473 | $ok = 0 |
---|
474 | } |
---|
475 | } else { |
---|
476 | $iogroup{$gn} = $cdiogroup{$cd} |
---|
477 | } |
---|
478 | $groups_conflict{$cd}{$gn} = 1; |
---|
479 | #$g->{conflict} = $groups_conflict{$cd}; |
---|
480 | #log_("orderGroups: group $gn conflict with group $gn ($g->{conflict}{$gn})\n", $config->{verbose}, $config->{LOG}, 4); |
---|
481 | log_("orderGroups: orderGroups: disc $cd\n", $config->{verbose}, $config->{LOG}, 5); |
---|
482 | $lists->{$cd} >= 1 or next; |
---|
483 | $cdg{$cd} = {}; |
---|
484 | if (ref $g->{discdeps}{$cd}) { |
---|
485 | foreach (keys %{$g->{discdeps}{$cd}}) { |
---|
486 | $donedisc{$_} and next; |
---|
487 | $cdiogroup{$_} = $cdiogroup{$cd}; |
---|
488 | log_("orderGroups: disc $cd => $_\n", $config->{verbose}, $config->{LOG}, 7); |
---|
489 | if ($cdg{$cd}{$_}) { |
---|
490 | log_("ERROR: orderGroups: loop in discs dependencies, taking manual order\n", $config->{verbose}, $config->{LOG}); |
---|
491 | $loop = 1; |
---|
492 | last ordering_loop |
---|
493 | } |
---|
494 | $cdg{$cd}{$_} = 1; |
---|
495 | $cdg{$_} = {}; |
---|
496 | if ($cd{$cd} <= $cd{$_}) { |
---|
497 | $cd{$cd} = $cd{$_} + 1; |
---|
498 | $ok = 0 |
---|
499 | } |
---|
500 | } |
---|
501 | } |
---|
502 | } |
---|
503 | } |
---|
504 | } |
---|
505 | } |
---|
506 | if ($loop) { |
---|
507 | # Does not take care of iogroup in manual mode |
---|
508 | $metagroups[$meta][0][0] = $mg; |
---|
509 | foreach my $c (@$acds) { $cdg{$c} and $lists->{$c} == 2 and push @{$metagroups[$meta][0][1]}, $c and $donedisc{$c} = 1 } |
---|
510 | } else { |
---|
511 | my @siogroup = sort { $iogroup{$a} <=> $iogroup{$b} } keys %iogroup; |
---|
512 | my %iogroupcd; |
---|
513 | $metagroups[$meta][0][0] = []; |
---|
514 | for (my ($i, $j); $i < @siogroup; $i++) { |
---|
515 | if ($i && $iogroup{$siogroup[$i]} != $iogroup{$siogroup[$i-1]}) { |
---|
516 | $j++; |
---|
517 | $metagroups[$meta][$j][0] = [] |
---|
518 | } |
---|
519 | log_("orderGroups: siogroup $i ($siogroup[$i] iogroup $iogroup{$siogroup[$i]} cd " . join(',',keys %{$grps->[$siogroup[$i]]{disc_impacted}}) ." list " . join(',',keys %{$grps->[$siogroup[$i]]{list}}) . ")\n", $config->{verbose}, $config->{LOG}, 8); |
---|
520 | my $g = $grps->[$siogroup[$i]]; |
---|
521 | push @{$metagroups[$meta][$j][0]}, $g; |
---|
522 | $iogroupcd{$_} = $j foreach keys %{$g->{disc_impacted}} |
---|
523 | } |
---|
524 | #foreach (keys %iogroup) { |
---|
525 | # log_("orderGroups: group $_ (CDs " . join(',', keys %{$grps->[$_]{disc_impacted}}) . ") in iogroup $iogroup{$_}\n", 1, $config->{LOG}) |
---|
526 | #} |
---|
527 | my @scds = sort { $cd{$a} <=> $cd{$b} } keys %cdg; |
---|
528 | foreach my $c (@scds) { $lists->{$c} == 2 and push @{$metagroups[$meta][$iogroupcd{$c}][1]}, $c and $donedisc{$c} = 1 } |
---|
529 | } |
---|
530 | for (my $iogi; $iogi < @{$metagroups[$meta]}; $iogi++) { |
---|
531 | ref $metagroups[$meta][$iogi][1] or next; |
---|
532 | log_("orderGroups: IO group $iogi disc sorting @{$metagroups[$meta][$iogi][1]}\n", $config->{verbose}, $config->{LOG}, 4); |
---|
533 | } |
---|
534 | |
---|
535 | # for (my $i = 0; $i < @$grps; $i++) { |
---|
536 | # foreach my $ls (keys %{$grps->[$i]{list}}) { |
---|
537 | # foreach my $l (keys %{$grps->[$i]{list}}) { |
---|
538 | # log_("orderGroups: group $i listmatrix list $ls - list $l -> $grps->[$i]{listmatrix}{rpm}{$ls}{$l}\n", $config->{verbose}, $config->{LOG}) |
---|
539 | # } |
---|
540 | # foreach my $t (keys %{$grps->[$i]{list}{$ls}}) { |
---|
541 | # my $rep = $grps->[$i]{list}{$ls}{$t}; |
---|
542 | # for (my $grp = 0; $grp < @$grps; $grp++) { |
---|
543 | # foreach my $list (keys %{$grps->[$grp]{list}}) { |
---|
544 | # foreach my $type (keys %{$grps->[$grp]{list}{$list}}) { |
---|
545 | # my $rep2 = $grps->[$grp]{list}{$list}{$type}; |
---|
546 | # foreach my $a (@$rep) { |
---|
547 | # if (any { $a->[0] == $_->[0] } @$rep2) { |
---|
548 | # log_("orderGroups: group $i list $ls type $t conflicts with group $grp list $list type $type\n", $config->{verbose}, $config->{LOG}); |
---|
549 | # $grps->[$i]{conflict}{$grp} = 1; |
---|
550 | # $grps->[$i]{list_conflict}{$ls}{$t}{$grp}{$list}{$type} = 1; |
---|
551 | # last |
---|
552 | # } |
---|
553 | # } |
---|
554 | # } |
---|
555 | # } |
---|
556 | # } |
---|
557 | # } |
---|
558 | # } |
---|
559 | # } |
---|
560 | } |
---|
561 | # add alone discs |
---|
562 | my @cd; |
---|
563 | foreach (keys %donedisc) { |
---|
564 | $donedisc{$_} or push @cd, $_ |
---|
565 | } |
---|
566 | @cd and push @metagroups, [[0, \@cd]]; |
---|
567 | |
---|
568 | for (my $m = 0; $m < @metagroups; $m++) { |
---|
569 | for (my $iog = 0; $iog < @{$metagroups[$m]}; $iog++) { |
---|
570 | #log_("GROUP $i iog $iog: $metagroups[$m][$iog][0] (@{$metagroups[$m][$iog][0]})\n", $config->{verbose}, $config->{LOG}, 3); |
---|
571 | my $grps = $metagroups[$m][$iog][0]; |
---|
572 | for (my $i = 0; $i < @$grps; $i++) { |
---|
573 | foreach my $ls (keys %{$grps->[$i]{list}}) { |
---|
574 | foreach my $l (keys %{$grps->[$i]{list}}) { |
---|
575 | foreach my $t (keys %{$grps->[$i]{list}{$ls}}) { |
---|
576 | my $rep = $grps->[$i]{list}{$ls}{$t}; |
---|
577 | for (my $grp = 0; $grp < @$grps; $grp++) { |
---|
578 | foreach my $list (keys %{$grps->[$grp]{list}}) { |
---|
579 | foreach my $type (keys %{$grps->[$grp]{list}{$list}}) { |
---|
580 | my $rep2 = $grps->[$grp]{list}{$list}{$type}; |
---|
581 | foreach my $a (@$rep) { |
---|
582 | if (any { $a->[0] == $_->[0] } @$rep2) { |
---|
583 | log_("orderGroups: group $i list $ls type $t conflicts with group $grp list $list type $type\n", $config->{verbose}, $config->{LOG}); |
---|
584 | $grps->[$i]{conflict}{$grp} = 1; |
---|
585 | $grps->[$grp]{conflict}{$i} = 1; |
---|
586 | $grps->[$i]{list_conflict}{$ls}{$t}{$grp}{$list}{$type} = 1; |
---|
587 | last |
---|
588 | } |
---|
589 | } |
---|
590 | } |
---|
591 | } |
---|
592 | } |
---|
593 | } |
---|
594 | } |
---|
595 | } |
---|
596 | } |
---|
597 | } |
---|
598 | } |
---|
599 | \@metagroups |
---|
600 | } |
---|
601 | |
---|
602 | sub getGroupReps { |
---|
603 | my ($config, $group, $discsFiles) = @_; |
---|
604 | my $topdir = "$config->{topdir}/build/$config->{name}"; |
---|
605 | my $check_discsFiles = sub { |
---|
606 | my ($cd, $rep, $listnumber, $rep_nb) = @_; |
---|
607 | log_("getGroupReps check_discsfiles: disc $cd rep $rep list $listnumber\n", $config->{verbose} , $config->{LOG}, 5); |
---|
608 | foreach (keys %{$discsFiles->[$cd]{$rep}{$listnumber}}) { |
---|
609 | my $type = /src$/ ? 'srpm' : 'rpm'; |
---|
610 | my $d = $discsFiles->[$cd]{$rep}{$listnumber}{$_}; |
---|
611 | push @{$group->{rep}{$listnumber}[$rep_nb]{$type}{$d}}, $_; |
---|
612 | push @{$group->{rep_pkg}{$type}{$d}}, $_ |
---|
613 | } |
---|
614 | }; |
---|
615 | # FIXME sep_arch is not used, maybe a chech should prevent both sep_arch and non sep_arch mode. |
---|
616 | # However current scheme is more robust. |
---|
617 | my $check_dir = sub { |
---|
618 | my ($dir, $listnumber, $rep_nb, $type, $test, $sep_arch) = @_; |
---|
619 | log_("getGroupReps check_dir: dir $dir list $listnumber rep_nb $rep_nb type $type\n", $config->{verbose}, $config->{LOG},6); |
---|
620 | my $add_rpm = sub { |
---|
621 | my ($d, $rpm) = @_; |
---|
622 | $rpm =~ /($test)\.rpm$/ or return; |
---|
623 | $rpm = ~/(.*)\.rpm$/ or return; |
---|
624 | push @{$group->{rep}{$listnumber}[$rep_nb]{$type}{$d}}, $1; |
---|
625 | push @{$group->{rep_pkg}{$type}{$d}}, $1 |
---|
626 | }; |
---|
627 | my $RPMS; |
---|
628 | if (!opendir $RPMS, $dir) { log_("WARNING getGroupReps: cannot open $dir\n", $config->{verbose}, $config->{LOG}); return } |
---|
629 | foreach (readdir $RPMS) { |
---|
630 | if (-d "$dir/$_") { |
---|
631 | opendir my $rpm_dir, "$dir/$_"; |
---|
632 | foreach my $r (readdir $RPMS) { |
---|
633 | $add_rpm->("$dir/$_",$r) |
---|
634 | } |
---|
635 | } else { |
---|
636 | $add_rpm->($dir,$_) |
---|
637 | } |
---|
638 | } |
---|
639 | closedir $RPMS |
---|
640 | }; |
---|
641 | my $testarch = join '|', keys %{$config->{ARCH}}; |
---|
642 | foreach my $listnumber (keys %{$group->{list}}) { |
---|
643 | my $ok; |
---|
644 | foreach (@{$group->{list}{$listnumber}{rpm}}) { |
---|
645 | !$_->[3]{nodeps} and $ok = 1 |
---|
646 | } |
---|
647 | if (!$ok) { $group->{nodeps}{$listnumber} = 1 } |
---|
648 | log_("getGroupReps list $listnumber\n", $config->{verbose}, $config->{LOG},3); |
---|
649 | my $rep_nb; |
---|
650 | if (ref $config->{list}[$listnumber]{packages}) { |
---|
651 | foreach (@{$config->{list}[$listnumber]{packages}}) { |
---|
652 | log_("getGroupReps: rep num $rep_nb\n", $config->{verbose}, $config->{LOG},4); |
---|
653 | foreach my $t ('rpm', 'srpm') { |
---|
654 | foreach my $d (@{$_->{$t}}) { |
---|
655 | log_("getGroupReps: $d\n", $config->{verbose}, $config->{LOG},5); |
---|
656 | $check_dir->($d, $listnumber, $rep_nb, $t, $t eq 'rpm' ? $testarch : 'src'); |
---|
657 | } |
---|
658 | } |
---|
659 | $rep_nb++ |
---|
660 | } |
---|
661 | } |
---|
662 | |
---|
663 | foreach my $d (@{$config->{list}[$listnumber]{virtual}}) { |
---|
664 | my $cd = $d->{disc}; |
---|
665 | my $rep = $d->{repname}; |
---|
666 | my $path = $config->{disc}[$cd]{function}{data}{dir}{$rep}[1]{reploc}; |
---|
667 | my $sep_arch = $config->{disc}[$cd]{function}{data}{dir}{$rep}[1]{sep_arch}; |
---|
668 | my $dir = "$topdir/$cd/$path"; |
---|
669 | log_("getGroupReps: virtual disc $cd path $path (num $rep_nb) in $dir\n", $config->{verbose} , $config->{LOG},3); |
---|
670 | if ($discsFiles->[$cd]{$rep}{$listnumber}) { |
---|
671 | $check_discsFiles->($cd,$rep,$listnumber) |
---|
672 | } elsif (-d $dir) { |
---|
673 | $check_dir->($dir,$listnumber,$rep_nb, 'rpm',$testarch, $sep_arch); |
---|
674 | } else { |
---|
675 | log_("ERROR getGroupReps: could not find virtual disc $cd path $path\n", $config->{verbose} , $config->{LOG}); |
---|
676 | next |
---|
677 | } |
---|
678 | $rep_nb++ |
---|
679 | } |
---|
680 | foreach my $cd (keys %{$config->{list}[$listnumber]{disc}}) { |
---|
681 | foreach my $rep (keys %{$config->{list}[$listnumber]{disc}{$cd}}) { |
---|
682 | if ($config->{list}[$listnumber]{disc}{$cd}{$rep}{done}) { |
---|
683 | $check_discsFiles->($cd, $rep, $listnumber) |
---|
684 | } |
---|
685 | $rep_nb++ |
---|
686 | } |
---|
687 | } |
---|
688 | } |
---|
689 | } |
---|
690 | |
---|
691 | # TODO at present clone only do full copy |
---|
692 | sub prepare_cloned_discs { |
---|
693 | my ($group, $done, $config, $lists) = @_; |
---|
694 | my $g; |
---|
695 | foreach my $cd (keys %$lists) { |
---|
696 | my $loc_conf = $config->{disc}[$cd]{function}; |
---|
697 | if ($loc_conf->{data}{clone}) { |
---|
698 | log_("prepare_cloned_discs: disc $cd\n", $config->{verbose}, $config->{LOG},2); |
---|
699 | # nothing to do, cp -r |
---|
700 | #if (@{$loc_conf->{list}} == 1 && !$loc_conf->{list}[0][1]{to_del}) { |
---|
701 | # |
---|
702 | $loc_conf->{data}{clone}[0][1]{full_copy} = 1; |
---|
703 | $group->[$g]{disc_impacted}{$cd} = 1; |
---|
704 | $group->[$g]{discdeps}{$cd} = {}; |
---|
705 | log_("prepare_cloned_discs: setting group $g as master of disc $cd\n", $config->{verbose}, $config->{LOG}, 4); |
---|
706 | $config->{disc}[$cd]{group_master} = int $g; |
---|
707 | push @{$group->[$g]{master_of_disc}}, $cd; |
---|
708 | |
---|
709 | foreach (@{$loc_conf->{data}{clone}}) { |
---|
710 | $group->[$g]{disc_prereq}{$_->[1]{disc}}++ |
---|
711 | } |
---|
712 | $done->{$cd} = {}; |
---|
713 | $g++ |
---|
714 | # next |
---|
715 | #} |
---|
716 | } |
---|
717 | } |
---|
718 | $g |
---|
719 | } |
---|
720 | |
---|
721 | sub find_cpu { |
---|
722 | my $cpu; |
---|
723 | open my $CPU, "/proc/cpuinfo"; |
---|
724 | while (<$CPU>) { /processor/ and $cpu++ }; |
---|
725 | $cpu |
---|
726 | } |
---|
727 | |
---|
728 | sub make_io_group { |
---|
729 | my ($class, $iog, $config, $log, $lists, $discs_files, $cdsize, $size, $graft, $sort, $inode, $done_deps, $iotask, $metagroups, $mkisos) = @_; |
---|
730 | my $cds = $iog->[1]; |
---|
731 | my $groups = $iog->[0]; |
---|
732 | print $log "Group: $iog (@$cds -- $groups)\n"; |
---|
733 | # FIXME ordering metagroups can lead to empty groups with the -l option |
---|
734 | $groups or next; |
---|
735 | |
---|
736 | my (@buildlist, @rpmlist, @needed); |
---|
737 | my @groupok; |
---|
738 | |
---|
739 | #print_conflict_matrix($groups); |
---|
740 | for (my $i; $i < @$groups; $i++) { |
---|
741 | log_("Get already built discs lists\n", $config->{verbose}, $log, 3); |
---|
742 | $groups->[$i]{done} = {}; |
---|
743 | $class->{disc}->getBuiltDiscs($lists, $groups->[$i], $discs_files); |
---|
744 | |
---|
745 | log_("GROUP $i\n", $config->{verbose}, $log, 5); |
---|
746 | getGroupReps($config, $groups->[$i], $discs_files); |
---|
747 | |
---|
748 | log_("genDeps\n", $config->{verbose}, $log, 3); |
---|
749 | if (! $done_deps->{$groups->[$i]{depsrep}} && ref $groups->[$i]{rep_pkg}{rpm}) { |
---|
750 | $done_deps->{$groups->[$i]{depsrep}} = genDeps("$config->{tmp}/$config->{name}/$groups->[$i]{depsrep}", $groups->[$i]{rep_pkg}{rpm}, $config->{deps}, $config->{verbose}, $config->{tmp}) or do { log_("ERROR: genDeps failed\n", $config->{verbose}, $log); return 0 } |
---|
751 | } |
---|
752 | $groups->[$i]{urpm} = $done_deps->{$groups->[$i]{depsrep}}; |
---|
753 | log_("getSize\n", $config->{verbose}, $log, 3); |
---|
754 | my $redeps = getSize($groups->[$i],$config, $config->{verbose}) or do { log_("ERROR: getSize failed\n", $config->{verbose}, $log); return 0 }; |
---|
755 | |
---|
756 | $class->{disc}->guessHdlistSize($groups->[$i], $size, $cdsize, $lists, $discs_files); |
---|
757 | |
---|
758 | # put in getList to handle package nodeps flag |
---|
759 | #$groups->[$i]{revdeps} = $class->{list}->reverseDepslist($groups->[$i]); |
---|
760 | |
---|
761 | ($groups->[$i]{filelist}, my $norpmsrate) = $class->{list}->getList($groups->[$i], $discs_files); |
---|
762 | |
---|
763 | if ($groups->[$i]{rpmsratepath}) { |
---|
764 | my $struct_v = $config->{struct_version}; |
---|
765 | my $media_info = $config->{struct}{$struct_v}{media_info}; |
---|
766 | my $outputdir = "$config->{tmp}/build/$config->{name}/$groups->[$i]{installDisc}/$media_info/"; |
---|
767 | -d $outputdir or mkpath $outputdir; |
---|
768 | my $output = "$outputdir/rpmsrate"; |
---|
769 | # FIXME currently the rpmsrate is updated at group creation, |
---|
770 | # maybe need to be done again at disc finalizing stage only to include |
---|
771 | # present packages. However it is harmfull to have packages into the rpmsrate not |
---|
772 | # present on the discs. |
---|
773 | log_("cleanrpmsrate $groups->[$i]{rpmsratepath} -> $output\n", $config->{verbose}, $log, 3); |
---|
774 | $groups->[$i]{rpmsrate} = cleanrpmsrate($groups->[$i]{rpmsratepath}, $output, $norpmsrate, $groups->[$i]{rep_pkg}{rpm}, $groups->[$i]{urpm}) or log_("ERROR: cleanrpmsrate failed\n", $config->{verbose}, $log); |
---|
775 | $groups->[$i]{options}{rpmsrate} = $output; |
---|
776 | } |
---|
777 | |
---|
778 | log_("build_list group $i\n", $config->{verbose}, $log, 3); |
---|
779 | ($rpmlist[$i], $groups->[$i]{revdeps}) = $class->{list}->build_list($groups->[$i]) or return 0; |
---|
780 | |
---|
781 | $class->{list}->scoreList($groups->[$i]) or return 0; |
---|
782 | $class->{list}->autodeps($groups->[$i], $rpmlist[$i]); |
---|
783 | |
---|
784 | foreach my $l (keys %{$rpmlist[$i]}) { |
---|
785 | my (@force, @need, @superforce, @limit, @b); |
---|
786 | foreach (keys %{$rpmlist[$i]{$l}}) { |
---|
787 | log_("Group: rpm $_\n", $config->{verbose}, $log); |
---|
788 | # in case of multiple entries |
---|
789 | $groups->[$i]{limit}{$_} = 0; |
---|
790 | if (!$_) { |
---|
791 | log_("ERROR: empty rpmlist key ($rpmlist[$i]{$l}{$_}) KEYS " . keys(%{$rpmlist[$i]{$l}{$_}}) . " \n", $config->{verbose}, $log); |
---|
792 | next |
---|
793 | } |
---|
794 | my $elt = [ $_, $rpmlist[$i]{$l}{$_}, $groups->[$i]{scorelist}{$_} ]; |
---|
795 | if (!$config->{nodeps} && !$groups->[$i]{options}{nodeps} && !$groups->[$i]{nodeps}{$l} && /basesystem/) { |
---|
796 | $elt->[1]{needed} = 1; |
---|
797 | push @superforce, $elt |
---|
798 | } elsif ($rpmlist[$i]{$l}{$_}{force}) { |
---|
799 | #$elt->[1]{needed} = 1; |
---|
800 | push @force, $elt |
---|
801 | } elsif ($rpmlist[$i]{$l}{$_}{limit}) { |
---|
802 | $groups->[$i]{limit}{$_} = 1; |
---|
803 | push @limit, $elt |
---|
804 | } else { |
---|
805 | push @b, $elt |
---|
806 | } |
---|
807 | push @{$needed[$i]{$l}{alap}[$rpmlist[$i]{$l}{$_}{needed}]}, $elt, if $rpmlist[$i]{$l}{$_}{needed}; |
---|
808 | # used to check which packages has beed rejected |
---|
809 | push @{$groups->[$i]{buildlist}}, $_ |
---|
810 | } |
---|
811 | $buildlist[$i]{$l} = [ sort { $a->[2] <=> $b->[2] } @b ]; |
---|
812 | unshift @{$buildlist[$i]{$l}}, sort { $a->[2] <=> $b->[2] } @limit; |
---|
813 | # needed must not be put first. |
---|
814 | #push @{$buildlist[$i]{$l}}, sort { $a->[2] <=> $b->[2] } @need; |
---|
815 | push @{$buildlist[$i]{$l}}, sort { $a->[2] <=> $b->[2] } @force; |
---|
816 | push @{$buildlist[$i]{$l}}, sort { $a->[2] <=> $b->[2] } @superforce |
---|
817 | } |
---|
818 | } |
---|
819 | |
---|
820 | # FIXME it must have a cleaner manner to keep buildlist and do not have |
---|
821 | # to copy it. |
---|
822 | my @cb; |
---|
823 | for (my $i = 0; $i < @buildlist; $i++) { |
---|
824 | foreach my $l (keys %{$buildlist[$i]}) { |
---|
825 | $cb[$i]{$l} = []; |
---|
826 | foreach (@{$buildlist[$i]{$l}}) { |
---|
827 | log_("MakeWithGroups: copying buildlist group $i list $l package $_->[0] score $_->[2] options " . join(' ', keys %{$_->[1]}) . "\n", $config->{verbose}, $log, 4); |
---|
828 | push @{$cb[$i]{$l}}, $_ |
---|
829 | } |
---|
830 | } |
---|
831 | } |
---|
832 | |
---|
833 | my $diff = { data => [], idx => [] }; |
---|
834 | my $rejected; |
---|
835 | my $n=1; |
---|
836 | $rejected = $class->{build}->buildDiscs($groups, \@cb, \@rpmlist, \@groupok, $size, $cdsize,$lists,$cds, \@needed,$diff,$n) if @cb; |
---|
837 | my $logi; |
---|
838 | my ($cd, $diff) = $class->{build}->processDiff($groups,$diff, $discs_files); |
---|
839 | my $ok; |
---|
840 | # discs_files contains all the rpms, cd contains only the diff |
---|
841 | |
---|
842 | log_("make_io_group: $cd->[2]\n", $config->{verbose}, $log, 3); |
---|
843 | $class->{disc}->makeDiscs(1,$lists,$cds, $size, $mkisos, $discs_files, $graft, $sort, $inode, $cd) or return 0; |
---|
844 | $ok = $class->{disc}->checkSize($n, $size, $cdsize, $cds, $rejected); |
---|
845 | #log_("make_io_group: disc_building_tries $config->{disc_building_tries}\n",1,$log); |
---|
846 | $ok = 1 if $config->{disc_building_tries} < 2; |
---|
847 | while (!$ok) { |
---|
848 | $n++; |
---|
849 | log_("make_io_group: trying to adjust disc size, try $n\n", $config->{verbose}, $log, 3); |
---|
850 | $ok = 1; |
---|
851 | my @cb; |
---|
852 | for (my $i; $i < @buildlist; $i++) { |
---|
853 | foreach my $l (keys %{$buildlist[$i]}) { |
---|
854 | $cb[$i]{$l} = []; |
---|
855 | foreach (@{$buildlist[$i]{$l}}) { |
---|
856 | push @{$cb[$i]{$l}}, $_ if $groups->[$i]{rejected}{$_->[0]}{$l} |
---|
857 | } |
---|
858 | } |
---|
859 | } |
---|
860 | $rejected = $class->{build}->buildDiscs($groups, \@cb, \@rpmlist, \@groupok, $size, $cdsize, $lists, $cds, \@needed, $diff, $n) if @cb; |
---|
861 | my ($cd, $diff) = $class->{build}->processDiff($groups, $diff, $discs_files); |
---|
862 | $class->{disc}->makeDiscs($n, $lists, $cds, $size, $mkisos, $discs_files, $graft, $sort, $inode, $cd) or return 0; |
---|
863 | $ok = $class->{disc}->checkSize($n, $size, $cdsize, $cds, $rejected); |
---|
864 | !$ok and log_("ERROR: one or more disc are too big or too small, trying to correct\n", $config->{verbose}, $log, 2); |
---|
865 | if ($n >= $config->{disc_building_tries}) { |
---|
866 | log_("ERROR: could not manage to build discs of correct size, exiting\n", $config->{verbose}, $log); |
---|
867 | last |
---|
868 | } |
---|
869 | } |
---|
870 | # finally really build the ISOs |
---|
871 | if ($config->{nofork}) { |
---|
872 | $class->{disc}->makeDiscs(-1, $lists, $cds, $size, $mkisos, $discs_files, $graft, $sort, $inode, $cd); |
---|
873 | } else { |
---|
874 | # FIXME This algo is not correct, it happens that some IO tasks are still parallelized |
---|
875 | my $pid = fork; |
---|
876 | $pid and log_("make_io_group: fork to PID $pid to build ISO files\n", $config->{verbose}, $log, 1); |
---|
877 | if (!$pid) { |
---|
878 | while (@$iotask) { |
---|
879 | my $p = pop @$iotask; |
---|
880 | log_("make_io_group: waiting for IOtask PID $p to finish\n", $config->{verbose}, $log, 2); |
---|
881 | waitpid $p, 0 |
---|
882 | } |
---|
883 | $class->{disc}->makeDiscs(-1, $lists, $cds, $size, $mkisos, $discs_files, $graft, $sort, $inode, $cd); |
---|
884 | exit |
---|
885 | } else { |
---|
886 | push @$iotask, $pid |
---|
887 | } |
---|
888 | } |
---|
889 | for (my $i; $i < @$groups; $i++) { |
---|
890 | foreach my $list (keys %{$groups->[$i]{list}}) { |
---|
891 | foreach my $type (keys %{$groups->[$i]{list}{$list}}) { |
---|
892 | foreach (@{$groups->[$i]{list}{$list}{$type}}) { |
---|
893 | $config->{list}[$list]{disc}{$_->[0]}{$_->[1]}{done} = 1 |
---|
894 | } |
---|
895 | } |
---|
896 | } |
---|
897 | } |
---|
898 | } |
---|
899 | |
---|
900 | sub makeWithGroups { |
---|
901 | my ($class, $lists, $acds) = @_; |
---|
902 | my $config = $class->{config}; |
---|
903 | my $log = $config->{LOG}; |
---|
904 | my $metagroups = orderGroups($config, getGroups($config, $lists), $lists, $acds); |
---|
905 | |
---|
906 | my @discsFiles; |
---|
907 | my (@cdsize, %size, %graft, %sort, %done_deps, %inode, @iotask, @mkisos); |
---|
908 | for (my $i; $i < @{$config->{disc}}; $i++) { |
---|
909 | $cdsize[$i] = $config->{disc}[$i]{size}; |
---|
910 | $size{optimize_space}{disc}{$i} = $cdsize[$i] |
---|
911 | } |
---|
912 | foreach my $iog (@$metagroups) { |
---|
913 | foreach (@$iog) { |
---|
914 | ref $_->[1] or next; |
---|
915 | log_("makeWithGroups: Group listing $_ (@{$_->[1]} -- $_->[0])\n", $config->{verbose}, $config->{LOG}, 3); |
---|
916 | my $cds = $_->[1]; |
---|
917 | # Do not make first CDs in io groups to keep inter io groups alone directories safe. |
---|
918 | $class->{disc}->makeDiscs(0, $lists, $cds, \%size, \@mkisos, \@discsFiles, \%graft, \%sort, \%inode); |
---|
919 | } |
---|
920 | } |
---|
921 | $config->{cpu} = find_cpu() if !$config->{cpu}; |
---|
922 | log_("makeWithGroups: will try to use $config->{cpu} CPUs\n", $config->{verbose}, $config->{LOG}, 3); |
---|
923 | |
---|
924 | foreach my $g (@$metagroups) { |
---|
925 | foreach my $iog (@$g) { |
---|
926 | make_io_group($class, $iog, $config, $log, $lists, \@discsFiles, \@cdsize, \%size, \%graft, \%sort, \%inode, \%done_deps, \@iotask, $metagroups, \@mkisos); |
---|
927 | } |
---|
928 | } |
---|
929 | printDiscsFile($config, \@discsFiles, $config->{print}, $metagroups); |
---|
930 | $config->{printscript} and printBatchFile($config, \@discsFiles, $config->{printscript}); |
---|
931 | foreach my $p (@iotask) { |
---|
932 | waitpid $p, 0 |
---|
933 | } |
---|
934 | print "\n"; |
---|
935 | 1 |
---|
936 | } |
---|
937 | |
---|
938 | 1 |
---|
939 | |
---|
940 | # |
---|
941 | # Changelog |
---|
942 | # |
---|
943 | # 2002 02 21 |
---|
944 | # add maxlistmaxrep value to group |
---|
945 | # |
---|
946 | # 2002 03 03 |
---|
947 | # change size to an hash that contains disc size and rep size |
---|
948 | # |
---|
949 | # 2002 03 09 |
---|
950 | # make group{discrep} and hash not to have loop in disc dependencies when there are multiple repository on one CD |
---|
951 | # |
---|
952 | # 2002 03 14 |
---|
953 | # BIG change of group source handling |
---|
954 | # |
---|
955 | # 2002 03 15 |
---|
956 | # use new source handling |
---|
957 | # |
---|
958 | # 2002 03 23 |
---|
959 | # change getAlone to be able to build generic CDs without installation |
---|
960 | # |
---|
961 | # 2002 06 16 |
---|
962 | # add conflict in group |
---|
963 | # |
---|
964 | # 2002 08 30 |
---|
965 | # change reps structure, add pkg and pkg_rep in group |
---|
966 | # |
---|
967 | # 2004 05 28 |
---|
968 | # add IO group to be able to separate IO tasks from CPU tasks |
---|