source: soft/build_system/build_system/mkcd/trunk/pm/Mkcd/Group.pm @ 1

Last change on this file since 1 was 1, checked in by fasma, 12 years ago

Initial Import from Mandriva's soft revision 224062 and package revision 45733

File size: 50.1 KB
Line 
1package Mkcd::Group;
2
3my $VERSION = '2.0.3';
4
5use strict;
6use File::NCopy qw(copy);       
7use File::Path;
8use Mkcd::Disc;
9use Mkcd::List;
10use Mkcd::Build;
11use Mkcd::Tools qw(cleanrpmsrate printTable printDiscsFile readBatchFile printBatchFile log_);
12use Mkcd::Package qw(genDeps getSize);
13use Mkcd::Shell;
14use MDK::Common qw(any);
15use POSIX ":sys_wait_h";
16#use Mkcd::Optimize qw(print_conflict_matrix);
17
18=head1 NAME
19
20Group - mkcd module
21
22=head1 SYNOPSYS
23
24    require Mkcd::Group;
25
26=head1 DESCRIPTION
27
28C<Mkcd::Group> include the mkcd high level disc building routines.
29
30=head1 SEE ALSO
31
32mkcd
33
34=head1 COPYRIGHT
35
36Copyright (C) 2000,2001,2002,2003,2004,2005 Mandrakesoft
37Copyright (C) 2006 Mandriva
38
39Author: Florent Villard <warly@mandriva.com>
40
41This program is free software; you can redistribute it and/or modify
42it under the terms of the GNU General Public License as published by
43the Free Software Foundation; either version 2, or (at your option)
44any later version.
45
46This program is distributed in the hope that it will be useful,
47but WITHOUT ANY WARRANTY; without even the implied warranty of
48MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
49GNU General Public License for more details.
50
51You should have received a copy of the GNU General Public License
52along with this program; if not, write to the Free Software
53Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
54
55=cut
56
57my $config;
58
59sub new {
60    my ($class, $conf) = @_;
61    $config = $conf;
62    bless {
63            config      => $conf,
64            list        => new Mkcd::List($conf),
65            build       => new Mkcd::Build($conf),
66            disc        => new Mkcd::Disc($conf)
67       }, $class;
68}
69
70#
71# group structure
72#
73# $group[group number]{list}{rpm/srpm} = { list => [[cd, repname, {options}],[], ...,[]] }
74#
75# $group[group number]
76# brokendeps   => {
77#       rpm_depending_on_non_listed_locales => 1 ,
78#       rpm_which_deps_are_broken => 2,
79#       rpm_exluded_from_conf => 3 }
80# conflict     => { $group_number => 1 } this group have common disc with generic like function with group $group_number.
81# depslistid   => [ depslist id ]
82# depsrep      => deps repository name
83# discdep
84# discdeps     => { cd => { cds it depends on ] }
85# discrep
86# disc_impacted=> { cd => 1 }
87# done         => { rpm => rep number }
88# installDisc  => install disc for this group
89# filelist     => [FILELIST]
90# list
91# lang         => { locale1 => 1, locale2 => 1}
92# list_conflict=> { list => { type => { grp => { list => { type => 0/1 }}}}}
93# listmatrix
94# listmaxrep   => { rpm/srpm => { list => max ordered rep_name number for list list } }
95# listrpm      => { list => [ rpm ] }
96# listsize     => { rpm => { list => total rpm size, ... } }
97# listsort
98# maxlist
99# maxrep       => max ordered rep_name number
100# maxsize      => rpm maxsize
101# nodeps       => { list => 1}
102# options
103# orderedrep   => { rpm/srpm => { "rep_name" => num } }
104# orderedlist  => { rpm/srpm }
105# pkgdeps      => { package_name => [depslist dependencies ] }
106# pkgrate      => { rpm => rpmsrate_increase }
107# globrpm      => [ "path1/rpm1" ... "pathn/rpmq" ]
108# rejected     => { rpm => [ "error", "message" ] }
109# rep          => { type => list => [ { "path" => [pkg list] } } ]
110# rep_pkg      => { type => { "path" => [pkg list] } }
111# replist      => { $type => [ [ cd, repname, num, [ [related list, related curdir] [] ] ], [], ..., []] }
112# reploc
113# revdeps      => [ reversed depslist ]
114# rpmsrate     => { rpmsrate }
115# rpmsratepath => rpmsrate path
116# score        => [ score weight ]
117# scoredlist   => { rpm_name => score }
118# size         => { rpm_name => [filesize, list number, directory], ... }
119# srpmname     => { srpm => srpm-version-release }
120# sourcerpm    => { rpm => sourcerpm }
121# urpm         => URPM::urpm
122#     option added to urpm
123#     rpmkey
124#     sourcerpm
125#     rpm
126#
127
128sub getGroups {
129    my ($config, $lists) = @_;
130    my (@list, %cd, %done, %list, %repname);
131    log_("getGroups\n", $config->{verbose}, $config->{LOG}, 1);
132    foreach my $i (keys %$lists) {
133        log_("getGroups: disc $i\n", $config->{verbose}, $config->{LOG}, 2);
134        $cd{$i} = 1;
135        ref $config->{disc}[$i]{fastgeneric} or next;
136        foreach my $f (@{$config->{disc}[$i]{fastgeneric}}) {
137            my $repname = $f->[1]{repname};
138            my @k = keys %{$f->[1]};
139            ref $f->[1]{lists} or do { log_("ERROR getGroups: disc $i lists not defined for rep $repname ($f->[0] [@k])\n", $config->{verbose}, $config->{LOG},3); next };
140            log_("getGroups: lists @{$f->[1]{lists}} repname $repname options (@k)\n", $config->{verbose}, $config->{LOG},3);
141            foreach my $g_list (@{$f->[1]{lists}}) {
142                log_("getGroups: list $g_list\n", $config->{verbose}, $config->{LOG}, 3);
143                my $idx;
144                $idx = push @{$list[$g_list]}, [ $i, ${repname}, $f->[1], {} ];
145                push @{$repname{$i}{$repname}}, [ $g_list, $idx - 1 ];
146                log_("getGroups: cd $i repname $repname list $g_list\n", $config->{verbose}, $config->{LOG},3);
147                $list{$g_list} = 0
148            }
149        }
150    }
151    my @group;
152    my $g = prepare_cloned_discs(\@group, \%done, $config, $lists);
153    my %donerep;
154    foreach my $i (keys %$lists) {
155        foreach my $t (@{$config->{disc}[$i]{function}{data}{installation}}) {
156            log_("getGroups: disc $i\n", $config->{verbose}, $config->{LOG},2);
157            ref $t and do {
158                log_("getGroups: install disc for group $g => ($i)\n", $config->{verbose}, $config->{LOG},3);
159                $group[$g]{installation} = $t;
160                $group[$g]{installDisc} = $i;
161                $group[$g]{options} = $t->[1];
162                $group[$g]{score} ||= $t->[1]{score} || [1,1,1];
163                ($group[$g]{maxrep}{rpm}, $group[$g]{maxlist}{rpm}) = addRepList("rpm", $group[$g], $g, $t->[1]{rpmsdir}, $donerep{$g}, \%done, \%list, \%cd, \%repname, $i, \@list);
164                ($group[$g]{maxrep}{srpm}, $group[$g]{maxlist}{srpm}) = addRepList("srpm", $group[$g], $g, $t->[1]{srpmsdir}, $donerep{$g}, \%done, \%list, \%cd, \%repname, $i, \@list);
165                log_("getGroups: group $g 1 maxrep srpm $group[$g]{maxrep}{srpm} maxlist srpm $group[$g]{maxlist}{srpm}\n", $config->{verbose}, $config->{LOG},4);
166                log_("getGroups: group $g 1 maxrep rpm $group[$g]{maxrep}{rpm} maxlist rpm $group[$g]{maxlist}{rpm}\n", $config->{verbose}, $config->{LOG},4);
167                my $struct_v = $config->{struct_version};
168                my $media_info = $config->{struct}{$struct_v}{media_info};
169                $group[$g]{rpmsratepath} ||= $t->[1]{rpmsrate} || "$t->[1]{install}/$media_info/rpmsrate";
170                log_("getGroups: using $group[$g]{rpmsratepath} as rpmsrate file\n", $config->{verbose}, $config->{LOG},4);
171                $group[$g]{list} and $group[$g]{depsrep} = join '-', keys %{$group[$g]{list}};
172                log_("getGroups: $group[$g]{depsrep} defined as deps file directory\n", $config->{verbose}, $config->{LOG},4);
173                if (ref $t->[1]{lang}) {
174                    foreach (@{$t->[1]{lang}}) { $group[$g]{lang}{$_} = 1 }
175                }
176
177                $group[$g]{discdeps}{$i} ||= {};
178                log_("getGroups DEBUG: discdep for group $g => ($group[$g]{discdep})\n", $config->{verbose}, $config->{LOG},5);
179                $g++
180            };
181            if ($config->{struct_version} < 2007) {
182                log_("getGroups: struct $config->{struct_version} is <= 2007, ignoring any extra installation procedure on the disc $i\n", $config->{verbose}, $config->{LOG},2);
183                last
184            }
185        }
186    }
187    my %alone;
188    foreach (keys %list) {
189        $list{$_} and next;
190        log_("getGroups: searching alone groups list $_\n", $config->{verbose}, $config->{LOG},2);
191        # FIXME not clean as now with the --group option of generic getAlone add new group
192        $group[$g]{score} = [1,1,1];
193        $group[$g]{depsrep} = $_;
194        $g = getAlone($list[$_], $_, \@group, $g, \%done, \%alone, \@list, $lists);
195        $list{$_}++;
196        log_("getGroups: adding a group $g for list $_\n", $config->{verbose}, $config->{LOG},2);
197        $g++
198    }
199
200    foreach my $i (keys %$lists) {
201        $done{$i} and next;
202        $done{$i} = {};
203        # do not take care of already done CDs
204        $lists->{$i} > 1 or next;
205        log_("getGroups: searching alone disc disc $i does not handled by any group, setting alone group\n", $config->{verbose}, $config->{LOG},2);
206        $group[$g]{discdeps}{$i} ||= {};
207        log_("getGroups: adding a group $g for disc $i\n", $config->{verbose}, $config->{LOG},2);
208        $g++
209    }
210   
211    for (my $i; $i < @group; $i++) {
212        $group[$i]{orderedlist}{rpm} ||= [];
213        foreach (@{$group[$i]{orderedlist}{rpm}}) {
214            $group[$i]{list}{$_}{srpm} ||= []
215        }
216        $group[$i]{orderedlist}{srpm} ||= [];
217        log_("getGroups: ordered rpm list for group $i: @{$group[$i]{orderedlist}{rpm}}\n", $config->{verbose}, $config->{LOG},2);     
218        log_("getGroups: ordered srpm list for group $i: @{$group[$i]{orderedlist}{srpm}}\n", $config->{verbose}, $config->{LOG},2);   
219    }
220   
221    # $config->{verbose} and printTable(\@group);
222    \@group
223}
224
225sub getAlone {
226    my ($list, $ls, $groups, $g, $done, $alone, $listTable, $lists) = @_;
227    my $num = 1;
228    $list or return;
229    my $lnsort = 1;
230    my $replist_list;
231    my $group = $groups->[$g];
232    my $grp = $g;
233    my $inc;
234    my $ok;
235    foreach my $l (@$list) {
236        my ($cd, $rep, $opt) = @$l;
237        # Do not take care of already done CDs for alone group;
238        $ok = 1 if $lists->{$cd} > 1
239    }
240    if (!$ok) {
241        log_("getAlone: no active disc found for list @$list, ignoring\n", $config->{verbose}, $config->{LOG}, 1);
242        return
243    } 
244    foreach my $l (@$list) {
245        my ($cd, $rep, $opt) = @$l;
246        $done->{$cd}{$rep}{$ls} and next;
247        log_("WARNING getAlone: rep $rep of list $_ does not belong to any installation disc, setting alone group $g\n", $config->{verbose}, $config->{LOG}, 1);
248        my $type = $opt->{source} ? "srpm" : "rpm";
249        log_("getAlone: searching alone groups list $ls cd $cd rep $rep type $type\n", $config->{verbose}, $config->{LOG},1);
250        if ($opt->{group}) {
251            $num = 1;
252            if ($alone->{$opt->{group}}) {
253                $grp--;
254                $g = $alone->{$opt->{group}};
255                log_("getAlone: using existing group $g\n", $config->{verbose}, $config->{LOG},1);
256                $group = $groups->[$g]
257            } else {
258                if ($inc) {
259                    $grp++;
260                    log_("getAlone: creating a new group $g\n", $config->{verbose}, $config->{LOG},1);
261                    $groups->[$grp]{score} = [1,1,1];
262                    $groups->[$grp]{depsrep} = $ls;
263                }
264                $g = $grp;
265                $alone->{$opt->{group}} = $g;   
266                $group = $groups->[$g];
267                $inc = 1
268            }
269            log_("getAlone: adding list $ls cd $cd rep $rep type $type in group $opt->{group} ($g)\n", $config->{verbose}, $config->{LOG},1);
270        }
271        $group->{list}{$ls}{$type} or push @{$group->{orderedlist}{$type}}, $ls;       
272        log_("getAlone: ordered list for group $g type $type (@{$group->{orderedlist}{$type}})\n", $config->{verbose}, $config->{LOG},1);
273        $group->{listmatrix}{$type}{$ls}{$ls} = $num if !$group->{listmatrix}{$type}{$ls}{$ls} || $num < $group->{listmatrix}{$type}{$ls}{$ls};
274        # Alone groups should not take precedence
275        $config->{list}[$ls]{disc}{$cd}{$rep}{master} ||= $g;
276        if (! exists $config->{disc}[$cd]{group_master}) {
277            log_("getAlone: setting group $g as master of disc $cd\n", $config->{verbose}, $config->{LOG},2);
278            $config->{disc}[$cd]{group_master} = $g;
279            push @{$group->{master_of_disc}}, $cd
280        }
281        $config->{disc}[$cd]{group_list}{$g}{$ls}{$type} = 1;
282        my $curdir = [ $cd, $rep, {}, $opt ];
283        push @{$group->{list}{$ls}{$type}}, $curdir;
284        push @{$group->{list_cd}{$ls}{$cd}{$type}}, $curdir;
285        my $cur_num = \$group->{orderedrep}{$type}{"$cd/$rep"};
286        print "CUR_NUM group $group ($g) curnum $cur_num $$cur_num\n";
287        if (! $$cur_num) {
288            $$cur_num = $num;
289            $replist_list = { $ls => $l };
290            $group->{orderedrep}{$type}{"$cd/$rep"} = $num;
291            $group->{replist}{$type}[$num-1] = [ $cd, $rep, $num, $replist_list ];
292            $num++
293        } else {
294            $group->{replist}{$type}[$$cur_num-1][3]{$ls} = $l
295        }
296        print "CUR_NUM $cur_num $$cur_num\n";
297        foreach my $v (@{$config->{list}[$ls]{virtual}}) {
298            my ($d_cd, $d_rep) = ($v->{disc}, $v->{repname});
299            log_("getAlone: setting disc_prereq for disc on disc $d_cd for list $ls disc $cd group $g\n", $config->{verbose}, $config->{LOG},2);
300            $group->{disc_prereq}{$d_cd}++
301        }
302        if (!$group->{listsort}{$ls}{$type}) { $group->{listsort}{$ls}{$type} = $lnsort++ };
303        $done->{$cd}{$rep}{$ls}++;
304        log_("getAlone: searching alone groups group $g handle disc $l->[0]\n", $config->{verbose}, $config->{LOG},2);
305        # FIXME discdeps may be deprecated for group as hdlists are built without reading real directories.
306        $group->{discdeps}{$l->[0]} ||= {};
307        $group->{disc_impacted}{$l->[0]} = 1;
308        log_("getAlone: setting nodeps flag for group $g list $ls\n", $config->{verbose}, $config->{LOG},3) if $opt->{nodeps};
309        $group->{nodeps}{$ls} = $opt->{nodeps};
310        $group->{options}{nodeps} = $opt->{nodeps}
311    }
312    $grp
313}
314
315sub check_relative_media_path {
316    my ($group, $cd, $name) = @_;
317    my $installation = $group->{installation};
318    my $prefix = $installation->[1]{prefix};
319    my $rpmdir = $config->{disc}[$cd]{function}{data}{dir}{$name}[1]{reploc};
320    my $media_base = $config->{struct}{$config->{struct_version}}{media_base};
321    $prefix =~ s,^/*,,;
322    my $newdir = $rpmdir;
323    $newdir =~ s,^/*,,;
324    # FIXME there is a security version of this code which is more or less the same in Functions::buildInstallHdlist, it may be uniformised
325    if ($newdir !~ m,^$prefix,) {
326        my $hdlists_rpmdir = "/$prefix/$media_base/";
327        $hdlists_rpmdir =~ s,/+[^/]+,../,g;
328        $hdlists_rpmdir .= "/$rpmdir";
329        $hdlists_rpmdir =~ s,/+,/,g;
330        $newdir =~ s,.*/([^/]+)/?,$1,;
331        $newdir = "$prefix/$media_base/$newdir";
332        $newdir =~ s,/+,/,g;
333        # add an extra symlink function to the appropriate CD to create the symlink between arch/media/mainX and ../../other_arch/media/mainX
334        my $functions = $config->{group}{disc}{functions}{functions};
335        my $idx = @{$config->{disc}[$cd]{function}{list}};
336        &{$functions->{symlink}[0][5]}($cd, $idx, $hdlists_rpmdir, $newdir);
337        log_("check_relative_media_path: adding a new symlink for disc $cd from $hdlists_rpmdir to $newdir\n", $config->{verbose}, $config->{LOG},4)
338    }
339    log_("check_relative_media_path: $cd/$name is $newdir (for $prefix)\n", $config->{verbose}, $config->{LOG},2);
340    $installation->[1]{repname}{"$cd/$name"} = $newdir
341}
342
343sub addRepList {
344    my ($type, $group, $g, $replist, $donerep, $done, $list, $disc, $repname, $i, $listTable) = @_;
345    my $num = 1;
346    my $lnsort = 1;
347    my $replist_list;
348    foreach (@$replist) {
349        my ($cdlist, $cd, $name) = @$_;
350        check_relative_media_path($group, $cd, $name);
351        my $opt = $_->[3] || {};
352        log_("getGroups: group $g cd $cd repname $name list $cdlist noauto ($opt->{noauto})\n", $config->{verbose}, $config->{LOG},2);
353        if ($donerep->{$type}{$cd}{$name}{$cdlist}) {
354            log_("ERROR getGroups: $cd/$name/$cdlist is defined multiple time for group $g, ignoring\n", $config->{verbose}, $config->{LOG}); next }
355        $donerep->{$type}{$cd}{$name}{$cdlist} = 1;
356        if (!$disc->{$cd}) { log_("ERROR getGroups: disc $cd not in list, ignoring\n", $config->{verbose}, $config->{LOG}); next }
357        my $ln = $repname->{$cd}{$name};
358        if (!$ln) { log_("ERROR getGroups: $name on disc $cd does not exist\n", $config->{verbose}, $config->{LOG}); next }
359        my $cur_num = \$group->{orderedrep}{$type}{"$cd/$name"};
360        my $tmp_num = $num;
361        if (! $$cur_num) {
362            $$cur_num = $num;
363            $replist_list = {};
364            $group->{orderedrep}{$type}{"$cd/$name"} = $num;
365            @{$group->{reverse_rep}{$type}{$num}}{'cd','name'} = ($cd, $name);
366            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);
367            $group->{replist}{$type}[$num-1] = [ $cd, $name, $num, $replist_list ];
368            $num++
369        } else {
370            $replist_list = $group->{replist}{$type}[$$cur_num-1][3]
371        }
372        $cd != $i and $group->{discdeps}{$i}{$cd}++;
373        $group->{disc_impacted}{$cd} = 1;
374        if ($cd != $i) { log_("getGroups: group $g ($i) handles disc $cd\n", $config->{verbose}, $config->{LOG},2) }
375        foreach my $l (@$ln) {
376            my ($ls, $idx) = @$l;
377            next if $cdlist && $cdlist != $ls;
378            next if $replist_list->{$ls};
379            my $list_options = $listTable->[$ls][$idx][2];
380            if ($group->{listmaxrep}{$type}{$ls} < $group->{orderedrep}{$type}{"$cd/$name"}) { 
381                my $max =  $group->{orderedrep}{$type}{"$cd/$name"};
382                log_("addRepList: listmaxrep for list $ls is now $max (for $cd/$name)\n", $config->{verbose}, $config->{LOG},2);
383                $group->{listmaxrep}{$type}{$ls} = $max 
384            }
385            $group->{list}{$ls}{$type} or push @{$group->{orderedlist}{$type}}, $ls;   
386            foreach my $lst_ent (@$ln) { 
387                log_("addRepList: listmatrix $type list $ls list $lst_ent->[0] = $tmp_num\n", $config->{verbose}, $config->{LOG},2);
388                $group->{listmatrix}{$type}{$ls}{$lst_ent->[0]} = $tmp_num if !$group->{listmatrix}{$type}{$ls}{$lst_ent->[0]} || $tmp_num < $group->{listmatrix}{$type}{$ls}{$lst_ent->[0]}
389            } 
390            foreach my $lst (@{$group->{orderedlist}{$type}}) { 
391                log_("addRepList: listmatrix $type list $ls list $lst = $group->{listmatrix}{$type}{$lst}{$lst}\n", $config->{verbose}, $config->{LOG},2);
392                $group->{listmatrix}{$type}{$ls}{$lst} = $group->{listmatrix}{$type}{$lst}{$lst} if !$group->{listmatrix}{$type}{$ls}{$lst} || $group->{listmatrix}{$type}{$lst}{$lst} < $group->{listmatrix}{$type}{$ls}{$lst}
393            }
394           
395            if (!$group->{listsort}{$ls}{$type}) { $group->{listsort}{$ls}{$type} = $lnsort++ };
396            my $curdir = [ $cd, $name, $list_options, $opt ];
397            push @{$group->{list}{$ls}{$type}}, $curdir;
398            push @{$group->{list_cd}{$ls}{$cd}{$type}}, $curdir;
399            $replist_list->{$ls} = $curdir;
400            foreach my $v (@{$config->{list}[$ls]{virtual}}) {
401                my ($d_cd, $d_rep) = ($v->{disc}, $v->{repname});
402                log_("addRepList: setting disc_prereq for disc on disc $d_cd for list $ls disc $cd group $g\n", $config->{verbose}, $config->{LOG},2);
403                $group->{disc_prereq}{$d_cd}++
404            }
405            if ($opt->{fixed}) {
406                if (! exists $config->{list}[$ls]{disc}{$cd}{$name}{master}) {
407                    log_("WARNING addRepList: disc $cd list $ls rep $name has no master yet\n", $config->{verbose}, $config->{LOG},2) if !$config->{list}[$ls]{disc}{$cd}{$name}{master};
408                    $config->{list}[$ls]{disc}{$cd}{$name}{master} = $g
409                }
410            } else {
411                # this group is the master for this rep
412                log_("ERROR addRepList: group $g has already a master, overridding\n", $config->{verbose}, $config->{LOG},2) if $config->{list}[$ls]{disc}{$cd}{$name}{master};
413                $config->{list}[$ls]{disc}{$cd}{$name}{master} = $g;
414                if (! exists $config->{disc}[$cd]{group_master}) {
415                    log_("addRepList: setting group $g as master of disc $cd\n", $config->{verbose}, $config->{LOG},2);
416                    $config->{disc}[$cd]{group_master} = $g;
417                    push @{$group->{master_of_disc}}, $cd
418                }
419            }
420            $config->{disc}[$cd]{group_list}{$g}{$ls}{$type} = 1;
421            $list->{$ls}++;
422            $done->{$cd}{$name}{$ls}++;
423        }
424    }
425    if (ref $group->{master_of_disc}) {
426        my $seq_size = @{$group->{master_of_disc}};
427        my $i = 1;
428        foreach my $cd (@{$group->{master_of_disc}}) {
429            log_("addRepList: disc sequence $cd is $i/$seq_size\n", $config->{verbose}, $config->{LOG},2);
430            $config->{disc}[$cd]{seq_size} = $seq_size;
431            $config->{disc}[$cd]{seq_num} = $i++;
432        }
433    }
434    return $num, $lnsort
435}
436
437sub preCheck {
438    # TODO
439    # may not be necessary
440}
441
442sub orderGroups {
443    my ($config, $groups, $lists, $acds) = @_;
444    my @metagroups;
445    my @tmpmetagroups;
446    my @groupmeta;
447    my $ok;
448    my $check_group = sub {
449        my ($i, $og, $cd) = @_;
450        log_("orderGroups: checking group $i\n", $config->{verbose}, $config->{LOG},1);
451        if (ref $groups->[$i]{master_of_disc}) {
452            if ($groupmeta[$i] == $groupmeta[$og]) {
453                log_("orderGroups: setting group $i different from $og cos of disc $cd\n", $config->{verbose}, $config->{LOG},5);
454                $groupmeta[$i] = $groupmeta[$og] + 1;
455                return 0;
456            }
457        } elsif ($groupmeta[$i] != $groupmeta[$og] && $og == $config->{disc}[$cd]{group_master}) {
458            log_("orderGroups: setting group $i equal to $og cos of disc $cd\n", $config->{verbose}, $config->{LOG}, 5);
459            $groupmeta[$i] = $groupmeta[$og];
460            return 0
461        }
462        1
463    };
464    # FIXME This algo can create empty metagroups
465    while (!$ok) {
466        log_("orderGroups: ordering metagroups\n", $config->{verbose}, $config->{LOG}, 4);
467        $ok = 1;
468        my %handled;
469        for (my $i; $i < @$groups; $i++) {
470            if ($groups->[$i]{installDisc}) {
471                $lists->{$groups->[$i]{installDisc}} == 2 or next
472            }
473            log_("orderGroups: group $i (install disc $groups->[$i]{installDisc})\n", $config->{verbose}, $config->{LOG}, 6);
474            foreach my $list (keys %{$groups->[$i]{list}}) {
475                foreach my $type (keys %{$groups->[$i]{list}{$list}}) {
476                    foreach my $rep (@{$groups->[$i]{list}{$list}{$type}}) {
477                        my ($cd, $r) = ($rep->[0], $rep->[1]);
478                        $lists->{$cd} == 2 or next;
479                        my $og = $config->{disc}[$cd]{group_master};
480                        $handled{$cd}{$og} = 1;
481                        $og == $i and next;
482                        log_("orderGroups: master of disc $cd/$r = ($og)\n", $config->{verbose}, $config->{LOG}, 8);
483                        $ok &&= $check_group->($i,$og,$cd);
484                    }
485                }
486            }
487        }
488        for (my $i; $i < @$groups; $i++) {
489            foreach my $cd (keys %{$groups->[$i]{disc_prereq}}) {
490                log_("ordreGroups: searching for disc_prereq for group $i disc $cd\n", $config->{verbose}, $config->{LOG}, 5);
491                foreach (keys %{$handled{$cd}}) {
492                    $_ == $i and next;
493                    log_("ordreGroups: disc $cd handled by group $_\n", $config->{verbose}, $config->{LOG}, 5);
494                    # 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)
495                    #$ok &&= $check_group->($i,$_,$cd);
496                    if ($groupmeta[$i] == $groupmeta[$_]) {
497                        log_("orderGroups: setting group $i different from $_ cos of disc $cd\n", $config->{verbose}, $config->{LOG}, 3);
498                        $groupmeta[$i] = $groupmeta[$_] + 1;
499                        $ok = 0
500                    } 
501                }
502            }
503        }
504    }
505    for (my $i; $i < @$groups; $i++) {
506        if ($groups->[$i]{installDisc}) {
507            $lists->{$groups->[$i]{installDisc}} == 2 or next
508        }
509        log_("orderGroups: group $i metagroup $groupmeta[$i]\n", $config->{verbose}, $config->{LOG}, 8);
510        push @{$tmpmetagroups[$groupmeta[$i]][0]}, $groups->[$i];
511    }
512    my %donedisc;
513    for (my $meta; $meta < @tmpmetagroups; $meta++) {
514        log_("orderGroups: metagroup $meta\n", $config->{verbose}, $config->{LOG}, 5);
515        my $mg = $tmpmetagroups[$meta];
516        my %cd;
517        my %cdg;
518        my %iogroup;
519        my %cdiogroup;
520        my $i = 1;
521        foreach (@$acds) { $cd{$_} = $i; $cdiogroup{$_} = $i++ }
522        my $grps = $mg->[0];
523        my $i = 0;
524        foreach (0 .. $#$grps){ $iogroup{$_} = $i++ }
525        my $loop;
526        my $ok = 0;
527        my %groups_conflict;
528        my %old_values;
529        while (!$ok && !$loop) {
530ordering_loop: {
531            $ok = 1;
532            # WARNING group number are not definitive here, they must not be saved!
533            foreach my $gn (0 .. $#$grps) {
534                my $g = $grps->[$gn];
535                my @discdeps = (keys %{$g->{discdeps}});
536                my @lists =  (keys %{$g->{list}});
537                log_("orderGroups: group $gn discs @discdeps list @lists\n", $config->{verbose}, $config->{LOG}, 5);
538                foreach my $cd (@discdeps) {
539                    log_("orderGroups: disc $cd DONEDISC $donedisc{$cd} group $gn\n", $config->{verbose}, $config->{LOG}, 5);
540                    $donedisc{$cd} and next;
541                    if ($iogroup{$gn}) {
542                        log_("orderGroups: making disc $cd from group $gn in the same iogroup as group $gn ($iogroup{$gn})\n", $config->{verbose}, $config->{LOG}, 5);
543                        if ($iogroup{$gn} != $cdiogroup{$cd}) {
544                            if ($cdiogroup{$cd} == $old_values{$gn}) {
545                                log_("ERROR: orderGroups: loop in discs dependencies, taking manual order\n", $config->{verbose}, $config->{LOG}); 
546                                $loop = 1;
547                                last ordering_loop
548                            }
549                            $old_values{$gn} = $iogroup{$gn};
550                            $iogroup{$gn} = $cdiogroup{$cd};
551                            foreach my $all_cd (@discdeps) {
552                                $cdiogroup{$all_cd} = $iogroup{$gn};
553                            }
554                            $ok = 0
555                        }
556                    } else {
557                        $iogroup{$gn} = $cdiogroup{$cd}
558                    }
559                    $groups_conflict{$cd}{$gn} = 1;
560                    #$g->{conflict} = $groups_conflict{$cd};
561                    #log_("orderGroups: group $gn conflict with group $gn ($g->{conflict}{$gn})\n", $config->{verbose}, $config->{LOG}, 4);
562                    log_("orderGroups: orderGroups: disc $cd\n", $config->{verbose}, $config->{LOG}, 5);
563                    $lists->{$cd} >= 1 or next;
564                    $cdg{$cd} = {};
565                    if (ref $g->{discdeps}{$cd}) {
566                        foreach (keys %{$g->{discdeps}{$cd}}) {
567                            $donedisc{$_} and next;
568                            $cdiogroup{$_} = $cdiogroup{$cd}; 
569                            log_("orderGroups: disc $cd => $_\n", $config->{verbose}, $config->{LOG}, 7);
570                            if ($cdg{$cd}{$_}) { 
571                                log_("ERROR: orderGroups: loop in discs dependencies, taking manual order\n", $config->{verbose}, $config->{LOG}); 
572                                $loop = 1;
573                                last ordering_loop
574                            }
575                            $cdg{$cd}{$_} = 1;
576                            $cdg{$_} = {};
577                            if ($cd{$cd} <= $cd{$_}) { 
578                                $cd{$cd} = $cd{$_} + 1;
579                                $ok = 0
580                            }
581                        }
582                    }
583                }
584            }
585        }
586        }
587        # FIXME This code may not be needed, as the group with only fixed list are alone, and only linked to one disc, they should
588        # not be separated into a new IO group, but this I am not sure.
589        foreach my $gn (0 .. $#$grps) {
590            my $g = $grps->[$gn];
591            my @discdeps = (keys %{$g->{discdeps}});
592            my @lists =  (keys %{$g->{list}});
593            my $all_fixed = 1;
594            foreach my $list (@lists) {
595                $all_fixed &&= $config->{list}[$list]{fixed}
596            }
597            if ($all_fixed) {
598                # a fixed rep should only have one CD
599                my ($cd) = $discdeps[0];
600                log_("orderGroups: all the list are fixed for group $gn, including it into same iogroup as disc $cd ($cdiogroup{$cd})\n", $config->{verbose}, $config->{LOG}, 5);
601                $groups_conflict{$cd}{$gn} = 1;
602                $iogroup{$gn} = $cdiogroup{$cd};
603            }
604        }
605        if ($loop) {
606            # Does not take care of iogroup in manual mode
607            $metagroups[$meta][0][0] = $mg;
608            foreach my $c (@$acds) { $cdg{$c} and $lists->{$c} == 2 and push @{$metagroups[$meta][0][1]}, $c and $donedisc{$c} = 1 } 
609        } else {
610            my @siogroup = sort { $iogroup{$a} <=> $iogroup{$b} } keys %iogroup;
611            my %iogroupcd;
612            $metagroups[$meta][0][0] = [];
613            for (my ($i, $j); $i < @siogroup; $i++) {
614                if ($i && $iogroup{$siogroup[$i]} != $iogroup{$siogroup[$i-1]}) {
615                    $j++;
616                    $metagroups[$meta][$j][0] = []
617                }
618                log_("orderGroups: siogroup $i (j $j siogroup $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);
619                my $g = $grps->[$siogroup[$i]];
620                push @{$metagroups[$meta][$j][0]}, $g;
621                $iogroupcd{$_} = $j foreach keys %{$g->{disc_impacted}}
622            }
623            #foreach (keys %iogroup) {
624            #   log_("orderGroups: group $_ (CDs " . join(',', keys %{$grps->[$_]{disc_impacted}}) . ") in iogroup $iogroup{$_}\n", 1, $config->{LOG})
625            #}
626            my @scds = sort { $cd{$a} <=> $cd{$b} } keys %cdg;
627            foreach my $c (@scds) { 
628                log_("orderGroups: ordered CDs disc $c selected  $lists->{$c} donedisc $donedisc{$c}\n", $config->{verbose}, $config->{LOG}, 8);
629                $lists->{$c} == 2 and push @{$metagroups[$meta][$iogroupcd{$c}][1]}, $c and $donedisc{$c} = 1 
630            }   
631        }
632        for (my $iogi; $iogi < @{$metagroups[$meta]}; $iogi++) {
633            ref $metagroups[$meta][$iogi][1] or next;
634            log_("orderGroups: IO group $iogi disc sorting @{$metagroups[$meta][$iogi][1]}\n", $config->{verbose}, $config->{LOG}, 4);
635        }
636       
637#       for (my $i = 0; $i < @$grps; $i++) {
638#           foreach my $ls (keys %{$grps->[$i]{list}}) {
639#               foreach my $l (keys %{$grps->[$i]{list}}) {
640#                   log_("orderGroups: group $i listmatrix list $ls - list $l -> $grps->[$i]{listmatrix}{rpm}{$ls}{$l}\n", $config->{verbose}, $config->{LOG})
641#               }
642#               foreach my $t (keys %{$grps->[$i]{list}{$ls}}) {
643#                   my $rep = $grps->[$i]{list}{$ls}{$t};
644#                   for (my $grp = 0; $grp < @$grps; $grp++) {
645#                       foreach my $list (keys %{$grps->[$grp]{list}}) {
646#                           foreach my $type (keys %{$grps->[$grp]{list}{$list}}) {
647#                               my $rep2 = $grps->[$grp]{list}{$list}{$type};
648#                               foreach my $a (@$rep) {
649#                                   if (any { $a->[0] == $_->[0] } @$rep2) {
650#                                       log_("orderGroups: group $i list $ls type $t conflicts with group $grp list $list type $type\n", $config->{verbose}, $config->{LOG});   
651#                                       $grps->[$i]{conflict}{$grp} = 1;
652#                                       $grps->[$i]{list_conflict}{$ls}{$t}{$grp}{$list}{$type} = 1;
653#                                       last
654#                                   }
655#                               }
656#                           }
657#                       }
658#                   }
659#               }
660#           }
661#       }
662    }
663    # add alone discs
664    my @cd;
665    foreach (keys %donedisc) {
666        $donedisc{$_} or push @cd, $_ 
667    }
668    @cd and push @metagroups, [[0, \@cd]];
669   
670    for (my $m = 0; $m < @metagroups; $m++) {
671        for (my $iog = 0; $iog < @{$metagroups[$m]}; $iog++) {
672            #log_("GROUP $i iog $iog: $metagroups[$m][$iog][0] (@{$metagroups[$m][$iog][0]})\n", $config->{verbose}, $config->{LOG}, 3);
673            my $grps = $metagroups[$m][$iog][0];
674            for (my $i = 0; $i < @$grps; $i++) {
675                foreach my $ls (keys %{$grps->[$i]{list}}) {
676                    foreach my $l (keys %{$grps->[$i]{list}}) {
677                        foreach my $t (keys %{$grps->[$i]{list}{$ls}}) {
678                            my $rep = $grps->[$i]{list}{$ls}{$t};
679                            for (my $grp = 0; $grp < @$grps; $grp++) {
680                                foreach my $list (keys %{$grps->[$grp]{list}}) {
681                                    foreach my $type (keys %{$grps->[$grp]{list}{$list}}) {
682                                        my $rep2 = $grps->[$grp]{list}{$list}{$type};
683                                        foreach my $a (@$rep) {
684                                            if (any { $a->[0] == $_->[0] } @$rep2) {
685                                                log_("orderGroups: group $i list $ls type $t conflicts with group $grp list $list type $type\n", $config->{verbose}, $config->{LOG});   
686                                                $grps->[$i]{conflict}{$grp} = 1;
687                                                $grps->[$grp]{conflict}{$i} = 1;
688                                                $grps->[$i]{list_conflict}{$ls}{$t}{$grp}{$list}{$type} = 1;
689                                                last
690                                            }
691                                        }
692                                    }
693                                }
694                            }
695                        }
696                    }   
697                }
698            }
699        }
700    }
701    \@metagroups
702}
703
704sub getGroupReps {
705    my ($config, $group, $discsFiles) = @_;
706    my $topdir = "$config->{topdir}/build/$config->{name}";
707    my $check_discsFiles = sub {
708        my ($cd, $rep, $listnumber, $rep_nb) = @_;
709        log_("getGroupReps check_discsfiles: disc $cd rep $rep list $listnumber\n", $config->{verbose} , $config->{LOG}, 5);
710        foreach (keys %{$discsFiles->[$cd]{$rep}{$listnumber}}) {
711            my $type = /src$/ ? 'srpm' : 'rpm';
712            my $d = $discsFiles->[$cd]{$rep}{$listnumber}{$_};
713            push @{$group->{rep}{$listnumber}[$rep_nb]{$type}{$d}}, $_;
714            push @{$group->{rep_pkg}{$type}{$d}}, $_
715        }
716    };
717    # FIXME sep_arch is not used, maybe a chech should prevent both sep_arch and non sep_arch mode.
718    # However current scheme is more robust.
719    my $check_dir = sub {
720        my ($dir, $listnumber, $rep_nb, $type, $test, $sep_arch) = @_;
721        log_("getGroupReps check_dir: dir $dir list $listnumber rep_nb $rep_nb type $type\n", $config->{verbose}, $config->{LOG},6);
722        my $add_rpm = sub {
723            my ($d, $rpm) = @_;
724            $rpm =~ /($test)\.rpm$/ or return;
725            $rpm = ~/(.*)\.rpm$/ or return;
726            push @{$group->{rep}{$listnumber}[$rep_nb]{$type}{$d}}, $1;
727            push @{$group->{rep_pkg}{$type}{$d}}, $1
728        };
729        my $RPMS;
730        if (!opendir $RPMS, $dir) { log_("WARNING getGroupReps: cannot open $dir\n", $config->{verbose}, $config->{LOG}); return }
731        foreach (readdir $RPMS) {
732            if (-d "$dir/$_") {
733                opendir my $rpm_dir, "$dir/$_";
734                foreach my $r (readdir $RPMS) {
735                    $add_rpm->("$dir/$_",$r)
736                }
737            } else {
738                $add_rpm->($dir,$_)
739            }
740        }
741        closedir $RPMS
742    };
743    my $testarch = join '|', keys %{$config->{ARCH}};
744    foreach my $listnumber (keys %{$group->{list}}) {
745        my $ok;
746        foreach (@{$group->{list}{$listnumber}{rpm}}) {
747            !$_->[3]{nodeps} and $ok = 1
748        }
749        if (!$ok) { $group->{nodeps}{$listnumber} = 1 }
750        log_("getGroupReps list $listnumber\n", $config->{verbose}, $config->{LOG},3);
751        my $rep_nb;
752        if (ref $config->{list}[$listnumber]{packages}) {
753            foreach (@{$config->{list}[$listnumber]{packages}}) {
754                log_("getGroupReps: rep num $rep_nb\n", $config->{verbose}, $config->{LOG},4);
755                foreach my $t ('rpm', 'srpm') {
756                    foreach my $d (@{$_->{$t}}) {
757                        log_("getGroupReps: $d\n", $config->{verbose}, $config->{LOG},5);
758                        $check_dir->($d, $listnumber, $rep_nb, $t, $t eq 'rpm' ? $testarch : 'src');
759                    }
760                }
761                $rep_nb++
762            }
763        }
764       
765        foreach my $d (@{$config->{list}[$listnumber]{virtual}}) {
766            my $cd = $d->{disc};
767            my $rep = $d->{repname};
768            my $path = $config->{disc}[$cd]{function}{data}{dir}{$rep}[1]{reploc};
769            my $sep_arch = $config->{disc}[$cd]{function}{data}{dir}{$rep}[1]{sep_arch};
770            my $dir = "$topdir/$cd/$path";
771            log_("getGroupReps: virtual disc $cd path $path (num $rep_nb) in $dir\n", $config->{verbose} , $config->{LOG},3);
772            if ($discsFiles->[$cd]{$rep}{$listnumber}) {
773                $check_discsFiles->($cd,$rep,$listnumber)
774            } elsif (-d $dir) {
775                $check_dir->($dir,$listnumber,$rep_nb, 'rpm',$testarch, $sep_arch);
776            } else {
777                log_("ERROR getGroupReps: could not find virtual disc $cd path $path\n", $config->{verbose} , $config->{LOG});
778                next
779            }
780            $rep_nb++
781        }
782        foreach my $cd (keys %{$config->{list}[$listnumber]{disc}}) {
783            foreach my $rep (keys %{$config->{list}[$listnumber]{disc}{$cd}}) {
784                if ($config->{list}[$listnumber]{disc}{$cd}{$rep}{done}) {
785                    $check_discsFiles->($cd, $rep, $listnumber)
786                }
787                $rep_nb++
788            }
789        }
790    }
791}
792
793# TODO at present clone only do full copy
794sub prepare_cloned_discs {
795    my ($group, $done, $config, $lists) = @_;
796    my $g;
797    foreach my $cd (keys %$lists) {
798        my $loc_conf = $config->{disc}[$cd]{function};
799        if ($loc_conf->{data}{clone}) {
800            log_("prepare_cloned_discs: disc $cd\n", $config->{verbose}, $config->{LOG},2);
801            # nothing to do, cp -r
802            #if (@{$loc_conf->{list}} == 1 && !$loc_conf->{list}[0][1]{to_del}) {
803            #
804            $loc_conf->{data}{clone}[0][1]{full_copy} = 1;
805            $group->[$g]{disc_impacted}{$cd} = 1;
806            $group->[$g]{discdeps}{$cd} = {};
807            log_("prepare_cloned_discs: setting group $g as master of disc $cd\n", $config->{verbose}, $config->{LOG}, 4);
808            $config->{disc}[$cd]{group_master} = int $g;
809            push @{$group->[$g]{master_of_disc}}, $cd;
810           
811            foreach (@{$loc_conf->{data}{clone}}) {
812                $group->[$g]{disc_prereq}{$_->[1]{disc}}++
813            }
814            $done->{$cd} = {};
815            $g++
816            #   next
817            #}
818        }
819    }
820    $g
821}
822
823sub find_cpu {
824    my $cpu;
825    open my $CPU, "/proc/cpuinfo"; 
826    while (<$CPU>) { /processor/ and $cpu++ };
827    $cpu
828}
829
830sub make_io_group {
831    my ($class, $iog, $config, $log, $lists, $discs_files, $cdsize, $repsize, $size, $graft, $sort, $inode, $done_deps, $iotask, $metagroups, $mkisos) = @_;
832    my $cds = $iog->[1];
833    my $groups = $iog->[0];
834    print $log "Group: $iog ";
835    print $log "(@$cds -- $groups)\n";
836    # FIXME ordering metagroups can lead to empty groups with the -l option
837    $groups or next;
838
839    my (@buildlist, @rpmlist, @needed);
840    my @groupok;
841
842    #print_conflict_matrix($groups);
843    for (my $i; $i < @$groups; $i++) {
844        log_("Get already built discs lists\n", $config->{verbose}, $log, 3);
845        $groups->[$i]{done} = { rep => {}, list => {} };
846        $class->{disc}->getBuiltDiscs($lists, $groups->[$i], $discs_files, $size, $cdsize);
847
848        log_("GROUP $i\n", $config->{verbose}, $log, 5);
849        getGroupReps($config, $groups->[$i], $discs_files);
850
851        log_("genDeps\n", $config->{verbose}, $log, 3);
852        if (! $done_deps->{$groups->[$i]{depsrep}} && ref $groups->[$i]{rep_pkg}{rpm}) {
853            $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 }
854        }
855        $groups->[$i]{urpm} = $done_deps->{$groups->[$i]{depsrep}};
856        log_("getSize\n", $config->{verbose}, $log, 3);
857        my $redeps = getSize($groups->[$i],$config, $config->{verbose}) or do { log_("ERROR: getSize failed\n", $config->{verbose}, $log); return 0 };
858
859        $class->{disc}->guessHdlistSize($groups->[$i], $size, $cdsize, $repsize, $lists, $discs_files);
860
861        # put in getList to handle package nodeps flag
862        #$groups->[$i]{revdeps} = $class->{list}->reverseDepslist($groups->[$i]);
863
864        ($groups->[$i]{filelist}, my $norpmsrate) = $class->{list}->getList($groups->[$i], $discs_files);
865
866        if ($groups->[$i]{rpmsratepath}) { 
867            my $struct_v = $config->{struct_version};
868            my $media_info = $config->{struct}{$struct_v}{media_info};
869            my $outputdir = "$config->{tmp}/build/$config->{name}/$groups->[$i]{installDisc}/$media_info/";
870            -d $outputdir or mkpath $outputdir;
871            my $output = "$outputdir/rpmsrate";
872            # FIXME currently the rpmsrate is updated at group creation,
873            # maybe need to be done again at disc finalizing stage only to include
874            # present packages. However it is harmfull to have packages into the rpmsrate not
875            # present on the discs.
876            log_("cleanrpmsrate $groups->[$i]{rpmsratepath} -> $output\n", $config->{verbose}, $log, 3);
877            $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);
878            $groups->[$i]{options}{rpmsrate} = $output;
879        }
880
881        log_("build_list group $i\n", $config->{verbose}, $log, 3);
882        ($rpmlist[$i], $groups->[$i]{revdeps}) = $class->{list}->build_list($groups->[$i]) or return 0;
883
884        $class->{list}->scoreList($groups->[$i]) or return 0;
885        $class->{list}->autodeps($groups->[$i], $rpmlist[$i]);
886
887        foreach my $l (keys %{$rpmlist[$i]}) { 
888            log_("make_io_group: processing rpmlist $i list $l\n", $config->{verbose}, $log, 3);
889            my (@force, @need, @superforce, @limit, @b);
890            foreach (keys %{$rpmlist[$i]{$l}}) {
891                # in case of multiple entries
892                $groups->[$i]{limit}{$_} = 0;
893                if (!$_) {
894                    log_("ERROR: empty rpmlist key ($rpmlist[$i]{$l}{$_}) KEYS " .  keys(%{$rpmlist[$i]{$l}{$_}}) . " \n", $config->{verbose}, $log);
895                    next
896                }
897                my $elt = [ $_, $rpmlist[$i]{$l}{$_}, $groups->[$i]{scorelist}{$_} ];
898                #if (!$config->{nodeps} && !$groups->[$i]{options}{nodeps} && !$groups->[$i]{nodeps}{$l} && /basesystem/) {
899                if ($rpmlist[$i]{$l}{$_}{superforce}) { 
900                    $elt->[1]{needed} = 1;
901                    $rpmlist[$i]{$l}{$_}{needed} = 1;
902                    push @superforce, $elt
903                } elsif ($rpmlist[$i]{$l}{$_}{force}) { 
904                    #$elt->[1]{needed} = 1;
905                    push @force, $elt
906                } elsif ($rpmlist[$i]{$l}{$_}{limit}) {
907                    $groups->[$i]{limit}{$_} = 1;
908                    push @limit, $elt
909                # do not includes packages with onlyifneeded flag
910                } elsif (!$rpmlist[$i]{$l}{$_}{onlyifneeded} || $rpmlist[$i]{$l}{$_}{needed}) {
911                    push @b, $elt
912                } else {
913                    log_("make_io_group: excluding $_ from rpmlist list $l group $i\n", $config->{verbose}, $log, 8);
914                    push @{$groups->[$i]{rejected}{$_}{$l}}, ["excluded", $_];
915                    $groups->[$i]{brokendeps}{$_} = 3;
916                    next
917                }
918                my $n = $rpmlist[$i]{$l}{$_}{needed};
919                push @{$needed[$i]{$l}{alap}[$n]}, $elt if $n;
920                # used to check which packages has beed rejected
921                push @{$groups->[$i]{buildlist}}, $_
922            }
923            $buildlist[$i]{$l} = [ sort { $a->[2] <=> $b->[2] } @b ];
924            unshift @{$buildlist[$i]{$l}}, sort { $a->[2] <=> $b->[2] } @limit;
925            # needed must not be put first.
926            #push @{$buildlist[$i]{$l}}, sort { $a->[2] <=> $b->[2] } @need;
927            push @{$buildlist[$i]{$l}}, sort { $a->[2] <=> $b->[2] } @force;
928            push @{$buildlist[$i]{$l}}, sort { $a->[2] <=> $b->[2] } @superforce
929        }
930    }
931
932    # FIXME it must have a cleaner manner to keep buildlist and do not have
933    # to copy it.
934    my @cb;
935    for (my $i = 0; $i < @buildlist; $i++) { 
936        foreach my $l (keys %{$buildlist[$i]}) { 
937            $cb[$i]{$l} = [];
938            foreach (@{$buildlist[$i]{$l}}) { 
939                log_("MakeWithGroups: copying buildlist group $i list $l package $_->[0] score $_->[2] options " . join(' ', %{$_->[1]}) . "\n", $config->{verbose}, $log, 4); 
940                push @{$cb[$i]{$l}}, $_
941            }
942        }
943    }
944
945    my $diff = { data => [], idx => [] };
946    my $rejected;
947    my $n=1;
948    my $shell;
949    my $shell_ok;
950    if ($config->{shell}) {
951        $shell = new Mkcd::Shell("mkcd version $config->{version}");
952        $shell_ok = $shell->prompt({ size => $size, discs_files => $discs_files, config => $config, metagroups => $metagroups });
953    } 
954    $rejected = $class->{build}->buildDiscs($groups, \@cb, \@rpmlist, \@groupok, $size, $cdsize, $lists,$cds, \@needed,$diff,$n) if @cb;
955    my $logi;
956    my ($cd, $diff) = $class->{build}->processDiff($groups,$diff, $discs_files);
957    my $ok;
958    # discs_files contains all the rpms, cd contains only the diff
959
960    if ($config->{shell}) {
961        $shell_ok = $shell->prompt({ size => $size, discs_files => $discs_files, config => $config, metagroups => $metagroups });
962    }
963    log_("make_io_group: $cd->[2]\n", $config->{verbose}, $log, 3);
964   
965    $class->{disc}->makeDiscs(1, $lists, $cds, $size, $mkisos, $discs_files, $graft, $sort, $inode, $cd) or return 0;
966    $ok = $class->{disc}->checkSize($n, $size, $cdsize, $cds, $rejected);
967    #log_("make_io_group: disc_building_tries $config->{disc_building_tries}\n",1,$log);
968    $ok = 1 if $config->{disc_building_tries} < 2;
969    while (!$ok || $shell_ok) {
970        $n++;
971        log_("make_io_group: trying to adjust disc size, try $n\n", $config->{verbose}, $log, 3);
972        $ok = 1;
973        my @cb;
974        for (my $i; $i < @buildlist; $i++) { 
975            foreach my $l (keys %{$buildlist[$i]}) { 
976                $cb[$i]{$l} = [];
977                foreach (@{$buildlist[$i]{$l}}) {
978                    push @{$cb[$i]{$l}}, $_ if $groups->[$i]{rejected}{$_->[0]}{$l}
979                }
980            }
981        }
982        if ($config->{shell}) {
983            $shell_ok = $shell->prompt({ size => $size, discs_files => $discs_files });
984        }
985        $rejected = $class->{build}->buildDiscs($groups, \@cb, \@rpmlist, \@groupok, $size, $cdsize, $lists, $cds, \@needed, $diff, $n) if @cb;
986        my ($cd, $diff) = $class->{build}->processDiff($groups, $diff, $discs_files);
987        $class->{disc}->makeDiscs($n, $lists, $cds, $size, $mkisos, $discs_files, $graft, $sort, $inode, $cd) or return 0;
988        $ok = $class->{disc}->checkSize($n, $size, $cdsize, $cds, $rejected);
989        !$ok and log_("ERROR: one or more disc are too big or too small, trying to correct\n", $config->{verbose}, $log, 2);
990        if ($n >= $config->{disc_building_tries}) { 
991            log_("ERROR: could not manage to build discs of correct size, exiting\n", $config->{verbose}, $log); 
992            last 
993        }
994    }
995    # finally really build the ISOs
996    if ($config->{nofork}) { 
997        $class->{disc}->makeDiscs(-1, $lists, $cds, $size, $mkisos, $discs_files, $graft, $sort, $inode, $cd);
998    } else {
999        # FIXME This algo is not correct, it happens that some IO tasks are still parallelized
1000        my $pid = fork;
1001        $pid and log_("make_io_group: fork to PID $pid to build ISO files\n", $config->{verbose}, $log, 1); 
1002        if (!$pid) {
1003            while (@$iotask) {
1004                my $p = pop @$iotask;
1005                log_("make_io_group: waiting for IOtask PID $p to finish\n", $config->{verbose}, $log, 2); 
1006                waitpid $p, 0
1007            }
1008            $class->{disc}->makeDiscs(-1, $lists, $cds, $size, $mkisos, $discs_files, $graft, $sort, $inode, $cd);
1009            print STDERR "Finished\n";
1010            exit
1011        } else {
1012            push @$iotask, $pid
1013        }
1014    }
1015    log_("make_io_group: finalizing disc files\n", $config->{verbose}, $log, 2); 
1016    for (my $i; $i < @$groups; $i++) {
1017        foreach my $list (keys %{$groups->[$i]{list}}) {
1018            foreach my $type (keys %{$groups->[$i]{list}{$list}}) {
1019                foreach (@{$groups->[$i]{list}{$list}{$type}}) {
1020                    $config->{list}[$list]{disc}{$_->[0]}{$_->[1]}{done} = 1
1021                }
1022            }
1023        }       
1024    }
1025}
1026
1027sub makeWithGroups {
1028    my ($class, $lists, $acds) = @_;
1029    my $config = $class->{config};
1030    my $log = $config->{LOG};
1031    my $metagroups = orderGroups($config, getGroups($config, $lists), $lists, $acds);
1032
1033    my @discsFiles;
1034    my (@cdsize, %repsize, %size, %graft, %sort, %done_deps, %inode, @iotask, @mkisos);
1035    for (my $i; $i < @{$config->{disc}}; $i++) { 
1036        $cdsize[$i] = $config->{disc}[$i]{size}; 
1037        $size{optimize_space}{disc}{$i} = $cdsize[$i];
1038        my %rep;
1039        my $nb_rep;
1040        my $nb_free_rep;
1041        my $normalize;
1042        foreach my $rep (keys %{$config->{disc}[$i]{rep}}) {
1043            $rep{$rep} = $config->{disc}[$i]{rep}{$rep};
1044            $nb_rep++;
1045            $normalize += $rep{$rep};
1046            $nb_free_rep++ if !$config->{disc}[$i]{rep}{$rep}
1047        }
1048        my $leftsize = $cdsize[$i] * (1 - $normalize);
1049        $leftsize = 0 if $leftsize < 0;
1050        log_("makeWithGroups: cdsize $cdsize[$i] normalize $normalize leftsize $leftsize\n", $config->{verbose}, $config->{LOG}, 3);
1051        foreach my $rep (keys %{$config->{disc}[$i]{rep}}) {
1052            $repsize{"$i/$rep"} = $rep{$rep} ? (($cdsize[$i] * $rep{$rep}) / $normalize) : ($leftsize / $nb_free_rep);
1053            log_("makeWithGroups: repsize $i/$rep " . $repsize{"$i/$rep"} . " (rep $rep{$rep})\n", $config->{verbose}, $config->{LOG}, 3)
1054        }
1055    }
1056    foreach my $iog (@$metagroups) {
1057        foreach (@$iog) {
1058            ref $_->[1] or next;
1059            log_("makeWithGroups: Group listing $_ (@{$_->[1]} -- $_->[0])\n", $config->{verbose}, $config->{LOG}, 3);
1060            my $cds = $_->[1];
1061            # Do not make first CDs in io groups to keep inter io groups alone directories safe.
1062            $class->{disc}->makeDiscs(0, $lists, $cds, \%size, \@mkisos, \@discsFiles, \%graft, \%sort, \%inode);
1063        }
1064    }
1065    $config->{cpu} = find_cpu() if !$config->{cpu};
1066    log_("makeWithGroups: will try to use $config->{cpu} CPUs\n", $config->{verbose}, $config->{LOG}, 3);
1067   
1068    foreach my $g (@$metagroups) {
1069        foreach my $iog (@$g) {
1070            ref $iog->[1] or next;
1071            make_io_group($class, $iog, $config, $log, $lists, \@discsFiles, \@cdsize, \%repsize, \%size, \%graft, \%sort, \%inode, \%done_deps, \@iotask, $metagroups, \@mkisos);
1072        }
1073    }
1074    check_wasted_space($config, \@discsFiles, $metagroups);
1075    printDiscsFile($config, \@discsFiles, $config->{print}, $metagroups);
1076    $config->{printscript} and printBatchFile($config, \@discsFiles, $config->{printscript});
1077    foreach my $pid (@iotask) {
1078        if ($pid && getpgrp $pid != -1) {
1079            print STDERR "Waiting for pid $_\n";
1080            waitpid($pid, 0);
1081        }
1082    }
1083    print STDERR "Finished\n";
1084    1
1085}
1086
1087sub check_wasted_space {
1088    my ($config, $discsFiles, $metagroups) = @_;
1089    my %wasted;
1090    my %size;
1091    # this is not really correct as multiple list may have packages with the same name but different size
1092    if ($metagroups) {
1093        foreach my $iogroups (@$metagroups) {
1094            foreach (@$iogroups) {
1095                my $groups = $_->[0];
1096                for (my $i; $i < @$groups; $i++) {
1097                    foreach my $rpm (keys %{$groups->[$i]{size}}) {
1098                        foreach my $list (keys %{$groups->[$i]{size}{$rpm}}) { 
1099                            $size{$rpm} = $groups->[$i]{size}{$rpm}{$list}[0] if $size{$rpm} < $groups->[$i]{size}{$rpm}{$list}[0] 
1100                        }
1101                    }
1102                }
1103            }
1104        }
1105    }
1106    for (my $cd; $cd < @$discsFiles; $cd++) {
1107        $discsFiles->[$cd] or next;
1108        log_("check_wasted_space: check wasted space on disk $cd\n", $config->{verbose}, $config->{LOG}, 3);
1109        foreach my $rep (keys %{$discsFiles->[$cd]}) {
1110            foreach my $list (keys %{$discsFiles->[$cd]{$rep}}) {
1111                foreach my $rpm (sort keys %{$discsFiles->[$cd]{$rep}{$list}}) {
1112                    if (!$wasted{rpm}{$rpm}) {
1113                        $wasted{rpm}{$rpm} = $cd
1114                    } elsif ($wasted{rpm}{$rpm} != $cd) {
1115                        log_("check_wasted_space: wasted space for $rpm\n", $config->{verbose}, $config->{LOG}, 3);
1116                        $wasted{wasted}{$cd} += $size{$rpm};
1117                        $wasted{total} += $size{$rpm}
1118                    } else {
1119                        $wasted{saved}{$cd} += $size{$rpm};
1120                        $wasted{total_saved} += $size{$rpm}
1121                    }
1122                }
1123            }
1124        }
1125    }
1126    log_("check_wasted_space: total wasted space $wasted{total}\n", $config->{verbose}, $config->{LOG}, 1);
1127    log_("check_wasted_space: total saved space $wasted{total_saved}\n", $config->{verbose}, $config->{LOG}, 1);
1128    for (my $cd; $cd < @$discsFiles; $cd++) {
1129        $discsFiles->[$cd] or next;
1130        log_("check_wasted_space: total wasted space on CD $cd $wasted{wasted}{$cd}\n", $config->{verbose}, $config->{LOG}, 1);
1131        log_("check_wasted_space: total saved space on CD $cd $wasted{saved}{$cd}\n", $config->{verbose}, $config->{LOG}, 1);
1132    }
1133}
1134
11351
1136
1137# 20060705
1138# Multiarch CDs
1139# - two differents installation procedure (mkcd detect it and try to optimize the disc in background)
1140#   - have to share CDs (need to rework the master/group_master/orderdisc)
1141#   - have to optimize common packages location
1142#   - two creation mode
1143#      - use fixed and create first i586 then x86_64 CDs (drawback: extra packages in x86_64 hdlist which will makes the installation of RPMs post install more complex)
1144#      - build the CDs in parallell, try to share common packages with CD affinity (use the in_rep function)
1145# - one global multiarch installation procedure (we have to force mkcd to optimize the discs)
1146#   - handle both i586 and x86_64 packages
1147#   - need to be careful about dependencies mixing
1148#   - build architectures simultaneously
1149#
1150# Try to make mkcd see a dual arch procedure installation and to optimize the CD creation to share space on CDs. Do not try to share directory, better create specific directories on CDs with shared packages with hardlinks (need to be very careful because noarch packages may not be the same between the directories, so mkcd need to relink the packages)
1151#
1152# - Create one installation with only one list and select automatically 32/64bit ?
1153#   - how to select special installation path ?
1154#   - create a default new post 2007 structure and use arch subdir as default
1155#   - auto detect multiple installation
1156#   - how to handle configuration filter files for rpm lists ?
1157#   - try to increase default rule so that mkcd can try to optimize package location.
1158#
1159# - Create a new structure for installation which automatically add subdir, warn user that multiple installation is only supported with 2007, or if there is a prefix ?
1160#
1161# - How to share packages between installation, how to override default ? How to detect that packages should be linked or not. If we have a full i586 install and a basesystem x86_64 install, how to share packages ? Start with the group with the most important constraints ? Do it in parallel ? Precheck the list to increase the affinity of common packages on common CDs ? Do it before the cd creation of dynamically ? Create one CD and then try to create a new one with packages from the previous one ? Try to tweak the configuration as the CD is being built ?
1162#
1163# Try to guess the needed space and schedule them in various directories ?
1164# Rewrite the main construction algorithm ?
1165# Alter the current building algorythm ?
1166#
1167# - Pre-alter the packages list filter. Hard because the dependencies are not really known.
1168# - dynamic altering of package location. Need to add hook in the parallel CD building.
1169# - post altering of packages location. Hard because packages need to be moved between CDs.
1170#
1171# - when a package is added in one CD, check if the packages is also present in the other rpmlist, and push it on the top if this is the case.
1172# - Maybe better to build one architecture after the other and only check for done noarch or i586 packages ? Then I need to add code to select which fixed packages should be added to the list. Add a --selective option to the fixed one ? This will be more complex for the user because new hdlist for x86_64 will refer to a directory which is not the same as its content.
1173#
1174# - Could add a generic multigroup optimization mechanism, this has not to be limited to one specific case. (Then add a generic multigroup package sharing program)
1175# - For dual installation CDs, try to share them between group, and mark them as multiowned. Remove the fixed need for x86_64 version
1176#
1177# 20060710
1178# Multiarch CDs
1179# Create a new optimization algorithm which monitor multi CD creation.
1180#   - a function check after each packages is included, how to put it also for other group
1181#   - CDs with several installation procedures are linked a common group and CD should not be done before all the groups are finished.
1182#
1183# How to really optimize package location, this should be done after, during and after, create a post-optimization packages location ?
1184# Create at least a check function to see if space was wasted.
1185#
1186# To create CDs with several groups, either create special group, or make multi owning general ? Keep a master and slaves ? Order the group so that the master must wait for all other groups to build them ?
Note: See TracBrowser for help on using the repository browser.