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