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