source: soft/build_system/build_system/mkcd/tags/V4_1_0_1mdk/pm/Mkcd/Optimize.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: 27.3 KB
Line 
1#
2# Copyright (C) 2000,2001,2002,2003,2004 Mandrakesoft
3#
4# Author: Florent Villard <warly@mandraesoft.com>
5#
6# This program is free software; you can redistribute it and/or modify
7# it under the terms of the GNU General Public License as published by
8# the Free Software Foundation; either version 2, or (at your option)
9# any later version.
10#
11# This program is distributed in the hope that it will be useful,
12# but WITHOUT ANY WARRANTY; without even the implied warranty of
13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14# GNU General Public License for more details.
15#
16# You should have received a copy of the GNU General Public License
17# along with this program; if not, write to the Free Software
18# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
19#
20# to prepare, create and burn iso images
21#
22
23package Mkcd::Optimize;
24
25my $VERSION = '0.0.2';
26
27use strict;
28use Mkcd::Tools qw(log_);
29our @ISA = qw(Exporter);
30our @EXPORT = qw(optimize_space get_pkgs_deps print_conflict_matrix );
31
32sub optimize_space {
33    my ($config, $groups, $diff, $size, $cdsize, $cdnum, $gain, $cdlists, $special, $grp, $list, $type, $all_rpmsize) = @_;
34    $config->{optimize_space} or return 0;
35    log_("optimize_space: cdnum $cdnum gain $gain cdlists $cdlists grp $grp list $list\n", $config->{verbose}, $config->{LOG}, 4);
36    my @cd_to_test;
37    if (!$special) {
38        if (defined $size->{optimize_space}{disc}{$cdnum} && $gain > $size->{optimize_space}{disc}{$cdnum}) {
39            log_("WARNING optimize_space: last time only get $size->{optimize_space}{disc}{$cdnum} on disc $cdnum, does not try again\n", $config->{verbose}, $config->{LOG}, 4);
40            return 0 
41        }
42        log_("optimize_space: previously manage to gain $size->{optimize_space}{disc}{$cdnum} on disc $cdnum\n", $config->{verbose}, $config->{LOG}, 2) if defined $size->{optimize_space}{disc}{$cdnum};
43        my $maxSpace; 
44        for (my $i; $i < @$cdsize; $i++) {
45            $cdlists->{$i} or next;
46            $groups->[$grp]{disc_impacted}{$i} or next;
47            my $space = $cdsize->[$i] - $size->{disc}[$i];
48            push @cd_to_test, [ $i, $space ];
49            $maxSpace += $space
50        }
51        $maxSpace -= $all_rpmsize;
52        if ($maxSpace < $gain) { log_("WARNING optimize_space: could not get $gain on disc $cdnum (only $maxSpace available)\n", $config->{verbose}, $config->{LOG}, 4); return 0 }
53        else { log_("optimize_space: $maxSpace available, try to move packages to get $gain free space on disc $cdnum\n", $config->{verbose}, $config->{LOG}, 4) }
54    }
55    my $realgain = 0;
56    my @cd_sorted = sort { $b->[1] <=> $a->[1] } @cd_to_test;
57    my ($local_diff, $local_size, $local_done, @to_reject);
58    my $check_diff_deps = sub {
59        my ($rpms, $deps_rpms, $rep_num, $g) = @_;
60        my @rpmsd;
61        log_("optimize_space check_diff_deps\n", $config->{verbose}, $config->{LOG}, 4);
62        foreach (@$deps_rpms) { push @rpmsd, @{$_->[6]} if $_->[6] }
63        my $deps = get_pkgs_deps(\@rpmsd, $groups->[$g]);
64        my %deps;
65        foreach my $d_ids (@$deps) { if (ref $d_ids) { foreach (@$d_ids) { $deps{alt}{$_} = $d_ids } } else { $deps{std}{$_} = 1 } }
66        foreach my $d (@$rpms) {
67            # log_("optimize_space check_diff_deps: data $d\n", $config->{verbose}, $config->{LOG});
68            foreach my $data (@{$d->[5]}) {
69                my $rpm = $data->[0];
70                # log_("optimize_space check_diff_deps: $rpm ($groups->[$g]{urpm}{rpm}{$rpm})\n", $config->{verbose}, $config->{LOG});
71                my $id = $groups->[$g]{urpm}{rpm}{$rpm}->id;
72                if ($deps{std}{$id}) {
73                    log_("optimize_space check_diff_deps: $rpm depends on these packages\n", $config->{verbose}, $config->{LOG}, 5);
74                    return 0
75                } elsif ($deps{alt}{$id}) {
76                    log_("optimize_space check_diff_deps: $rpm depends on these packages as alternatives, trying to find another alternative\n", $config->{verbose}, $config->{LOG}, 5);
77                    my $n_pres = 1;
78                    foreach (@{$deps{alt}{$id}}) {
79                        my $alt_rpm = $groups->[$g]{depslistid}[$_];
80                        if ($local_done->[$g]{rep}{$alt_rpm} <= $rep_num) {
81                            $n_pres = 0
82                        }
83                    }
84                    return 0 if $n_pres
85                }
86            }
87        }
88        1
89    };
90    my $check_previous_deps = sub {
91        my ($rpms1, $rpms2, $g, $src_rep, $dest_rep) = @_;
92        log_("optimize_space check_previous_deps: rpms1 $rpms1 rpms2 $rpms2 g $g src_rep $src_rep dest_rep $dest_rep\n", $config->{verbose}, $config->{LOG}, 6);
93        my ($src, $dest);
94        if ($src_rep > $dest_rep) {
95            $src = $src_rep;
96            $dest = $dest_rep;
97        } elsif ($src_rep < $dest_rep) {
98            $dest = $src_rep;
99            $src = $dest_rep;
100        } else {
101            return 1;
102        }
103        if ($src > $dest + 1) {
104            foreach my $rep ($dest+1 .. $src-1) {
105                foreach (@{$local_diff->{idx}}) {
106                    my $d = $local_diff->{data}[$_];
107                    push @$rpms1, $d if $d->[3] == $rep
108                }
109            }
110        }
111        return $check_diff_deps->($rpms2, $rpms1, $dest, $g);
112    };
113    my $exchange = sub {
114        my ($elt, $src_cd, $src_rep, $cd, $rep, $dest_curdir, $idx, $tot_size, $group, $l) = @_;
115        my $rpms;
116        foreach (@{$elt->[5]}) { 
117            $local_done->[$group]{list}{$_->[0]} = $l; 
118            $local_done->[$group]{rep}{$_->[0]} = $rep; 
119            $rpms .= " $_->[0]" 
120        }
121        log_("optimize_space exchange: moving $rpms (grp $group list $l) from disc $src_cd rep $src_rep to disc $cd rep $rep\n", $config->{verbose}, $config->{LOG}, 5);
122        # TODO data is not duplicated, must check to see if this is a pb
123        my @new_elt = @$elt;
124        $new_elt[0] = $dest_curdir;
125        $new_elt[3] = $rep;
126        my $b_idx = push @{$local_diff->{data}}, \@new_elt;
127        $local_diff->{idx}[$idx] = $b_idx-1;
128        $local_size->{disc}[$src_cd] -= $tot_size;
129        my $src_repname = $groups->[$group]{replist}{srpm}[$src_rep-1][1];
130        $local_size->{rep}{$src_cd}{$src_repname}{$l} -= $tot_size;
131        $local_size->{disc}[$cd] += $tot_size;
132        my $dest_repname = $groups->[$group]{replist}{srpm}[$rep-1][1];
133        $local_size->{rep}{$cd}{$dest_repname}{$l} += $tot_size;
134        log_("optimize_space exchange: moving $rpms (grp $group list $l) from disc $src_cd rep $src_rep (size $local_size->{disc}[$src_cd]) to disc $cd rep $rep (size $local_size->{disc}[$cd])\n", $config->{verbose}, $config->{LOG}, 5);
135        if ($src_cd == $cdnum) {
136            $realgain += $tot_size;
137            log_("optimize_space exchange: current gain $realgain\n", $config->{verbose}, $config->{LOG}, 5);
138            if ($realgain > $gain) { goto optimize_space_ok }
139        } elsif ($cd == $cdnum) {
140            $realgain -= $tot_size;
141            log_("optimize_space exchange: current gain $realgain\n", $config->{verbose}, $config->{LOG}, 5);
142        }
143        1
144    };
145    my $delete = sub {
146        my ($elt, $src_cd, $src_rep, $idx, $tot_size, $group, $l) = @_;
147        my $rpms;
148        # FIXME must test no_src_fit mod
149        foreach (@{$elt->[5]}) { 
150            $local_done->[$group]{rep}{$_->[0]} = 0; 
151            $local_done->[$group]{list}{$_->[0]} = 0; 
152            $to_reject[$group]{$_->[2]}{$_->[0]}{no_space} = 1;
153            $rpms .= " $_->[0]" }
154        # remove entry
155        for (my $i = $idx; $i < @{$local_diff->{idx}} - 1; $i++) {
156            $local_diff->{idx}[$i] = $local_diff->{idx}[$i+1];
157        }
158        pop @{$local_diff->{idx}};
159        log_("optimize_space delete: new diff size " . (int @{$local_diff->{idx}}) . "\n", $config->{verbose}, $config->{LOG});
160        $local_size->{disc}[$src_cd] -= $tot_size;
161        log_("optimize_space delete: deleting idx $idx packages $rpms (grp $group list $l) from disc $src_cd rep $src_rep (disc $src_cd size $local_size->{disc}[$src_cd])\n", $config->{verbose}, $config->{LOG});
162        my $src_repname = $groups->[$group]{replist}{srpm}[$src_rep-1][1];
163        $local_size->{rep}{$src_cd}{$src_repname}{$l} -= $tot_size;
164        if ($src_cd == $cdnum) {
165            $realgain += $tot_size;
166            log_("optimize_space delete: current gain $realgain\n", $config->{verbose}, $config->{LOG}, 5);
167            if ($realgain > $gain) { goto optimize_space_ok }
168        }
169        1
170    };
171    my $delete_and_check = sub {
172        my ($to_del_d, $i, $type, $prev) = @_;
173        my ($group, $list) = ($to_del_d->[1], $to_del_d->[2]);
174        my ($dn, $needed);
175        my @pkg_to_del;
176        my ($bin_d, $j, $bin_dcd, $bin_d_curdir, $bin_drepnum, $bin_dsize);
177        for ($j = $i; $j >= 0; $j--) {
178            $bin_d = $local_diff->{data}[$local_diff->{idx}[$j]];
179            ($bin_d_curdir, undef, undef, $bin_drepnum) = @$bin_d;
180            ($bin_dcd) = @$bin_d_curdir;
181            $bin_dsize = $bin_d->[7];
182            ($bin_d->[4] == 1 || $config->{nosrcfit} || $config->{nosrc} || $groups->[$group]{options}{nosrcfit}) and last;
183            my $bin_srpms;
184            foreach (@{$bin_d->[5]}) { $bin_srpms .= " $_->[0]" }
185            log_("optimize_space delete_and_check: strict source mode, deleting also srpms $bin_srpms associated from disc $bin_dcd\n", $config->{verbose}, $config->{LOG}, 5);
186            push @pkg_to_del, [$bin_d, $bin_dcd, $bin_drepnum, $j, $bin_dsize, $bin_d->[1], $bin_d->[2]]
187        }
188        log_("optimize_space delete_and_check: deleting rpms from disc $bin_dcd\n", $config->{verbose}, $config->{LOG}, 5);
189        push @pkg_to_del, [$bin_d, $bin_dcd, $bin_drepnum, $j, $bin_dsize, $bin_d->[1], $bin_d->[2]];
190
191        my $ok = 1;
192        foreach my $pkg (@pkg_to_del) {
193            my ($d, $dcd, $drepnum, $i, $dsize, $g, $l) = @$pkg;
194            if ($d->[1] != $group || $d->[2] != $list) {
195                log_("ERROR optimize_space delete_and_check: this must not happen, in strict source mode sources must follow rpms in diff indexes (group $bin_d->[1] list $bin_d->[1] instead of group $g list $l)\n", $config->{verbose}, $config->{LOG}, 4);
196                $ok = 0;
197            }
198            if ($d->[4] == 1) {
199                foreach (@{$d->[5]}) {
200                    if ($_->[2][1]{force} || $_->[2][1]{needed} || $_->[2][1]{done}) {
201                        $needed = 1;
202                        log_("optimize_space delete_and_check: could not delete $_->[0] needed $_->[2][1]{needed} ($drepnum)\n", $config->{verbose}, $config->{LOG}, 5);
203                        last
204                    }
205                }
206                if ($needed || @$prev && !$check_diff_deps->($prev, [$d], $drepnum, $g)) {
207                    push @$prev, $d;
208                    $ok = 0;
209                }
210            }
211        }
212        my $mid = @pkg_to_del;
213        if ($ok) {
214            foreach my $pkg (@pkg_to_del) {
215                my ($d, $dcd, $drepnum, $i, $dsize, $g, $l) = @$pkg;
216                $delete->($d, $dcd, $drepnum, $i, $dsize, $g, $l);
217            }
218            return $mid, $mid
219        }
220        return 0, $mid
221    };
222
223    my $move_bin = sub {
224            my ($g, $l, $special, $reverse) = @_;
225            $special && $reverse and return 0;
226            my @test;
227            my @ordered_bin_list_rep = sort { $reverse ? $a->[2] <=> $b->[2] : $b->[2] <=> $a->[2] } grep { $_->[3]{$l} } @{$groups->[$g]{replist}{rpm}};
228        my $dn;
229        my $pdn = -1;
230        my $spec = $special;
231        log_("optimize_space: moving binaries from group $g list $l (reverse $reverse)\n", $config->{verbose}, $config->{LOG}, 5);
232        while ($dn > $pdn) {
233            move_bin_while:
234            $pdn = $dn;
235            for (my $bin_idx; $bin_idx < $#ordered_bin_list_rep; $bin_idx++) {
236                my @bin_r = @{$ordered_bin_list_rep[$bin_idx]};
237                my @src_bin_r = @{$ordered_bin_list_rep[$bin_idx+1]};
238
239                my ($bin_cd, undef, $bin_num, $hashlist) = @bin_r;
240                next if $bin_cd == $cdnum;
241                my ($src_bin_cd, undef, $src_bin_num) = @src_bin_r;
242                my @next_src_bin_r;
243                my ($next_src_bin_cd, $next_src_bin_num);
244                if ($bin_idx+2 < @ordered_bin_list_rep) {
245                    @next_src_bin_r = @{$ordered_bin_list_rep[$bin_idx+2]};
246                    ($next_src_bin_cd, undef, $next_src_bin_num) = @src_bin_r;
247                }
248                next if $bin_cd == $src_bin_cd;
249                my $end;
250                log_("optimize_space: try to move binaries from disc $src_bin_cd rep $src_bin_num to disc $bin_cd rep $bin_num (spec $spec)\n", $config->{verbose}, $config->{LOG}, 5);
251                my ($a, $b, $c) = $reverse ? (0, @{$local_diff->{idx}},1) : ($#{$local_diff->{idx}},0, -1);
252                my $next_first_size;
253                if (!$spec && $next_src_bin_num) {
254                    my $next_d;
255                    my $next_idx;
256                    for ($next_idx = $a; $c*$next_idx <= $b; $next_idx += $c) {
257                        $next_d = $local_diff->{data}[$local_diff->{idx}[$next_idx]];
258                        ($next_d->[1] == $g && $next_d->[2] == $l && $next_d->[4] == 1 && $next_d->[3] == $next_src_bin_num) and last;
259                    }
260                    $next_first_size = $next_d->[7];
261                    log_("optimize_space: next to move will be id $next_idx size $next_first_size on disc $next_src_bin_cd rep $next_src_bin_num\n", $config->{verbose}, $config->{LOG}, 5);
262                    my $cd_space;
263                    if ($next_d->[0][2]{limit}) {
264                        log_("optimize_space: rep limit mode for srpm rep $src_bin_cd/$src_bin_num\n", $config->{verbose}, $config->{LOG}, 6);
265                        $cd_space = $next_d->[0][2]{limit}{size} - $local_size->{rep}{$src_bin_cd}{$next_d->[0][1]}{$l}
266                    } else {
267                        $cd_space = $cdsize->[$src_bin_cd] - $local_size->{disc}[$src_bin_cd]
268                    }
269                    if ($next_first_size < $cd_space) {
270                        log_("optimize_space: no need to move from disc $src_bin_cd rep $src_bin_num, trying next\n", $config->{verbose}, $config->{LOG}, 5);
271                        next
272                    }
273                }
274                my (@previous, $check, $d);
275                my $rep_diff = abs($src_bin_num - $bin_num);
276                foreach my $mode (0,1) {
277                    for (my $idx = $a; $c*$idx <= $b; $idx += $c) {
278                        my $d = $local_diff->{data}[$local_diff->{idx}[$idx]];
279                        ($d->[1] == $g && $d->[2] == $l && $d->[4] == 1 && $d->[3] == $src_bin_num) or next;
280                        my $curdir = $d->[0];
281                        my $first_size = $d->[7];
282                        if ($spec) {
283                            log_("optimize_space: try to delete rpms in rep $bin_num\n", $config->{verbose}, $config->{LOG}, 5);
284                            foreach my $del_mode (0,1) {
285                                my ($to_del_idx, $to_del_d, @prev, $to_del_l);
286                                for ($to_del_idx = $#{$local_diff->{idx}}; $to_del_idx >= 0; $to_del_idx--) {
287                                    $to_del_d = $local_diff->{data}[$local_diff->{idx}[$to_del_idx]];
288       
289                                    my $del_bin_cd = $local_diff->{data}[$local_diff->{idx}[$to_del_idx]][0][0];
290
291                                    if (!$to_del_d->[5]) {
292                                        log_("ERROR optimize_space move_bin: this must not happen, idx $to_del_idx is null in diff->{data} ($to_del_d)\n", $config->{verbose}, $config->{LOG}, 5); next
293                                    }
294                                    $to_del_d->[1] == $g or next;
295                                    if ($del_mode == 0 && $to_del_d->[2] != $l && $to_del_d->[4] == 1) {
296                                        push @prev, $to_del_d;
297                                        next
298                                    }
299                                    $spec = 0;
300                                    my ($nb, $mid) = $delete_and_check->($to_del_d, $to_del_idx, 'rpm', \@prev);
301                                    $to_del_idx -= $mid - 1;
302                                    $dn += $nb;
303                                    if ($idx >= $to_del_idx) {
304                                        $idx -= $nb
305                                    }
306                                    log_("optimize_space move_bin: first_size $first_size size_disc $local_size->{disc}[$bin_cd] cdsize $cdsize->[$bin_cd]\n", $config->{verbose}, $config->{LOG}, 5); next;
307                                    if ($curdir->[2]{limit}) {
308                                        log_("optimize_space: rep limit mode for rpm rep $bin_cd/$bin_num\n", $config->{verbose}, $config->{LOG}, 6);
309                                        goto move_bin_try_to_move if $first_size + $local_size->{rep}{$bin_cd}{$curdir->[1]}{$l} < $curdir->[2]{limit}{size};
310                                    } else {
311                                        goto move_bin_try_to_move if $first_size + $local_size->{disc}[$bin_cd] < $cdsize->[$bin_cd];
312                                    }
313                                    if ($to_del_d->[0][2]{limit}) {
314                                        log_("optimize_space: rep limit mode for rpm rep $del_bin_cd/$to_del_d->[3]\n", $config->{verbose}, $config->{LOG}, 6);
315                                        goto move_bin_while if $first_size < $to_del_d->[0][2]{limit}{size} - $local_size->{rep}{$del_bin_cd}{$to_del_d->[0][1]}{$l}
316                                    } else { 
317                                        goto move_bin_while if $first_size < $cdsize->[$del_bin_cd] - $local_size->{disc}[$del_bin_cd]
318                                    }
319                                }
320                            }
321                        }
322                        move_bin_try_to_move:
323                        my $av_space;
324                        # FIXME must be checked to validate generic limit option (soft option should be validated too)
325                        if ($curdir->[2]{limit}) {
326                            log_("optimize_space: rep limit mode for rpm rep $bin_cd/$bin_num\n", $config->{verbose}, $config->{LOG}, 6);
327                            $av_space = $curdir->[2]{limit}{size} - $local_size->{rep}{$bin_cd}{$curdir->[1]}{$l};
328                        } else {
329                            $av_space = $cdsize->[$bin_cd] - $local_size->{disc}[$bin_cd];
330                        }
331                        my $needed;
332                        foreach (@{$d->[5]}) {
333                            if ($_->[2][1]{needed} || $_->[2][1]{done}) {
334                                $needed = 1;
335                                log_("optimize_space: could not move $_->[0] needed $_->[2][1]{needed} ($bin_num)\n", $config->{verbose}, $config->{LOG}, 5);
336                                last
337                            }
338                        }
339                        if ($needed || ((@previous || $rep_diff > 1) && !$check_previous_deps->(\@previous, [$d], $g, $src_bin_num, $bin_num))) {
340                            push @previous, $d;
341                            next
342                        }
343                        if ($first_size < $av_space) {
344                            my $dest_curdir = $hashlist->{$l};
345                            $dn += $exchange->($d, $src_bin_cd, $src_bin_num, $bin_cd, $bin_num, $dest_curdir, $idx, $first_size, $g, $l);
346                            if ($curdir->[2]{limit}) { 
347                                log_("optimize_space: rep limit mode for rpm rep $src_bin_cd/$src_bin_num\n", $config->{verbose}, $config->{LOG}, 6);
348                                last if $next_first_size + $local_size->{rep}{$src_bin_cd}{$curdir->[1]}{$l} < $curdir->[2]{limit}{size}
349                            } else {
350                                last if $next_first_size + $local_size->{disc}[$src_bin_cd] < $cdsize->[$src_bin_cd]
351                            }
352                        } else {
353                            if ($mode == 0) {
354                                push @previous, $d
355                            } else { 
356                                if ($special && !$spec) {
357                                    $spec = $special;
358                                    goto move_bin_while
359                                }
360                                last
361                            }
362                        }
363                    }
364                }
365            }
366        }
367        $dn
368    };
369    my $try_to_move = sub {
370        my ($grp, $list, $type, $g, $l, $opti_mode, $cd, $special) = @_;
371        my $dn;
372        if ($opti_mode || $grp != $g || $list != $l) {
373            if ($groups->[$grp]{list_conflict}{$list}{$type}{$g}{$l}{rpm} && (!$cd || $groups->[$grp]{list_cd}{$list}{$cd})) {
374                $dn += $move_bin->($g, $l);
375            } else {
376                log_("optimize_space try_to_move: group $grp list $list type $type has no common disc with group $g list $l type rpm\n", $config->{verbose}, $config->{LOG}, 5);       
377            }
378        }
379        if ($groups->[$grp]{list_conflict}{$list}{$type}{$g}{$l}{srpm}) {
380            my $spec = 0;
381            foreach my $s_mode (0,1,2) { 
382                my $loop_gain = -1;
383                log_("optimize_space try_to_move: srpm mode $s_mode\n", $config->{verbose}, $config->{LOG}, 5); 
384                while ($realgain > $loop_gain) {
385                    move_src_while:
386                    $loop_gain = $realgain;
387                    my @max_size;
388                    my @prev;
389                    for (my $i = $#{$local_diff->{idx}}; $i >= 0; $i--) {
390                        my $d = $local_diff->{data}[$local_diff->{idx}[$i]];
391                        $d->[4] != 2 || $d->[1] != $g and next;
392                        my ($d_curdir, undef, undef, $drepnum, undef, $ddata) = @$d;
393                        my $dcd = $d_curdir->[0];
394                        if (!($spec || $s_mode == 2 || $dcd == $cdnum)) { next }
395                        my $dsize = $d->[7];
396                        if (!$s_mode && $dsize > (1.5 * ($gain - $realgain))) { next }
397                        if ($max_size[$drepnum]) {
398                            next if $dsize > $max_size[$drepnum]
399                        }
400                        my $srpms;
401                        foreach (@$ddata) { $srpms .= " $_->[0]" }
402                        log_("optimize_space: trying to move $srpms (size $dsize) from disc $dcd srpm rep $drepnum\n", $config->{verbose}, $config->{LOG}, 5);
403                        foreach (@{$groups->[$g]{replist}{srpm}}) {
404                            # log_("optimize_space: test $_ group $g list $l", $config->{verbose}, $config->{LOG}, 5);
405                            log_(" $_->[3] - $_->[3]{$l}\n", $config->{verbose}, $config->{LOG}, 5);
406                        }
407                        my @ordered_src_list_rep = sort { $a->[2] <=> $b->[2] } grep { ref $_->[3] && $_->[3]{$l} } @{$groups->[$g]{replist}{srpm}};
408                        my $test_dn = $dn;
409                        for (my $k=0; $k < @ordered_src_list_rep; $k++) {
410                            my ($dest_cd, $dest_repname, $dest_repnum, $hash_list) = @{$ordered_src_list_rep[$k]};
411                            log_("optimize_space: trying disc $dest_cd srpm rep $dest_repnum\n", $config->{verbose}, $config->{LOG}, 5);
412                            $dest_repnum == $drepnum and next;
413                            $dest_cd == $cdnum and next;
414                            my $dest_curdir = $hash_list->{$l};
415                            log_("optimize_space: trying disc $dest_cd srpm rep $dest_repnum\n", $config->{verbose}, $config->{LOG}, 5);
416                            my $cd_space;
417                            if ($dest_curdir->[2]{limit}) {
418                                log_("optimize_space: rep limit mode for srpm rep $dest_cd/$dest_repnum ($dest_curdir->[2]{limit}{size} - $local_size->{rep}{$dest_cd}{$dest_curdir->[1]}{$l})\n", $config->{verbose}, $config->{LOG}, 6);
419                                $cd_space = $dest_curdir->[2]{limit}{size} - $local_size->{rep}{$dest_cd}{$dest_curdir->[1]}{$l}
420                            } else {
421                                $cd_space = $cdsize->[$dest_cd] - $local_size->{disc}[$dest_cd]
422                            }
423                            if ($d->[2] == $l && $dsize <= $cd_space) {
424                                log_("optimize_space: moving srpm $srpms from disc $dcd to disc $dest_cd\n", $config->{verbose}, $config->{LOG}, 5);
425                                $dn += $exchange->($d, $dcd, $drepnum, $dest_cd, $dest_repnum, $dest_curdir, $i, $dsize, $g, $l);
426                                goto move_src_while if $cdnum == $dcd;
427                                #$dn += $move_bin->($g, $l) if (!$cd || $groups->[$grp]{list_cd}{$list}{$cd}) && $groups->[$grp]{list_conflict}{$list}{$type}{$g}{$l}{rpm} && $groups->[$g]{list_conflict}{$l}{srpm}{$g}{$l}{rpm};
428                                $realgain > $loop_gain ? last : goto try_to_move_end
429                            } elsif (!$spec && $special) {
430                                $spec = 1;
431                                goto move_src_while
432                            } elsif ($special) {
433                                log_("optimize_space: deleting srpm $srpms from disc $dcd\n", $config->{verbose}, $config->{LOG}, 5);
434                                my ($nb, $mid) += $delete_and_check->($d, $i, 'srpm', \@prev);
435                                $i -= $mid - 1;
436                                $dn += $nb;
437                                next if $cdnum == $dcd;
438                                $spec = 0; 
439                                #$dn += $move_bin->($g, $l) if (!$cd || $groups->[$grp]{list_cd}{$list}{$cd}) && $groups->[$grp]{list_conflict}{$list}{$type}{$g}{$l}{rpm} && $groups->[$g]{list_conflict}{$l}{srpm}{$g}{$l}{rpm};
440                                $realgain > $loop_gain ? last : goto try_to_move_end
441                            }
442                        }
443                        $max_size[$drepnum] = $dsize if $dn == $test_dn
444                    }
445                }
446            }
447        } else {
448            log_("optimize_space: group $grp list $list type $type has no common disc with group $g list $l type srpm\n", $config->{verbose}, $config->{LOG}, 5);       
449        }
450        if ($special && $groups->[$g]{disc_impacted}{$cdnum}) {
451            $dn += $move_bin->($g, $l,1);
452        }
453        try_to_move_end:
454        $dn
455    };
456    my $opti = sub {
457        my ($grp, $list, $type, $cd, $opti_mode, $special) = @_;
458        my $i;
459        $i++;
460        log_("optimize_space: main loop $i (special $special)\n", $config->{verbose}, $config->{LOG}, 5);
461        if (!$cd || $groups->[$grp]{list_cd}{$list}{$cd}) { $try_to_move->($grp, $list, $type, $grp, $list, $opti_mode, $cd, $special) }
462        foreach my $g (0 .. $#{$groups}) {
463            foreach my $l (keys %{$groups->[$g]{list}}) {
464                if (!$l) { log_("ERROR optimize_space: list 0 must not be defined\n", $config->{verbose}, $config->{LOG}, 2); next }
465                if ($cd || $groups->[$grp]{list_cd}{$list}{$cd}) { 
466                    $try_to_move->($grp, $list, $type, $g, $l, $opti_mode, $cd, $special)
467                }
468            }
469        }
470    };   
471
472    my $local_copy = sub {
473        my ($diff, $size) = @_;
474        my ($local_diff, $local_size, $local_done) = ({}, {}, []);
475        $local_diff->{idx} = [ @{$diff->{idx}} ];
476        for (my $i = 0; $i < @{$diff->{data}}; $i++) {
477            $local_diff->{data}[$i] = [ @{$diff->{data}[$i]} ] if ref $diff->{data}[$i]
478        }
479        for (my $group; $group < @$groups; $group++) {
480            foreach (keys %{$groups->[$group]{done}{rep}}) {
481                $local_done->[$group]{rep}{$_} = $groups->[$group]{done}{rep}{$_};
482                $local_done->[$group]{list}{$_} = $groups->[$group]{done}{list}{$_}
483            }
484        }
485        $local_size->{disc} = [ @{$size->{disc}} ];
486        foreach my $cd (keys %{$size->{rep}}) {
487            foreach my $rep (keys %{$size->{rep}{$cd}}) {
488                foreach my $list (keys %{$size->{rep}{$cd}{$rep}}) {
489                    log_("optimize_space: local_copy {$cd}{$rep}{$list} -> $size->{rep}{$cd}{$rep}{$list}\n", $config->{verbose}, $config->{LOG}, 6);
490                    $local_size->{rep}{$cd}{$rep}{$list} = $size->{rep}{$cd}{$rep}{$list}
491                }
492            }
493        }
494        ($local_diff, $local_size, $local_done)
495    };
496
497    my $do_it = sub {
498        my ($local_diff, $local_size, $diff, $size) = @_;
499        log_("optimize_space do_it: apply changes\n", $config->{verbose}, $config->{LOG}, 6);
500        $diff->{idx} = $local_diff->{idx};
501        $diff->{data} = $local_diff->{data};
502        $size->{disc} = $local_size->{disc};
503        $size->{rep} = $local_size->{rep};
504        for (my $group; $group < @$local_done; $group++) {
505            $groups->[$group]{done} = $local_done->[$group]
506        }
507        for (my $g; $g < @to_reject; $g++) {
508            foreach my $list (keys %{$to_reject[$g]}) {
509                foreach my $rpm (keys %{$to_reject[$g]{$list}}) {
510                    foreach (keys %{$to_reject[$g]{$list}{$rpm}}) {
511                        push @{$groups->[$g]{rejected}{$list}{$rpm}}, [ $_, 'optimize_space' ]
512                    }
513                }
514            }
515        }
516    };
517
518    ($local_diff, $local_size, $local_done) = $local_copy->($diff, $size);
519    foreach my $opti_mode (0,1) {
520        my $dn = 1;
521        while ($dn) {
522            $dn = 0;
523            foreach my $cd_d (@cd_sorted, [0]) {
524                my ($cd) = @$cd_d;
525                log_("optimize_space: cd @$cd_d\n", $config->{verbose}, $config->{LOG}, 6);
526
527                if (defined $grp && defined $list) {
528                    my @type_o = $type eq 'rpm' ? ('rpm', 'srpm') : ('srpm', 'rpm');
529                    foreach my $t (@type_o) { $dn = $opti->($grp, $list, $t, $cd, $opti_mode) }
530                    if ($special) { foreach my $t (@type_o) { $dn = $opti->($grp, $list, $t, $cd, $opti_mode, 1) } }
531                } else {
532                    foreach my $s (0 .. $special) {
533                        foreach my $grp (keys %{$config->{disc}[$cdnum]{group_list}}) {
534                            foreach my $lst (keys %{$config->{disc}[$cdnum]{group_list}{$grp}}) {
535                                if (!$lst) { log_("ERROR optimize_space: list 0 must not be defined\n", $config->{verbose}, $config->{LOG}, 2); next }
536                                foreach my $type (keys %{$config->{disc}[$cdnum]{group_list}{$grp}{$lst}}) {
537                                    $dn = $opti->($grp, $lst, $type, $special)
538                                }
539                                $dn and goto try_another_time
540                            }
541                        }
542                    }
543                }
544            }
545            try_another_time:
546            @cd_to_test = ();
547            for (my $i; $i < @$cdsize; $i++) {
548                $cdlists->{$i} or next;
549                $groups->[$grp]{disc_impacted}{$i} or next;
550                push @cd_to_test, [ $i, $cdsize->[$i] - $local_size->{disc}[$i] ]
551            }
552        }
553    }
554   
555optimize_space_ok:
556    log_("optimize_space: manage to gain $realgain\n", $config->{verbose}, $config->{LOG}, 2);
557    if ($realgain < $gain) {
558        log_("optimize_space: setting max gain for disc $cdnum to $realgain\n", $config->{verbose}, $config->{LOG}, 2);
559        $size->{optimize_space}{disc}{$cdnum} = $realgain
560    } else {
561        $do_it->($local_diff, $local_size, $diff, $size)
562    }
563    return $realgain
564}
565
566sub get_pkgs_deps {
567    my ($rpmd, $group) = @_;
568    my (@tdeps, %curID);
569    foreach (@$rpmd) {
570        my $rpm = $_->[0];
571        $curID{$group->{urpm}{rpm}{$rpm}->id} = 1;
572        $_->[1]{nodeps} and next;
573        $group->{pkgdeps}{$rpm} and push @tdeps, @{$group->{pkgdeps}{$rpm}}
574    }
575    my (@deps, %depsdone);
576    foreach (@tdeps) {
577        if (ref $_) {
578            my @toadd;
579            my $key = join '|', @$_;
580            $depsdone{$key}++ and next;
581            # We could not just remove the $deps inside the foreach loop
582            # otherwize one alternative deps could be removed but not the other, and
583            # this could lead to package rejected for ordering reasons although they should not
584            # As a consequence two foreach loops are needed
585            my $ok;
586            $ok ||= $depsdone{$_} foreach @$_;
587            $ok and next;
588            foreach my $d (@$_) {
589                if ($curID{$d}) { @toadd = (); last }
590                push @toadd, $d
591            }
592            @toadd and push @deps, \@toadd
593        } elsif (!$curID{$_}) {
594            $depsdone{$_}++ and next;
595            push @deps, $_
596        }
597    }
598    return \@deps
599}
600
601sub print_conflict_matrix {
602    my ($groups) = @_;
603    print "print_listcd_matrix\n";
604    for (my $i = 0; $i < @$groups; $i++) {
605        ref $groups->[$i]{list_cd} or next;
606        print "Group $i\n";
607        foreach my $list (keys %{$groups->[$i]{list_cd}}) {
608            ref $groups->[$i]{list_cd}{$list} or next;
609            print "Group $i list $list\n";
610            foreach my $cd (keys %{$groups->[$i]{list_cd}{$list}}) {
611                ref $groups->[$i]{list_cd}{$list}{$cd} or next;
612                print "Group $i list $list cd $cd\n";
613                foreach my $type (keys %{$groups->[$i]{list_cd}{$list}{$cd}}) {
614                    ref $groups->[$i]{list_cd}{$list}{$cd}{$type} or next;
615                    print "Group $i list $list cd $cd type $type -> @{$groups->[$i]{list_cd}{$list}{$cd}{$type}}\n"
616                }
617            }
618        }
619    }
620    print "print_conflict_matrix\n";
621    for (my $i = 0; $i < @$groups; $i++) {
622        ref $groups->[$i]{list_conflict} or next;
623        #print "Group $i\n";
624        foreach my $list (keys %{$groups->[$i]{list_conflict}}) {
625            ref $groups->[$i]{list_conflict}{$list} or next;
626            #print "Group $i list $list\n";
627            foreach my $type (keys %{$groups->[$i]{list_conflict}{$list}}) {
628                ref $groups->[$i]{list_conflict}{$list}{$type} or next;
629                #print "Group $i list $list type $type\n";
630                foreach my $group (keys %{$groups->[$i]{list_conflict}{$list}{$type}}) {
631                    ref $groups->[$i]{list_conflict}{$list}{$type}{$group} or next;
632                    #print "Group $i list $list type $type group $group\n";
633                    foreach my $list_2 (keys %{$groups->[$i]{list_conflict}{$list}{$type}{$group}}) {
634                        ref $groups->[$i]{list_conflict}{$list}{$type}{$group}{$list_2} or next;
635                        #print "Group $i list $list type $type group $group list $list_2\n";
636                        foreach my $type (keys %{$groups->[$i]{list_conflict}{$list}{$type}{$group}{$list_2}}) {
637                            print "Group $i list $list type $type group $group list $list_2 type $type -> $groups->[$i]{list_conflict}{$list}{$type}{$group}{$list_2}{$type}\n"
638                        }
639                    }
640                }
641            }
642        }
643    }
644       
645
646}
Note: See TracBrowser for help on using the repository browser.