source: soft/build_system/build_system/mkcd/tags/v2-9-3/pm/Mkcd/List.pm @ 1

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

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

File size: 51.3 KB
Line 
1package Mkcd::List;
2
3my $VERSION = '0.5.0';
4
5use strict;
6use File::NCopy qw(copy);       
7use File::Path;
8use Mkcd::Package qw(rpmVersionCompare);
9
10=head1 NAME
11
12List - mkcd module
13
14=head1 SYNOPSYS
15
16    require Mkcd::List;
17
18=head1 DESCRIPTION
19
20C<mkcd::List> include the mkcd packages list functions.
21
22=head1 SEE ALSO
23
24mkcd
25
26=head1 COPYRIGHT
27
28Copyright (C) 2000 MandrakeSoft <warly@mandrakesoft.com>
29
30This program is free software; you can redistribute it and/or modify
31it under the terms of the GNU General Public License as published by
32the Free Software Foundation; either version 2, or (at your option)
33any later version.
34
35This program is distributed in the hope that it will be useful,
36but WITHOUT ANY WARRANTY; without even the implied warranty of
37MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
38GNU General Public License for more details.
39
40You should have received a copy of the GNU General Public License
41along with this program; if not, write to the Free Software
42Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
43
44=cut
45
46my $config;
47
48sub new {
49    my ($class, $conf) = @_;
50    $config = $conf;
51    bless {
52           config       => $config,
53          }, $class;
54}
55
56sub processDiff {
57    my ($class,$groups, $diff, $log, $discsFiles) = @_;
58    my @cd;
59    for(my $cd; $cd < @$diff; $cd++){
60        my $dc = $diff->[$cd];
61        $dc or next;
62        for(my $grp; $grp < @$dc; $grp++){
63            my $dcg = $dc->[$grp];
64            $dcg or next;
65            for (my $list; $list < @{$dcg}; $list++){
66                my $dcgl = $dcg->[$list];
67                $dcgl or next;
68                for (my $rep ; $rep < @{$dcgl}; $rep++){
69                    my $dcglr = $dcgl->[$rep];
70                    $dcglr or next;
71                    for (my $type ; $type < @{$dcglr}; $type++){
72                        my $dcglrt = $dcglr->[$type];
73                        $dcglrt or next;
74                        for (my $i; $i < @{$dcglrt}; $i++){
75                            my $ent = $dcglrt->[$i];
76                            $log and push @{$log->[$cd][$grp][$list][$rep][$type]}, $ent;
77                            my $rpm = $ent->[0];
78                            my $curdir = $ent->[3];
79                            $config->{verbose} and print {$config->{LOG}} "LOG disc $cd group $grp: $rpm ($groups->[$grp]{size}{$rpm}{$list}[1])\n";
80                            if (!$rpm) {
81                                foreach (@$ent){
82                                    if (ref) { print {$config->{LOG}} "ERROR processDiff: @$_\n" }
83                                    else { print {$config->{LOG}} "ERROR processDiff: $_\n" }
84                                }
85                            }
86                            $rpm or next;
87                            my $source = $groups->[$grp]{size}{$rpm}{$list}[1];
88                            push @{$cd[$cd]{$curdir->[1]}{$list}{$source}}, [$ent->[1],"$groups->[$grp]{rpmkey}{rpm}{$rpm}.rpm"];
89                            if ($ent->[1] == 1) { $discsFiles->[$cd]{$curdir->[1]}{$list}{$groups->[$grp]{rpmkey}{rpm}{$rpm}} = $source }
90                            # FIXME may need to delete upper hash if empty
91                            elsif ($ent->[1] == 2) { delete $discsFiles->[$cd]{$curdir->[1]}{$list}{$groups->[$grp]{rpmkey}{rpm}{$rpm}} }
92                        }
93                    }
94                }
95            }
96        }
97    }
98    return \@cd
99}
100
101sub getDoneList{
102    my ($config,$group, $listnumber, $discsFiles) = @_;
103    if (@{$group->{list}{$listnumber}{rpm}} > 1) { print "WARNING getDoneList: $listnumber appears in several directories, getting only the first one\n"}
104    if (@{$group->{list}{$listnumber}{srpm}} > 1) { print "WARNING getDoneList: $listnumber appears in several sources directories, getting only the first one\n"}
105    my $r = $group->{list}{$listnumber}{rpm}[0];
106    my $rs = $group->{list}{$listnumber}{srpm}[0];
107    my ($cd,$rep) = ($r->[0],$r->[1]);
108    my ($scd,$srep) = ($rs->[0],$rs->[1]);
109    foreach my $r (@{$config->{list}[$listnumber]{packages}}){
110        $config->{verbose} and print {$config->{LOG}} "getDoneList: $listnumber (@$r)\n";
111        local *A; opendir A, $r->[0];
112        foreach (readdir A){
113            /src.rpm$/ and next;
114            /(.*)\.rpm/ or next; 
115            my $rpm = $group->{rpmkey}{key}{$1};
116            $group->{done}{$rpm} = $group->{orderedrep}{rpm}{"$cd/$rep"};
117            $discsFiles->[$cd]{$rep}{$listnumber}{$1} = $r->[0]
118        }
119        local *A; opendir A, $r->[1];
120        foreach (readdir A){
121            /(.*src)\.rpm/ or next; 
122            my $srpm = $group->{rpmkey}{key}{$1};
123            $group->{done}{$srpm} = 1;
124            $discsFiles->[$scd]{$srep}{$listnumber}{$1} = $r->[1]
125        }
126    }
127    #
128    # FIXME this may be better placed in the function setting the list as done, that is to say
129    # for example in cdcom or like.
130    #
131    $config->{list}[$listnumber]{disc}{$cd}{$rep}{done} = 1;
132    $config->{list}[$listnumber]{disc}{$scd}{$srep}{done} = 1;
133}
134
135sub getList{
136    my ($class, $group,$discsFiles) = @_;
137    my $config = $class->{config};
138    my %filelist;
139    my @norpmsrate;
140    foreach my $listnumber (keys %{$group->{list}}){
141        my $done = $config->{list}[$listnumber]{done};
142        $done and getDoneList($config,$group, $listnumber,$discsFiles);
143        if ($config->{list}[$listnumber]{filelist} || $config->{list}[$listnumber]{prelist}){
144            foreach (@{$config->{list}[$listnumber]{filelist}}){
145                $config->{verbose} and print {$config->{LOG}} "getList: FILE LIST listnumber $listnumber ($_)\n";
146                local *A; open A, $_ or print {$config->{LOG}} "ERROR: cannot open $_, ignoring\n" and next;
147                local $_;
148                while (<A>){
149                    s/#.*//;
150                    $_ or next;
151                    my ($name, $options) = /(\S*)\s*(.*)/;
152                    my @options = split ',',$options;
153                    $config->{verbose} and print {$config->{LOG}} "FILESLIST: $_ -> $name options @options\n";
154                    my %opt;
155                    foreach (@options){
156                        s/^\s*//;
157                        /norpmsrate/ and push @norpmsrate, $name and next;
158                        /^(?:(?:nosrc|noalternatives|regexp|ignore|nodeps|force|limit|exclude)|(rate|notondisc|rpmsrate|section) (\d+))$/ or print {$config->{LOG}} "WARNING: getList: $_: unknown option\n" and next;
159                        $_ = $1 || $_; 
160                        $opt{$_} = $2 || 1;
161                    }
162                    $config->{verbose} and print {$config->{LOG}} "Adding $name -- ", join ' ', keys %opt, "\n";
163                    push @{$filelist{$listnumber}}, [ $name, \%opt ];   
164                }
165            }
166            foreach my $p (@{$config->{list}[$listnumber]{prelist}}){
167                $config->{verbose} and print {$config->{LOG}} "Prelist Adding $p->[0] -- ", join ' ', keys %{$p->[1]}, "\n";
168                $p->[1]{norpmsrate} and push @norpmsrate, $_->[0] and next;
169                push @{$filelist{$listnumber}}, $p
170            }
171        }else{
172            if (!$done && $config->{list}[$listnumber]{auto}){
173                push @{$filelist{$listnumber}}, ["INSTALL",{ section=>1, force => 1 }];
174                push @{$filelist{$listnumber}}, ["SYSTEM",{ section=>1, force => 1 }];
175                push @{$filelist{$listnumber}}, [".*",{ regexp => 1 }]
176            }
177            #   else{
178            #           push @{$filelist{$listnumber}}, [".*",{ done => $done, regexp => 1, force => $done }]
179            #   }
180        }
181        my $listdone = 1;
182        foreach my $r (@{$group->{list}{$listnumber}{rpm}}){
183            my ($cd,$rep,$repopt,$opt) = @$r;
184            if ($config->{list}[$listnumber]{disc}{$cd}{$rep}{done}){
185                if (!$opt->{dup}){
186                    foreach my $rpmkey (keys %{$discsFiles->[$cd]{$rep}{$listnumber}}){
187                        my $rpm = $group->{rpmkey}{key}{$rpmkey};
188                        $group->{done}{$rpm} = $group->{orderedrep}{rpm}{"$cd/$rep"};
189                        $config->{verbose} and print {$config->{LOG}} "getList: $rpm in $cd/$rep -> $group->{done}{$rpm}\n";
190                        push @{$filelist{$listnumber}}, [$rpm,{ done => 1, regexp => 1, udpate => $r->[2]{update}}];
191                    }
192                }
193            }else { $listdone = 0 }
194        }
195        $listdone and print {$config->{LOG}} "getList: setting list $listnumber as done\n" and $config->{list}[$listnumber]{done} = 1;
196    }
197    (\%filelist,\@norpmsrate)
198}
199
200#
201# compute individual scoring (max_size*(rpmsrate+1)*rpmsrate_factor/(size*size_factor))
202# then add dependencies sons score ( score + deps_factor*(sons_score)
203#
204# special rpmsrate groups score could be added in the rpmsrate value
205#
206# FIXME current scoring rules make size only significant for equaly dependent packages,
207# dependencies get far more importance for packages a lot of packages depend on.
208#
209# Size scoring could be added afterwards, but this will break the autodeps created with
210# this scheme.
211#
212# TODO
213# add scoring rules to include srpm size in score.
214#
215#
216sub scoreList{
217    my ($class,$group) = @_;
218    my $scoreweight = $group->{score};
219    my $params = $group->{params};
220    my $rpmsrate = $group->{rpmsrate};
221    my $maxsize = $group->{maxsize} || 1;
222    $config->{verbose} and print {$config->{LOG}} "SCORE for group: @$scoreweight\n";
223    $config->{verbose} and print {$config->{LOG}} "Individual scoring\n";
224    my $sf;
225    my $i;
226    my $total;
227    my (@min,@max);
228    if ($scoreweight->[1]){
229        (@min,@max) = (($maxsize*$scoreweight->[0]*6/($scoreweight->[1]*1),0),(0,0))
230    }else{
231        (@min,@max) = (($maxsize*$scoreweight->[0]*6,0),(0,0))
232    }
233    my @specialdeps;
234    foreach (keys %{$params->{info}}){
235        #print "INFO KEYS $_\n";
236        my ($ratekey) = /(.*)-[^-]+-[^-]+\.[^.]+$/;
237        # FIXME take the bigger size when package appears in multiple lists
238        my $size;
239        foreach my $list (keys %{$group->{size}{$_}}){ $size < $group->{size}{$_}{$list}[0] and $size = $group->{size}{$_}{$list}[0] }
240        $size or print {$config->{LOG}} "WARNING: $_ has zero size\n";
241        my $s;
242        my $rate = $group->{brokendeps}{$_} ? 0 : (defined $group->{pkgrate}{$_} ? $group->{pkgrate}{$_}: $rpmsrate->[0]{$ratekey});
243        if ($scoreweight->[1]) {
244            $sf = ($size*9)/$maxsize + 1; # from 1 to 10
245            $s = $scoreweight->[0]*($rate + 1)/($scoreweight->[1]*$sf);
246        } else {
247            $s = $scoreweight->[0]*($rate + 1);
248        }
249        $group->{scorelist}{$_} = $s;
250        ($s < $min[0]) and @min = ($s,$_);
251        ($s > $max[0]) and @max = ($s,$_);
252
253        $config->{verbose} and print {$config->{LOG}} "SCORE package $_: $s (rpmsrate ($ratekey): $rate, sf: $sf)\n";
254        $total+=$s;
255        $i++
256    }
257    $i and print {$config->{LOG}} "minimal $min[0] ($min[1]), maximal $max[0] ($max[1]), average ",$total/$i,"\n";
258    1
259}
260
261sub autodeps{
262    my ($class,$group, $rpmlist) = @_;
263    my $scoredeps = $group->{score}[2];
264    $scoredeps or print {$config->{LOG}} "autodeps: deps score is null, bypassing autodeps\n" and return 1;
265    $config->{verbose} and print {$config->{LOG}} "autodeps: compute reversed depslist.ordered ($scoredeps)\n";
266    my $revDeps = $group->{revdeps};
267    my %rpm;
268    foreach my $k (keys %{$rpmlist}){ foreach (keys %{$rpmlist->{$k}}) { $rpm{$_} = $rpmlist->{$k}{$_} }}
269    # FIXME this algo is not correct
270    for (my $i = @{$group->{params}{depslist}} - 1 ; $i >= 0; $i--){
271        my $rpm = $group->{depslistid}[$i];
272        $rpm{$rpm} or print {$config->{LOG}} "autodeps: ignoring $rpm\n" and next;
273        if ($rpm{$rpm}{ignore}) { print {$config->{LOG}} "autodeps: $rpm has ignore flag, do not add deps score\n"; next }
274        foreach (@{$revDeps->[$i]}){
275            $group->{scorelist}{$rpm} += $scoredeps*$group->{scorelist}{$group->{depslistid}[$_]};
276        }
277    }
278    1
279}
280
281sub reverseDepslist{
282    my ($class,$group) = @_;
283    my $depslist = $group->{params}{depslist};
284    my $locales = $group->{lang};
285    my @revdeps;
286    my %skip;
287    $config->{verbose} and print {$config->{LOG}} "reverseDepslist\n";
288    for (my $i; $i < @$depslist; $i++){
289        my $d = $depslist->[$i];
290        my $rpm = "$d->{name}-$d->{version}-$d->{release}.$d->{arch}";
291        $group->{depslistid}[$i] = $rpm;
292        my %rev;
293        foreach ( split (' ', $d->{deps})){
294            if (!$group->{options}{nodeps} && !$class->{config}->{nodeps} && /NOTFOUND_(\S*)/) {
295                $skip{$i} = 1;
296                $group->{brokendeps}{$rpm} = 2;
297                push @{$group->{missingdeps}{$rpm}}, $1;
298                print {$config->{LOG}} "WARNING: $rpm has unresolved dependencies ($1), ignored\n";
299                next
300            }
301            if (/\|/) { 
302                my $s = [split '\|', $_];
303                push @{$group->{pkgdeps}{$rpm}}, $s; 
304                foreach (@$s) { $skip{$_} or push @{$revdeps[$_]}, $i }
305            } else { 
306                if ($locales && $group->{depslistid}[$_] =~ /locales-([^-]+)-[^-]+-[^-]+\.[^.]+/){
307                    if (!$locales->{$1}){
308                        $config->{verbose} and print {$config->{LOG}} "reverseDepslist: locale $1 ($group->{depslistid}[$_]) skipped for $rpm\n" and $skip{$i} = 1;
309                        !$group->{brokendeps}{$rpm} and $group->{brokendeps}{$rpm} = 1 
310                    }
311                }
312                push @{$group->{pkgdeps}{$rpm}}, $_;
313                $skip{$_} or push @{$revdeps[$_]}, $i;
314            }
315        }
316    }
317    return \@revdeps
318}
319
320sub closeRpmsList{
321    my ($group,$rpmfile) = @_;
322    my $n=1;
323    my %done;
324    my %doneName;
325    my %alternatives;
326    while ($n){
327        $n = 0;
328        foreach my $listnumber (@{$group->{orderedlist}{rpm}}){
329            foreach my $rpm (keys %{$rpmfile->{$listnumber}}){
330                if (!$group->{options}{dup}){
331                    my ($name,$version,$release,$arch) = $rpm =~ /^(.*)-([^-]+)-([^-]+)\.([^.]+)$/;
332                    if ($doneName{$name}){
333                        if (!($doneName{$name}[0] eq "$version-$release.$arch")){
334                            print {$config->{LOG}} "WARNING closeRpmsList: $name-$version-$release.$arch duplicated with $doneName{$name}[0]\n";
335                            my ($v,$r,$a) = @{$doneName{$name}[1]};     
336                            my $todel;
337                            my $vers;
338                            my $ret = rpmVersionCompare($rpm,"$name-$v-$r.$a");
339                            if ($ret < 0){
340                                $todel = $rpm;
341                                $vers = [$v,$r,$a]
342                            }elsif ($ret > 0){
343                                $todel = "$name-$v-$r.$a";
344                                $vers = [$version,$release,$arch]
345                            }else{
346                                print {$config->{LOG}} "ERROR closeRpmsList: oops, something not possible happened in duplicate version comparaison ($rpm and $name-$v-$r.$a)\n";
347                            }
348                            if ($todel){
349                                $config->{verbose} and print {$config->{LOG}} "closeRpmsList: deleting $todel\n";
350                                $doneName{$name} = [ "$vers->[0]-$vers->[1].$vers->[2]", $vers];
351                                $group->{brokendeps}{$todel} = 3;
352                                delete $rpmfile->{$listnumber}{$todel};
353                                $todel eq $rpm and next 
354                            }
355                            $n = 1
356                        }
357                    }else{
358                        $doneName{$name} = [ "$version-$release.$arch",[$version,$release,$arch]]
359                    }
360                }
361                if ($group->{brokendeps}{$rpm} == 2 || $group->{brokendeps}{$rpm} == 3){
362                    $config->{verbose} and print {$config->{LOG}} "closeRpmsList: deleting $rpm (list $listnumber)\n";
363                    delete $rpmfile->{$listnumber}{$rpm};
364                    $n = 1;
365                    next
366                }
367                $done{$rpm} and next;
368                $rpmfile->{$listnumber}{$rpm}{nodeps} and next;
369                my $needed;
370                # FIXME the right thing to do would be to put the require in the rep just before the one of the $rpm, and not to force it.
371                $needed = 1 if ($rpmfile->{$listnumber}{$rpm}{done} || $rpmfile->{$listnumber}{$rpm}{force});
372                # print {$config->{LOG}} "closeRpmsList: setting $rpm as needed because of (force $rpmfile->{$listnumber}{$rpm}{force} done $rpmfile->{$listnumber}{$rpm}{done})\n" if ($rpmfile->{$listnumber}{$rpm}{done} || $rpmfile->{$listnumber}{$rpm}{force});
373                foreach (@{$group->{pkgdeps}{$rpm}}){
374                    /NOTFOUND_(.*)/ and print {$config->{LOG}} "ERROR closeRpmsList: $1 not provided\n" and next;
375                    my $rpmdep;
376                    my $rpmdeplist;
377                    my $specialrpmdep;
378                    if (ref){
379                        if ($alternatives{"@$_"}) {
380                            ($rpmdep, $rpmdeplist) = @{$alternatives{"@$_"}};
381                        }
382                        if (! ref $rpmfile->{$rpmdeplist}{$rpmdep}){
383                            foreach my $testalt (1,0){
384                                ($rpmdep, $rpmdeplist) = (undef,undef);
385                                # FIXME this is wrong, package can come from any list
386                                my @score = ($group->{maxlist}{rpm},int @{$group->{list}{$listnumber}{rpm}},$group->{maxsize});
387                                my @specialscore = (int @{$group->{list}{$listnumber}{rpm}},$group->{maxsize});
388                                $config->{verbose} and print {$config->{LOG}} "closeRpmsList: $rpm @$_ (maxscore @score) alternative\n";
389                                foreach (@$_) {
390                                    my $pkg = $group->{depslistid}[$_];
391                                    print {$config->{LOG}} "closeRpmsList: trying $pkg (brokendeps $group->{brokendeps}{$pkg})\n";
392                                    $group->{brokendeps}{$pkg} == 2 and next;
393                                    $group->{brokendeps}{$pkg} == 3 and next;
394                                    my $pkglist = find_list($group,$pkg,$listnumber);
395                                    $pkglist or print "closeRpmsList: $pkg list could not be used for $rpm dependencies\n" and next;
396                                    $config->{verbose} and print {$config->{LOG}} "closeRpmsList: list $pkglist rpmfile $rpmfile->{$pkglist}{$pkg}\n";
397
398                                    if ($rpmfile->{$pkglist}{$pkg}){
399                                        $rpmfile->{$pkglist}{$pkg}{limit} and next;
400                                        $testalt and $rpmfile->{$pkglist}{$pkg}{noalternatives} and next;
401                                    }
402                                    my $rep = $group->{size}{$pkg}{$pkglist}[2];
403                                    my $s = $group->{size}{$pkg}{$pkglist}[0];
404                                    my $l = $group->{listsort}{rpm}{$pkglist};
405                                    $config->{verbose} and print {$config->{LOG}} "\t$pkg ($l,$rep,$s) (@score)\n";
406                                    # also put an alternative from this list
407                                    if ($pkglist == $listnumber){
408                                        if ($rep < $specialscore[1]){
409                                            @specialscore = ($rep,$s);
410                                            $specialrpmdep = $pkg;
411                                        }elsif ($rep == $specialscore[1] && $s < $specialscore[2]){
412                                            @specialscore = ($rep,$s);
413                                            $specialrpmdep = $pkg;
414                                        }               
415                                    }
416                                    if ($l < $score[0]){
417                                        @score = ($l,$rep,$s);
418                                        $rpmdep = $pkg;
419                                        $rpmdeplist = $pkglist;
420                                        $config->{verbose} and print {$config->{LOG}} "1 $rpmdep -- $rpmdeplist -- $l,$rep,$s\n";
421                                    }elsif ($l == $score[0]){
422                                        if ($pkglist == $listnumber){
423                                            if ($rep < $score[1]){
424                                                @score = ($l,$rep,$s);
425                                                $rpmdep = $pkg;
426                                                $rpmdeplist = $pkglist;
427                                                $config->{verbose} and print {$config->{LOG}} "2 $rpmdep -- $rpmdeplist -- $l,$rep,$s\n";
428                                            }elsif ($rep == $score[1] && $s < $score[2]){
429                                                @score = ($l,$rep,$s);
430                                                $rpmdep = $pkg;
431                                                $rpmdeplist = $pkglist;
432                                                $config->{verbose} and print {$config->{LOG}} "3 $rpmdep -- $rpmdeplist -- $l,$rep,$s\n";
433                                            }
434                                        }elsif ($s < $score[2]){
435                                            @score = ($l,$rep,$s);
436                                            $rpmdep = $pkg;
437                                            $rpmdeplist = $pkglist;
438                                            $config->{verbose} and print {$config->{LOG}} "4 $rpmdep -- $rpmdeplist -- $l,$rep,$s\n";
439                                        }
440
441                                    }
442                                }
443                            }
444                            if ($rpmdep && $rpmdeplist){
445                                $config->{verbose} and print {$config->{LOG}} "\tResult:\t$rpmdep\n";
446                                $alternatives{"@$_"} = [ $rpmdep, $rpmdeplist ]
447                            }else{
448                                print {$config->{LOG}} "WARNING: $rpm has unresolved or excluded dependencies, removed\n";
449                                print {$config->{LOG}} "closeRpmsList: deleting $rpm (list $listnumber)\n";
450                                delete $rpmfile->{$listnumber}{$rpm};
451                                $n = 1;
452                                $group->{brokendeps}{$rpm} = 2
453                            }
454                        }
455                    } else {   
456                        # TODO verify that there is no need to do $rpmfile->{$pkglist}{$rpmdep} or brokendeps;
457                        $rpmdep = $group->{depslistid}[$_];
458                        $rpmdeplist = find_list($group,$rpmdep,$listnumber);
459                    }
460                    # print {$config->{LOG}} "rpmdep $rpmdep rpmdeplist $rpmdeplist rpm $rpm\n";
461                    if ($rpmdep){
462                        if (!$rpmdeplist || $group->{brokendeps}{$rpmdep} == 2 || $group->{brokendeps}{$rpmdep} == 3){
463                            $group->{brokendeps}{$rpm} = $group->{brokendeps}{$rpmdep};
464                            $n = 1;
465                            print {$config->{LOG}} "WARNING closeRpmsList: $rpm has unresolved or excluded dependencies ($rpmdep), removed\n";
466                            print {$config->{LOG}} "closeRpmsList: deleting $rpm (list $listnumber)\n";
467                            delete $rpmfile->{$listnumber}{$rpm};
468                            next
469                        }
470                        if (! ref $rpmfile->{$rpmdeplist}{$rpmdep}){
471                            $n = 1;
472                            $config->{verbose} and print {$config->{LOG}} "closeRpmsList: ADDED $rpmdep (list $rpmdeplist) needed $needed\n";
473                            $rpmfile->{$rpmdeplist}{$rpmdep} = { needed => $needed }
474                        }elsif($needed) {
475                            $config->{verbose} and print {$config->{LOG}} "closeRpmsList: setting $rpmdep needed option\n";
476                            $rpmfile->{$rpmdeplist}{$rpmdep}{needed} = $needed;
477                        }
478                    }
479                    if ($specialrpmdep){
480                        if (! ref $rpmfile->{$listnumber}{$specialrpmdep}){
481                            $n = 1;
482                            $config->{verbose} and print {$config->{LOG}} "closeRpmsList: ADDED $specialrpmdep (list $listnumber)d\n";
483                            $rpmfile->{$listnumber}{$specialrpmdep} = { }
484                        }
485                    }
486                }
487                $done{$rpm} = 1;
488            }
489            $config->{verbose} and print {$config->{LOG}} "closeRpmsList: $listnumber {$n}\n";
490        }
491    }
492}
493
494sub addRPMToList{
495    my ($group,$listnumber,$rpmfile,$done,$rpms,$fentry,$name) = @_;
496    $name =~ s/\+/\\+/g;
497    my @toadd;
498    if ($fentry->{regexp}) { @toadd = grep { /$name/ } @$rpms } 
499    else { @toadd = grep { /^$name-[^-]+-[^-]+\.[^.]*$/ } @$rpms }
500    $config->{verbose} and print {$config->{LOG}} "addRPMToList: toadd $name (regexp $fentry->{regexp}) (@toadd)\n";
501    if ($fentry->{done}){
502        foreach (@toadd){
503            my ($pkg) = /^(.*)-[^-]+-[^-]+\.[^.]*$/;
504            my %ht;
505            foreach my $k (keys %$fentry) { $ht{$k} = $fentry->{$k}}   
506            $rpmfile->{$listnumber}{$_} = \%ht;
507            $done->{$pkg} = [ $_, $group->{size}{$_}{$listnumber}[2], \%ht, $listnumber ];
508            $config->{verbose} and print {$config->{LOG}} "addRPMToList: ADDED $_ (list $listnumber) options ", join '', keys %ht,"\n"
509        }
510        return
511    }
512    my %pkg;
513    if ($fentry->{regexp}) { 
514        foreach (@toadd){
515            $_ or print {$config->{LOG}} "ERROR addRPMToList: empty rpm\n" and next;
516            $group->{size}{$_}{$listnumber} or next;
517            $group->{brokendeps}{$_} == 2 and next;
518            $group->{brokendeps}{$_} == 3 and next;
519            my ($pkgname) = /^(.*)-[^-]+-[^-]+\.[^.]*$/;
520            $done->{$_} and next;
521            my $rep = $group->{size}{$_}{$listnumber}[2];
522            $fentry->{exclude} and print {$config->{LOG}} "addRPMToList: excluding $_\n" and $group->{brokendeps}{$_} = 3 and next;
523            if ($done->{$pkgname} && $done->{$pkgname}->[3] == $listnumber){
524                if (!$fentry->{update} || !$done->{$pkgname}[2]{done}){
525                    if ($rep < $done->{$pkgname}->[1]){
526                        $pkg{$done->{$pkgname}->[0]} = 0;
527                        $config->{verbose} and print {$config->{LOG}} "REPLACING $done->{$pkgname}[0] with $_ (list $listnumber)\n";
528                        $pkg{$_} = 1;
529                        $done->{$pkgname} = [ $_, $rep, $fentry, $listnumber ];
530                        $done->{$_} = 1
531                    }elsif ($done->{$pkgname}->[1] == $rep){
532                        if (rpmVersionCompare($done->{$pkgname}->[0],$_) < 0){
533                            $pkg{$done->{$pkgname}->[0]} = 0;
534                            $config->{verbose} and print {$config->{LOG}} "REPLACING $done->{$pkgname}[0] with $_ (list $listnumber)\n";
535                            $pkg{$_} = 1;
536                            $done->{$pkgname} = [ $_, $rep, $fentry, $listnumber ];
537                            $done->{$_} = 1
538                        }
539                    }
540                }
541            }else{ $pkg{$_} = 1; $done->{$pkgname} = [ $_, $rep, $fentry, $listnumber ]; $done->{$_} = 1 }
542        }
543    }else{
544        my $rep;
545        my $pkg;
546        # FIXME present algorythm selects only one package per version, and choose the one in the list declared first.
547        # Maybe adding all the version and letting closeRRPMsList choose the right one is better.
548        foreach (@toadd){
549            $_ or print {$config->{LOG}} "ERROR addRPMToList: empty rpm\n" and next;
550            $group->{size}{$_}{$listnumber} or next;
551            $group->{brokendeps}{$_} == 2 and next;
552            $group->{brokendeps}{$_} == 3 and next;
553            $fentry->{exclude} and print {$config->{LOG}} "addRPMToList: excluding $_\n" and $group->{brokendeps}{$_} = 3 and next;
554            if ($group->{size}{$_}{$listnumber}[2] < $rep || !$rep)  {
555                $rep = $group->{size}{$_}{$listnumber}[2];
556                print {$config->{LOG}} "addRPMToList: choosing $_ (rep $rep)\n";
557                $pkg = $_
558            }elsif ($group->{size}{$_}{$listnumber}[2] == $rep){
559                if (rpmVersionCompare($pkg,$_) < 0){
560                    $rep = $group->{size}{$_}{$listnumber}[2];
561                    print {$config->{LOG}} "addRPMToList: choosing $_ (rep $rep)\n";
562                    $pkg = $_
563                }
564            }
565        }
566        my ($pkgname) = $pkg =~ /^(.*)-[^-]+-[^-]+\.[^.]*$/;
567        if (!$done->{$pkgname}) { $pkg{$pkg} = 1; $done->{$pkgname} = [ $pkg, $rep, $fentry, $listnumber ]; $done->{$pkg} = 1 }
568    }
569    $fentry->{exclude} and return 1;
570    foreach (keys %pkg){
571        $pkg{$_} or next;
572        defined $fentry->{rate} and $group->{pkgrate}{$_} = $fentry->{rate} and print {$config->{LOG}} "addRPMToList: setting $_ rate to $fentry->{rate}\n";
573        my %ht;
574        foreach my $k (keys %$fentry) { $ht{$k} = $fentry->{$k}}
575        $rpmfile->{$listnumber}{$_} = \%ht;     
576        $config->{verbose} and print {$config->{LOG}} "addRPMToList: ADDED $_ (list $listnumber) options ", join " ", keys %ht,"\n"
577    }
578}
579
580sub buildList{
581    my ($class,$group) = @_;
582    my %rpmfile;
583    my $filelist = $group->{filelist};
584    my @fullrpm = (keys %{$group->{params}{info}});
585    my @section = (keys %{$group->{rpmsrate}[1]});
586    my %done;
587    foreach my $listnumber (keys %{$group->{list}}){
588        my $rpms = $group->{listrpm}{$listnumber};
589        if (ref $rpms){
590            print {$config->{LOG}} "$listnumber -- $group->{filelist} -- ", keys %{$group->{filelist}},"\n";
591            ref $filelist->{$listnumber} or print {$config->{LOG}} "WARNING: list $listnumber has an empty file list\n" and next;
592            $config->{verbose} and print {$config->{LOG}} "buildList: FILE LIST $listnumber (", int @{$filelist->{$listnumber}},")\n";
593            foreach my $fentry (@{$filelist->{$listnumber}}){
594                my $name = $fentry->[0];
595                my $opt = $fentry->[1]; 
596                $config->{verbose} and print {$config->{LOG}} "buildList: processing $name ", join ' ', keys %{$opt},"\n";
597                my @toadd;
598                if ($opt->{section}){
599                    my $level = $opt->{section};
600                    $config->{verbose} and print {$config->{LOG}} "buildList: selecting rpmsrate package of section $name with score higher than $level\n";
601                    $opt->{section} = 0;
602                    if ($opt->{regexp}){
603                        $opt->{regexp} = 0;
604                        @toadd = grep {/$name/} @section;
605                        print {$config->{LOG}} "$name (@section) -> @toadd\n";
606                        foreach (@toadd){
607                            foreach (@{$group->{rpmsrate}[1]{$_}}){
608                                print {$config->{LOG}} "$_ -> $group->{rpmsrate}[0]{$_}\n";
609                                if ($group->{rpmsrate}[0]{$_} >= $level){
610                                    addRPMToList($group,$listnumber,\%rpmfile,\%done,$rpms,$opt,$_);
611                                }
612                            }
613                        }
614                    }else{
615                        my $rpmlist = $group->{rpmsrate}[1]{$name} or print {$config->{LOG}} "ERROR buildList: $name unknown rpmsrate section\n" and next;
616                        foreach (@$rpmlist){
617                            if ($group->{rpmsrate}[0]{$_} >= $level){
618                                addRPMToList($group,$listnumber,\%rpmfile,\%done,$rpms,$opt,$_)
619                            }
620                        }
621                    }
622                }else{
623                    addRPMToList($group,$listnumber,\%rpmfile,\%done,$rpms,$opt,$name);
624                }
625            }
626        }else{
627            print {$config->{LOG}} "WARNING: List $listnumber is empty, ignoring\n";   
628            $class->{config}->{list}[$listnumber]{empty} = 1;
629        }
630    }
631    if (!$class->{config}->{nodeps} && !$group->{options}{nodeps}){
632        my @toadd = grep { /^basesystem-[^-]+-[^-]+\.[^.]*$/ } @fullrpm; 
633        my $rep;
634        my $pkg;
635        my $listnumber;
636        foreach (@toadd){
637            # FIXME need to select default list in a better way
638            my $l;
639            foreach $l (keys %{$group->{size}{$_}}){
640                if ($l == $listnumber && $group->{size}{$_}{$listnumber}[2] < $rep || !$rep){
641                    $rep = $group->{size}{$_}{$listnumber}[2];
642                    $pkg = $_;
643                    $listnumber = $l
644                }
645            }
646            $listnumber or $listnumber = $l
647        }
648        if ($pkg){
649            $rpmfile{$listnumber}{$pkg} = {};
650            print {$config->{LOG}} "buildList ADDED $pkg \n"
651        }else { print {$config->{LOG}} "ERROR: basesystem package is not available.\n"}
652
653        # add deps
654        closeRpmsList($group,\%rpmfile)
655    }
656    \%rpmfile
657}
658
659
660# TODO
661#
662sub optimizeSpace{
663    my ($groups,$log,$diff,$size,$cdsize,$cdnum,$gain,$grp,$cdlists,$list) = @_;
664    return 0;
665    my $maxSpace;
666    for(my $i; $i < @$cdsize; $i++){
667        $cdlists->{$i} or next;
668        $maxSpace += $cdsize->[$i] - $size->{disc}[$i] 
669    }
670    if ($maxSpace < $gain) { print {$config->{LOG}} "Could not get $gain on disc $cdnum\n"; return 0}
671    else { print {$config->{LOG}} "$maxSpace available, try to move packages to get $gain free space on disc $cdnum\n"}
672    if ($list){
673        my %cd;
674        my $space;
675        my $group = $groups->[$grp];
676        my @cd;
677        for (my $j; $j < @{$group->{list}{$list}{srpm}}; $j++){
678            my $cd = $group->{list}{$list}[$j][0];
679            $cd{$cd} = 1;
680            $space += $cdsize->[$cd] - $size->{disc}[$cd]
681        }
682        my $ok;
683        for (my $j; $j < @{$group->{list}{$list}{rpm}}; $j++){
684            my $cd = $group->{list}{$list}[$j][0];
685            $space += $cdsize->[$cd] - $size->{disc}[$cd];
686            if ($cd{$cd}){
687                $ok = 1;
688                push @cd, $cd
689            }
690        }
691        if ($ok && $space >= $gain){
692            print {$config->{LOG}} "optimizeSpace: trying to gain $gain within group\n";       
693            foreach (@cd){
694
695            }
696        }
697    }
698    0
699}
700
701sub addRPMToDiff{
702    my ($rpm,$rpmd,$diff,$cdnum,$repnumber, $i, $list, $curdir, $size, $rpmsize,$totrpmsize,$j, $done) = @_;
703    my @interdeps;
704    for (my $s; $s < @$rpm; $s++){
705        push @{$diff->[$cdnum][$i][$list][$j][0]}, [$rpm->[$s],1,$rpmd->[$s],$curdir,$rpmsize->[$s]];
706        my $id = @{$diff->[$cdnum][$i][$list][$j][0]};
707        print {$config->{LOG}} "addRPMToDiff: $rpm->[$s] put in rep $repnumber\n";
708        $done->{$rpm->[$s]} = $repnumber;
709        $interdeps[$s][0] = $id-1;
710        $interdeps[$s][1] = [$cdnum, $i, $list, $curdir, $id];
711    }
712    if (@$rpm > 1){ 
713        for (my $s; $s < @$rpmd; $s++){
714            my $id = $interdeps[$s][0]; 
715            foreach (my $t; $t < @interdeps; $t++){
716                $t == $s and next;
717                push @{$diff->[$cdnum][$i][$list][$j][0][$id][6]}, $interdeps[$t][1]
718            }
719        }
720    }
721    $size->{disc}[$cdnum] += $totrpmsize;
722    $size->{rep}{$cdnum}{$curdir->[1]}{$list} += $totrpmsize;
723    $config->{verbose} and print {$config->{LOG}} "addRPMToDiff: SIZE disc $cdnum: $size->{disc}[$cdnum] (+ @$rpm $totrpmsize)\n";
724    (1,\@interdeps)
725}
726
727sub find_list {
728    my ($group,$r,$list) = @_;
729    my $l;
730    foreach (keys %{$group->{size}{$r}}){
731        $l = $_ if (($l && $group->{listmatrix}{rpm}{$l}{$_}) || $group->{listmatrix}{rpm}{$list}{$_})
732    }
733    return $l
734}
735
736sub processDeps{
737    my ($r,$group,$rejected,$done,$rpmlist,$topush,$intopush,$depsdisc,$rpmd,$list,$loop,$i,$tobedone,$buildlist,$rpm) = @_;
738    print {$config->{LOG}} "processDeps: deps $r\n";
739    # FIXME default to random list if $l != $list
740    my $l = find_list($group,$r,$list);
741    if ($rejected->[$i]{$r}) { 
742        print {$config->{LOG}} "ERROR processDeps: deps $r rejected, rejecting @$rpm\n";
743        $config->{verbose} and print {$config->{LOG}} "Rejecting @$rpm $r\n";
744        @{$rejected->[$i]}{@$rpm} = map 1, @$rpm;
745        $rejected->[$i]{$r} = 1;
746        $$loop = 1; %$topush = (); return 0 
747    }
748    my $tcd = $done->{$r};
749    if ($tcd){
750        if ($tcd > $$depsdisc) { $$depsdisc = $tcd};
751        $config->{verbose} and print {$config->{LOG}} "processDeps: deps done $r on rep $tcd ($$depsdisc)\n";
752        return 2 
753    }
754    if ($tobedone->[$i]{$r}){
755        if ($l == $list){
756            print {$config->{LOG}} "$r tobedone\n";
757            $intopush->{$r} and print {$config->{LOG}} "WARNING processDeps: $r added twice\n" and return 1;
758            push @$rpmd, [$r, $rpmlist->[$i]{$l}{$r}];
759            $intopush->{$r} = 1;
760            push @{$topush->{$l}}, $rpmd; 
761            $config->{verbose} and print {$config->{LOG}} "processDeps: adding looping deps $r ($_ -- $l) with @$rpm\n"
762        }else{
763                if ($group->{listmatrix}{rpm}{$list}{$l}){
764                    # FIXME tobedone may not mean dependencies loop in parallel mode for different list.
765                    print {$config->{LOG}} "processDeps: $r is already scheduled on list $l, waiting.\n";
766                    %$topush = ();
767                    push @{$buildlist->[$i]{$list}}, @$rpmd > 1 ? $rpmd : $rpmd->[0];
768                    return 3
769                    #$intopush{$r} and print {$config->{LOG}} "ERROR: $r added twice\n" and return 0;
770                    #$intopush{$r} = 1;
771                    #push @{$topush{$l}}, [$r, $rpmlist->[$i]{$l}{$r}];
772                    #$config->{verbose} and print {$config->{LOG}} "DEPS $r ($_ -- $l)\n"
773                }else{
774                    print {$config->{LOG}} "ERROR processDeps: deps $r could not be put in directory before packages @$rpm\n";
775                    $config->{verbose} and print {$config->{LOG}} "Rejecting @$rpm $r\n";
776                    @{$rejected->[$i]}{@$rpm} = map 1, @$rpm;
777                    $rejected->[$i]{$r} = 1;
778                    %$topush = ();
779                    $$loop = 1;
780                    return 0
781            }
782        }
783    }else{
784        if ($l == $list){
785            $intopush->{$r} and print {$config->{LOG}} "WARNING processDeps: $r added twice\n" and return 1;
786            $intopush->{$r} = 1;
787            push @{$topush->{$l}}, [$r, $rpmlist->[$i]{$l}{$r}]; 
788            $config->{verbose} and print {$config->{LOG}} "processDeps: adding normal deps $r ($_ -- $l)\n"
789        } else {
790            if ($group->{options}{sequential}){
791                print {$config->{LOG}} "WARNING processDeps: could not add interlist deps in sequential mode\n";
792                $config->{verbose} and print {$config->{LOG}} "Rejecting @$rpm\n";
793                @{$rejected->[$i]}{@$rpm} = map 1, @$rpm;
794                %$topush = ();
795                $$loop = 1;
796                return 0
797            } else {
798                if ($group->{listmatrix}{rpm}{$list}{$l}){
799                    $intopush->{$r} and print {$config->{LOG}} "WARNING processDeps: $r added twice\n" and return 1;
800                    $intopush->{$r} = 1;
801                    push @{$topush->{$l}}, [$r, $rpmlist->[$i]{$l}{$r}]; 
802                    $config->{verbose} and print {$config->{LOG}} "processDeps: adding normal deps $r ($_ -- $l)\n"
803                }else{
804                    print {$config->{LOG}} "ERROR processDeps: deps $r could not be put in directory before packages @$rpm\n";
805                    $config->{verbose} and print {$config->{LOG}} "Rejecting @$rpm\n";
806                    @{$rejected->[$i]}{@$rpm} = map 1, @$rpm;
807                    %$topush = ();
808                    $$loop = 1;
809                    return 0
810                }
811            }
812        }
813    }
814}
815
816sub updateGenericLimit {
817    my ($groups,$cdsize) = @_;
818    $config->{verbose} and print {$config->{LOG}} "updateGenericLimit\n";
819    for (my $i; $i < @$groups; $i++){
820        foreach my $type (keys %{$groups->[$i]{orderedlist}}){
821            foreach my $list (@{$groups->[$i]{orderedlist}{$type}}){
822                foreach my $r (@{$groups->[$i]{list}{$list}{$type}}){
823                    my ($cd,$rep,$repopt) = @$r;
824                    #print {$config->{LOG}} "trying to update disc $cd rep $rep list $list limit repopt $repopt (",keys %$repopt,") opt $opt (",keys %$opt,")\n";
825                    $config->{list}[$list]{disc}{$cd}{$rep}{done} and next;
826                    $repopt->{limit} or next;
827                    $repopt->{limit}{size} = $repopt->{limit}{value} * $cdsize->[$cd];
828                    $config->{verbose} and print {$config->{LOG}} "updateGenericLimit: setting disc $cd rep $rep list $list limit to $repopt->{limit}{size} ($repopt->{limit}{value} * $cdsize->[$cd])\n";
829                }
830            }
831        }
832    }
833}
834
835sub testSoftLimit{
836    my ($opt,$cd,$groups,$buildlist) = @_;
837    print $config->{verbose} and print {$config->{LOG}} "testSoftLimit\n";
838    my $softnok = 1;
839    # FIXME this code must be tested
840    if ($opt->{limit} && $opt->{limit}{soft}){
841        foreach my $l (@{$config->{disc}[$cd]{fastgeneric}}){
842            my $lst = $l->[2]{list};
843            for (my $i; $i < @$groups; $i++){
844                $groups->[$i]{list}{$lst} or next;     
845                $softnok = 0 if (@{$buildlist->[$i]{$lst}} && !($lst->{limit} && $lst->{limit}{soft}))   
846            }
847        }
848    }
849    return $softnok;
850}
851
852sub add_one_disc{
853    my ($cdlists,$group,$cdsize,$list,$cds,$sources) = @_;
854    my $ncd;
855    foreach (keys %{$cdlists}){
856        $ncd = $_ + 1 if $ncd <= $_
857    }
858    print {$config->{LOG}} "add_one_disc: $config->{list}[$list]{cd} -- $ncd\n";
859    if (!$config->{list}[$list]{cd} || ($config->{list}[$list]{cd} >= $ncd)){
860        print {$config->{LOG}} "add_one_disc: adding new disc $ncd\n";
861        $config->{disc}[$ncd]{size} = $config->{discsize};
862        my $functions = $config->{group}{disc}{functions}{functions};
863        $cdsize->[$ncd] = $config->{discsize};
864        $config->{disc}[$ncd]{name} = $ncd;
865        my ($curdir,$srpmcurdir);
866        my $tmp = "$config->{tmp}/build/$config->{name}";
867        my $f = "$tmp/$ncd.list";
868        -f $f and unlink $f;
869        if ($config->{nolive}){
870            print {$config->{LOG}} "makeDisc: removing $tmp/$ncd\n";
871            rmtree "$tmp/$ncd";
872            mkpath "$tmp/$ncd";
873        }else{
874            my $dir = "$config->{topdir}/build/$config->{name}";
875            rmtree "$dir/$ncd";
876            rmtree "$dir/first/$ncd";
877            mkpath "$dir/$ncd"
878        }
879        my $instcd = $group->{installDisc};
880        my ($k,$l);
881
882        if ($sources && $config->{list}[$list]{sources} && $config->{list}[$list]{sources}{separate}){
883            $config->{disc}[$ncd]{serial} = "$config->{name}-disc$ncd-sources";
884            $config->{disc}[$ncd]{longname} = "MandrakeLinux $config->{name} sources";
885            &{$functions->{dir}[0][5]}($ncd,3,"srpms","Mandrake/SRPMS");
886            &{$functions->{generic}[0][5]}($ncd,4,"srpms",1);
887            &{$functions->{generic}[1][5]}($ncd,6, {source => 1});
888            push @{$config->{disc}[$instcd]{function}{data}{installation}[1]{srpmsdir}}, [ 0, $ncd,"srpms"];
889            $srpmcurdir = [ $ncd, "srpms" ];
890            $l = push @{$group->{list}{$list}{srpm}}, $srpmcurdir
891        }else{
892            $config->{disc}[$ncd]{serial} = "$config->{name}-disc$ncd";
893            $config->{disc}[$ncd]{longname} = "MandrakeLinux $config->{name}";
894            &{$functions->{dir}[0][5]}($ncd,1,"rpms","Mandrake/RPMS$ncd");
895            &{$functions->{generic}[0][5]}($ncd,2,"rpms",1);
896            $group->{orderedrep}{rpm}{"$ncd/rpms"} = $ncd;
897            #
898            # generic has no FIXED part, otherwize a call to generic with fixed=0
899            # would have been needed
900            #
901            $curdir = [$ncd, "rpms"];
902            push @{$group->{list}{$list}{rpm}}, $curdir;
903            $k = push @{$config->{disc}[$instcd]{function}{data}{installation}[1]{rpmsdir}}, [ 0, $ncd,"rpms"];
904            if ($config->{list}[$list]{sources}){
905                &{$functions->{dir}[0][5]}($ncd,3,"srpms","Mandrake/SRPMS");
906                &{$functions->{generic}[0][5]}($ncd,4,"srpms",1);
907                &{$functions->{generic}[1][5]}($ncd,6, {source => 1});
908                push @{$config->{disc}[$instcd]{function}{data}{installation}[1]{srpmsdir}}, [ 0, $ncd,"srpms"];
909                $srpmcurdir = [ $ncd, "srpms" ];
910                $l = push @{$group->{list}{$list}{srpm}}, $srpmcurdir
911            }
912        }
913        push @$cds, $ncd;
914        $cdlists->{$ncd} = 2;
915        return ($curdir,$k-1,$srpmcurdir,$l-1)
916    } else { return 0 }
917}
918
919sub addSRPMToDiff {
920    my ($rpmd,$done,$diff,$size,$srpmrep,$srpmsize,$curdir,$srpm,$list,$i,$j,$interdeps,$cdnum) = @_;
921    for (my $s; $s < @$rpmd; $s++){
922        if (!$rpmd->[$s][1]{nosrc} && !$done->{$srpm->[$s]}){
923            my $srep = $srpmrep->{$srpm->[$s]};
924            push @{$diff->[$srep->[0]][$i][$list][$srep->[1]][1]}, [$srpm->[$s],1,$rpmd->[$s],$srep->[2],$srpmsize->[$s]];
925            my $idx = $interdeps->[$s][0];
926            my $sidx = @{$diff->[$srep->[0]][$i][$list][$srep->[1]][1]};
927            my $rdeps = $interdeps->[$s][1];
928            $diff->[$cdnum][$i][$list][$j][0][$idx-1][5] = [$srep->[0], $i, $list, $srep->[1], $sidx-1];
929            $diff->[$srep->[0]][$i][$list][$srep->[1]][1][$sidx-1][5] = $rdeps;
930            $size->{disc}[$srep->[0]] += $srpmsize->[$s];
931            $size->{rep}{$srep->[0]}{$srep->[1]}{$list} += $srpmsize->[$s];
932            $config->{verbose} and print {$config->{LOG}} "SIZE disc $srep->[0]: $size->{disc}[$srep->[0]] (+ $srpm->[$s] $srpmsize->[$s])\n";
933        }
934        $done->{$srpm->[$s]}++;
935    }
936    1
937}
938
939sub sourcesSizeCheck{
940    my ($done,$rpmd,$srpm,$group,$groups,$size,$cdsize,$list,$cdlists,$cdnum,$rpmsize,$buildlist,$cds) = @_;
941    my %srpmrep;   
942    my $srpmok = 1;
943    my @srpmsize;
944    for (my $s; $s < @$srpm; $s++){
945        $done->{$srpm->[$s]} and next;
946        $rpmd->[$s][1]{nosrc} and next;
947        my $srpmsize = $group->{size}{$srpm->[$s]}{$list}[0];
948        $srpmsize[$s] = $srpmsize;
949        for (my $k; $k < @{$group->{list}{$list}{srpm}}; $k++){
950            my $srpmdir = $group->{list}{$list}{srpm}[$k];
951            my ($srccd,$srcrepname,$srcopt)= @$srpmdir;
952            $config->{verbose} and print {$config->{LOG}} "trying source disc $srccd\n";
953            $cdlists->{$srccd} > 1 or next;
954            my $currentrpm;
955            $cdnum == $srccd and $currentrpm = $rpmsize;
956            my $softnok = testSoftLimit($srcopt,$srccd,$groups,$buildlist);
957            # FIXME this need to be tested
958            if ($size->{disc}[$srccd] + $srpmsize + $currentrpm <= $cdsize->[$srccd] && !( $srcopt->{limit} && ($softnok || !$srcopt->{limit}{soft}) && $size->{rep}{$srccd}{$srcrepname}{$list} > $srcopt->{limit}{size})){
959                $srpmrep{$srpm->[$s]} = [$srccd,$k,$srpmdir];
960                last
961            }
962        }
963        if (!$srpmrep{$srpm->[$s]}){
964            $srpmok = 0
965            # no last here because if in autoMode a CD will be added after and we will not retest for each srpm if it could be put on an existing CD.
966        }
967    }
968    if (!$srpmok && $config->{list}[$list]{auto}){
969        my (undef,undef,$srpmdir,$k) = add_one_disc($cdlists,$group,$cdsize,$list,$cds,1);
970        if ($srpmdir){
971            for (my $s; $s < @$srpm; $s++){
972                if (!$srpmrep{$srpm->[$s]}){
973                    $srpmrep{$srpm->[$s]} = [$srpmdir->[0], $k, $srpmdir];
974                }
975            }
976            $srpmok = 1
977        }
978    }
979    return (\%srpmrep,\@srpmsize,$srpmok)
980}
981
982# TODO the algo is not as beautiful as it should be, but it is getting better
983sub buildDiscs{
984    my ($class,$groups,$buildlist,$rpmlist,$log,$groupok,$size,$cdsize,$cdlists,$cds) = @_;
985    $config->{verbose} and print {$config->{LOG}} "buildDiscs\n";
986    my $config = $class->{config};
987    my @diff;
988    for(my $i; $i < @{$size->{disc}}; $i++){
989        if ($size->{disc}[$i] > $cdsize->[$i]) { 
990            my $gain = $size->{disc}[$i] - $cdsize->[$i];
991            optimizeSpace($groups,$log,\@diff,$size,$cdsize,$gain,$i,$cdlists)
992        }
993    }
994    my $ok;
995    my @groupok = map 0, @$groups;
996    my @tobedone;
997    my @rejected;
998    my @needed;
999    my $iti;
1000    my @nosrcfit;
1001    updateGenericLimit($groups,$cdsize);
1002    while (!$ok){
1003        $config->{verbose} and print {$config->{LOG}} "iti: ",$iti++,"\n";
1004        $ok = 1;
1005        for (my $i; $i < @$groups; $i++){
1006            $groupok[$i] and next;
1007            my $group = $groups->[$i];
1008            #
1009            # FIXME source rpms are not shared between group, it may be usefull for mutilple installation
1010            # with common source dir, so that the same source rpm is shared (but this is not so common).
1011            #
1012            my $done = $group->{done};
1013            my $dn;
1014            while (!$dn){
1015                $groupok[$i] = 1;
1016                foreach my $list (@{$group->{orderedlist}{rpm}}){
1017                    $config->{verbose} and print {$config->{LOG}} "buildDiscs: list $list\n";
1018                    do {
1019                        $config->{list}[$list]{done} and goto end;
1020                        $config->{list}[$list]{empty} and goto end;
1021                        my $next;
1022                        foreach (@{$needed[$i]{$list}}){
1023                            $config->{verbose} and print {$config->{LOG}} "List $list need list $_->[0] to be <= $_->[1] (",int @{$buildlist->[$i]{$_->[0]}},")\n";
1024                            int @{$buildlist->[$i]{$_->[0]}} <= $_->[1] or $next = 1
1025                        }
1026                        $next and print {$config->{LOG}} "LIST $list waiting\n" and goto end;
1027                        $needed[$i]{$list} = [];
1028                        my $trpmd;
1029                        my $k;
1030                        my $goon;
1031                        my @rpmd;
1032                        do { 
1033                            $trpmd = pop @{$buildlist->[$i]{$list}} or goto end;
1034                            if (ref $trpmd->[0]){
1035                                foreach (@$trpmd){
1036                                    !$done->{$_->[0]} and push @rpmd, $_
1037                                }
1038                            } else { !$done->{$trpmd->[0]} and push @rpmd, $trpmd}
1039                        } until (@rpmd);
1040                        $groupok[$i] = 0;
1041                        $ok = 0;
1042                        my @rpm;
1043                        my $rpmsize;
1044                        my @rpmsize;
1045                        foreach (@rpmd){
1046                            my $r = $_->[0];
1047                            !$r and print {$config->{LOG}} "ERROR buildDisc: empty package @$_\n";
1048                            push @rpm, $r;
1049                            $config->{verbose} and print {$config->{LOG}} "RPM $r (group $i list $list)\n";
1050                            $tobedone[$i]{$r} = 1;
1051                            $rpmsize += $group->{size}{$r}{$list}[0];
1052                            push @rpmsize, $group->{size}{$r}{$list}[0]
1053                        }
1054                        my $loop;
1055                        my $dn2;
1056                        for (my $j; !$loop && !$dn2 && $j < @{$group->{list}{$list}{rpm}}; $j++){
1057                            $loop = 0;
1058                            my $curdir = $group->{list}{$list}{rpm}[$j];
1059                            $config->{list}[$list]{disc}{$curdir->[0]}{$curdir->[1]}{done} and next;
1060                            my ($cdnum,$repname,$repopt) = @$curdir;
1061                            $cdlists->{$cdnum} > 1 or next;
1062                            my $thisorderrep = $group->{orderedrep}{rpm}{"$cdnum/$repname"};
1063                            my $softnok = testSoftLimit($repopt,$cdnum,$groups,$buildlist);
1064                            $config->{verbose} and print {$config->{LOG}} "buildDiscs: softnok $softnok\n";
1065                            if ($size->{disc}[$cdnum] + $rpmsize > $cdsize->[$cdnum] || $repopt->{limit} && ($softnok || !$repopt->{limit}{soft}) && ($size->{rep}{$cdnum}{$repname}{$list} + $rpmsize > $repopt->{limit}{size})) {
1066                                if ($j == @{$group->{list}{$list}{rpm}}-1){
1067                                    if (!($repopt->{limit} && !$softnok && $repopt->{limit}{soft})){
1068                                        if (!optimizeSpace($groups,$log,\@diff,$size,$cdsize,$cdnum,$rpmsize,$i,$cdlists,$list)){
1069                                            if ($config->{list}[$list]{auto}){
1070                                                my ($curdir,$j) = add_one_disc($cdlists,$group,$cdsize,$list,$cds);
1071                                                if ($curdir){
1072                                                    $cdnum = $curdir->[0]
1073                                                } else {
1074                                                    $config->{verbose} and print {$config->{LOG}} "Could not add more disc, rejecting @rpm\n";
1075                                                    @{$rejected[$i]}{@rpm} = map 1, @rpm and next
1076                                                }
1077                                            }else {
1078                                                $config->{verbose} and print {$config->{LOG}} "Rejecting $@rpm\n";
1079                                                @{$rejected[$i]}{@rpm} = map 1, @rpm and next
1080                                            }
1081                                        }
1082                                    }else { 
1083                                        foreach my $l (@{$config->{disc}[$cdnum]{fastgeneric}}){
1084                                            my $lst = $l->[2]{list};
1085                                            $list == $lst and next;
1086                                            for (my $i; $i < @$groups; $i++){
1087                                                $groups->[$i]{list}{$lst}{rpm} or next; 
1088                                                push @{$needed[$i]{$list}}, [ $lst, 0 ] if (!($lst->{limit} && $lst->{limit}{soft}))
1089                                            }
1090                                        }
1091                                    }
1092                                }else { next }
1093                            }
1094                            if (!$config->{nodeps} && !$group->{options}{nodeps}) {
1095                                my @tdeps;
1096                                my %curID;
1097                                foreach (@rpmd){
1098                                    my $rpm = $_->[0];
1099                                    $curID{$group->{params}{info}{$rpm}{id}} = 1;
1100                                    $_->[1]{nodeps} and next;
1101                                    $group->{pkgdeps}{$rpm} and push @tdeps, @{$group->{pkgdeps}{$rpm}}
1102                                }
1103                                my @deps;
1104                                my %depsdone;
1105                                foreach (@tdeps){
1106                                    if (ref){
1107                                        my @toadd;
1108                                        my $key = join '|',@$_;
1109                                        $depsdone{$key}++ and next;
1110                                        foreach my $d (@$_){
1111                                            if ($curID{$d}){ @toadd = (); last }
1112                                            push @toadd, $d
1113                                        }
1114                                        @toadd and push @deps, \@toadd
1115                                    }elsif(!$curID{$_}){
1116                                        $depsdone{$_}++ and next;
1117                                        push @deps, $_
1118                                    }
1119                                }
1120                                if (@deps){
1121                                    my $waiting;
1122                                    my %topush;
1123                                    my %intopush;
1124                                    my $depsdisc;
1125                                    foreach (@deps){
1126                                        if (!ref){
1127                                            my $a = processDeps($group->{depslistid}[$_],$group,\@rejected,$done,$rpmlist,\%topush,\%intopush,\$depsdisc,\@rpmd,$list,\$loop,$i,\@tobedone,$buildlist,\@rpm);
1128                                            if ($a < 0) {return 0 } elsif ($a == 0) { last } elsif ($a == 2) { next } elsif ($a == 3) { $waiting = 1; last  }
1129                                        }else{
1130                                            # must create a virtual package that install all of them in one loop
1131                                            my $score = [ 0, $group->{maxlist} ];
1132                                            my $r = -1;
1133                                            $config->{verbose} and print {$config->{LOG}} "buildDiscs: alternatives deps @$_\n";
1134                                            foreach (@$_){
1135                                                # FIXME it may have a problem here, as depslistid are not erased when the
1136                                                # package is removed, that is to say that if the previous deps failed for
1137                                                # any reason, alternates deps may be added, although excluded before
1138                                                # however this _must_ not happen, and signify a bug somewhere else.
1139                                                my $pkg = $group->{depslistid}[$_];
1140                                                $intopush{$pkg} and $r = $pkg and last;
1141                                                $config->{verbose} and print {$config->{LOG}} "buildDiscs: alternatives deps $pkg\n";
1142                                                $rejected[$i]{$pkg} and next;
1143                                                my $tcd = $done->{$pkg};
1144                                                if ($done->{$pkg} && $tcd <= $group->{orderedrep}{rpm}{"$cdnum/$repname"}){
1145                                                    print {$config->{LOG}} "$pkg ($tcd) done\n";
1146                                                    $r = 0;
1147                                                    last
1148                                                } 
1149                                                my $s = $group->{scorelist}{$pkg};
1150                                                my $pkgList = find_list($group,$pkg,$list);
1151                                                if ($group->{options}{sequential} && !$config->{list}[$list]{done} && @{$buildlist->[$i]{$pkgList}}) { next }
1152                                                $config->{verbose} and print {$config->{LOG}} "buildDiscs: $pkg list $pkgList\n";
1153                                                if (!$tcd && $group->{listmatrix}{rpm}{$list}{$pkgList}){
1154                                                    if ($group->{listsort}{rpm}{$pkgList} < $score->[1] || ($group->{listsort}{rpm}{$pkgList} == $score->[1] && $s > $score->[0])){
1155                                                        $config->{verbose} and print {$config->{LOG}} "buildDiscs: choosing $pkg ($s, $group->{listsort}{$pkgList})\n";
1156                                                        $score = [ $s, $group->{listsort}{rpm}{$pkgList} ];
1157                                                        $r = $pkg;
1158                                                    }
1159                                                }
1160                                            }
1161                                            $intopush{$r} and next;
1162                                            if ($r == -1){
1163                                                print {$config->{LOG}} "ERROR buildDiscs: alternatives deps (@$_) could not be put in directory before packages @rpm\n";
1164                                                $config->{verbose} and print {$config->{LOG}} "Rejecting @rpm\n";
1165                                                @{$rejected[$i]}{@rpm} = map 1, @rpm;
1166                                                %topush = ();
1167                                                $loop = 1;
1168                                                last
1169                                            }
1170                                            if ($r){ 
1171                                                my $a = processDeps($r,$group,\@rejected,$done,$rpmlist,\%topush,\%intopush,\$depsdisc,\@rpmd,$list,\$loop,$i,\@tobedone,$buildlist,\@rpm);
1172                                                if ($a < 0) {return 0 } elsif ($a == 0) { last } elsif ($a == 2) { next } elsif ($a == 3) { $waiting = 1; last  }
1173                                            }else{
1174                                                $config->{verbose} and print {$config->{LOG}} "Finding better alternatives rep (@$_ - $depsdisc)\n";
1175                                                my $bestdisc = (keys %{$group->{orderedrep}{rpm}});
1176                                                if ($bestdisc >= $depsdisc){
1177                                                    foreach (@$_){
1178                                                        my $pkg = $group->{depslistid}[$_];
1179                                                        $rejected[$i]{$pkg} and print {$config->{LOG}} "$pkg rejected\n" and next;
1180                                                        my $tcd = $done->{$pkg} or next; 
1181                                                        $config->{verbose} and print {$config->{LOG}} "$pkg => rep $tcd\n";
1182                                                        if ($tcd < $bestdisc) { $bestdisc = $tcd}
1183                                                    }
1184                                                    $bestdisc > $depsdisc and $depsdisc = $bestdisc
1185                                                }
1186                                                $config->{verbose} and print {$config->{LOG}} "Finding better alternatives rep result $depsdisc\n";
1187                                            }
1188                                        }
1189                                    }
1190                                    $waiting and next;
1191                                    if (keys %topush){
1192                                        $config->{verbose} and print {$config->{LOG}} "Adding dependencies, looping\n";
1193                                        $loop = 1;
1194                                        my $test = @rpmd > 1 ? \@rpmd : $rpmd[0];
1195                                        push @{$buildlist->[$i]{$list}}, @rpmd > 1 ? \@rpmd : $rpmd[0];
1196                                        foreach (keys %topush){
1197                                            $list != $_ and push @{$needed[$i]{$list}}, [ $_, int @{$buildlist->[$i]{$_}} ];
1198                                            push @{$buildlist->[$i]{$_}}, @{$topush{$_}}
1199                                        }
1200                                    }elsif ($thisorderrep < $depsdisc) {
1201                                        if ($group->{listmaxrep}{rpm}{$list} >= $depsdisc){
1202                                            # has a chance to put it after depsdic
1203                                            $config->{verbose} and print {$config->{LOG}} "Dependencies on further directories ($depsdisc)\n";
1204                                            next
1205                                        }else{
1206                                            $config->{verbose} and print {$config->{LOG}} "buildDiscs: dependances are in further directories, rejecting @rpm\n";
1207                                            @{$rejected[$i]}{@rpm} = map 1, @rpm;
1208                                            $loop = 1
1209                                        }
1210                                    }
1211                                }
1212                            }
1213                            $loop and next;     
1214                            $config->{verbose} and print {$config->{LOG}} "@rpm deps ok\n";
1215                            my $nosrc = 1;
1216                            my @srpm;
1217                            my $donesrpm = 1;
1218                            if (!$group->{options}{nosources} && @{$group->{list}{$list}{srpm}}){
1219                                for (my $s; $s < @rpmd; $s++){
1220                                    my $srpm = $group->{params}{info}{$rpm[$s]}{sourcerpm}; 
1221                                    $srpm =~ s/\.rpm$//;
1222                                    if (!$group->{size}{$srpm}{$list}) {
1223                                        print {$config->{LOG}} "buildDiscs: ERROR: $srpm not available, trying alternatives => ";
1224                                        my ($srpmname) = $srpm =~ /(.*)-[^-]+-[^-]+\.src/;
1225                                        $srpm = $group->{srpmname}{$srpmname};
1226                                        if ($srpm) { print {$config->{LOG}} " $srpm\n" } else { print {$config->{LOG}} "not found\n"}
1227                                    }
1228                                    if ($srpm) { 
1229                                        $done->{$srpm} or $donesrpm = 0;
1230                                        $srpm[$s] = $srpm;
1231                                        $rpmd[$s][1]{nosrc} or $nosrc = 0 
1232                                    }
1233                                }
1234                            }
1235                            $config->{verbose} and print {$config->{LOG}} "buildDiscs: list $list: @rpm (@srpm) -- $curdir->[0] -- $curdir->[1] -- disc $cdnum\n";
1236                            if ($group->{options}{nosources} || !@{$group->{list}{$list}{srpm}} || $nosrc || $donesrpm) {
1237                                ($dn2) = addRPMToDiff(\@rpm, \@rpmd,\@diff,$cdnum, $group->{orderedrep}{rpm}{"$cdnum/$repname"}, $i, $list, $curdir, $size,\@rpmsize,$rpmsize,$j,$done)
1238                            }else{
1239                                if ($config->{nosrcfit} || $group->{options}{nosrcfit}){
1240                                    ($dn2, my $interdeps) = addRPMToDiff(\@rpm, \@rpmd,\@diff,$cdnum, $group->{orderedrep}{rpm}{"$cdnum/$repname"}, $i, $list, $curdir, $size,\@rpmsize,$rpmsize,$j,$done);
1241                                    push @nosrcfit, [\@rpmd,\@srpm,$list,$i,$j,$curdir,$interdeps,$cdnum]
1242                                }else{
1243                                    my ($srpmrep,$srpmsize,$srpmok) = sourcesSizeCheck($done,\@rpmd,\@srpm,$group,$groups,$size,$cdsize,$list,$cdlists,$cdnum,$rpmsize,$buildlist,$cds);
1244                                    if ($srpmok){
1245                                        (undef, my $interdeps) = addRPMToDiff(\@rpm, \@rpmd,\@diff,$cdnum, $group->{orderedrep}{rpm}{"$cdnum/$repname"}, $i, $list, $curdir, $size,\@rpmsize,$rpmsize,$j,$done);
1246                                        $dn2 = addSRPMToDiff(\@rpmd,$done,\@diff,$size,$srpmrep,$srpmsize,$curdir,\@srpm,$list,$i,$j,$interdeps,$cdnum);
1247                                    }else{
1248                                        print {$config->{LOG}} "WARNING: @srpm does not fit on the discs\n"
1249                                    }
1250                                }
1251                                if (!$dn2){
1252                                    @{$rejected[$i]}{@rpm} = map 1, @rpm;
1253                                    print {$config->{LOG}} "WARNING: @rpm does not fit on the disc ($size->{disc}[$cdnum] + $rpmsize > $cdsize->[$cdnum]) \n"
1254                                }
1255                            }
1256                        }
1257                        $dn2 and $dn = 1;
1258                    } while ($group->{options}{sequential} && @{$buildlist->[$i]{$list}});
1259                    end:
1260                    next if ($group->{options}{sequential} && @{$buildlist->[$i]{$list}}) 
1261                } 
1262                $groupok[$i] and $dn = 1
1263            }
1264        }
1265    }
1266    foreach (@nosrcfit){
1267        my ($rpmd,$srpm,$list,$i,$j,$curdir,$interdeps,$cdnum) = @$_;
1268        my $group = $groups->[$i];
1269        my $done = $group->{done};
1270        my ($srpmrep,$srpmsize,$srpmok) = sourcesSizeCheck($done,$rpmd,$srpm,$group,$groups,$size,$cdsize,$list,$cdlists,0,0,$buildlist,$cds);
1271        if ($srpmok){
1272            addSRPMToDiff($rpmd,$done,\@diff,$size,$srpmrep,$srpmsize,$curdir,$srpm,$list,$i,$j,$interdeps,$cdnum);
1273        }else{
1274            print {$config->{LOG}} "WARNING: @$srpm does not fit on the discs\n"
1275        }
1276    }
1277    my $rejected;
1278    $config->{verbose} and print {$config->{LOG}} "buildDiscs: rejected packages\n";
1279    for(my $i; $i < @rejected; $i++){
1280        $rejected[$i] or next;
1281        $rejected=1;
1282        foreach (keys %{$rejected[$i]}){
1283            print {$config->{LOG}} "WARNING buildDisc: group $i REJECTED $_\n"
1284        }
1285    }
1286    (\@diff,$rejected);
1287}
12881
1289
1290# Changelog
1291#
1292# 2002 02 21
1293#
1294# change false $j comparaison to $depsdisc in buildDisc to new $thisorderrep value.
1295#
1296# 2002 03 03
1297#
1298# new limit option handling.
1299# add updateGenericSoft function
1300# add testSoftLimit function
1301# update size to check rep size
1302#
1303# 2002 03 08
1304#
1305# fix autoMode CD adding
1306#
1307# 2002 03 13
1308#
1309# better selection of alternatives in multi-list to take the one in the first lists.
1310#
1311# 2002 03 14
1312#
1313# add sources new sources handling method
1314# in nosrcfit mode sources are added afterwards
1315#
1316# 2002 03 19
1317#
1318# add prelist in geList for cdcom, will be useful for oem too I guess.
1319#
1320# 2002 05 02
1321#
1322# add_one_disc: add separate mode for sources mode
1323#
1324# 2002 05 09
1325#
1326# add graft structure for md5 and graft point handling
1327#
1328# 2002 05 13
1329#
1330# fix a tricky bugs in buildList about fentry shared and not recreated for each packages.
Note: See TracBrowser for help on using the repository browser.