# # Copyright (C) 2000,2001,2002,2003,2004 Mandrakesoft # # Author: Florent Villard # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # to prepare, create and burn iso images # package Mkcd::Optimize; my $VERSION = '0.0.2'; use strict; use Mkcd::Tools qw(log_); our @ISA = qw(Exporter); our @EXPORT = qw(optimize_space get_pkgs_deps print_conflict_matrix ); sub optimize_space { my ($config, $groups, $diff, $size, $cdsize, $cdnum, $gain, $cdlists, $special, $grp, $list, $type, $all_rpmsize) = @_; $config->{optimize_space} or return 0; log_("optimize_space: cdnum $cdnum gain $gain cdlists $cdlists grp $grp list $list\n", $config->{verbose}, $config->{LOG}, 4); my @cd_to_test; if (!$special) { if (defined $size->{optimize_space}{disc}{$cdnum} && $gain > $size->{optimize_space}{disc}{$cdnum}) { 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); return 0 } 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}; my $maxSpace; for (my $i; $i < @$cdsize; $i++) { $cdlists->{$i} or next; $groups->[$grp]{disc_impacted}{$i} or next; my $space = $cdsize->[$i] - $size->{disc}[$i]; push @cd_to_test, [ $i, $space ]; $maxSpace += $space } $maxSpace -= $all_rpmsize; 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 } else { log_("optimize_space: $maxSpace available, try to move packages to get $gain free space on disc $cdnum\n", $config->{verbose}, $config->{LOG}, 4) } } my $realgain = 0; my @cd_sorted = sort { $b->[1] <=> $a->[1] } @cd_to_test; my ($local_diff, $local_size, $local_done, @to_reject); my $check_diff_deps = sub { my ($rpms, $deps_rpms, $rep_num, $g) = @_; my @rpmsd; log_("optimize_space check_diff_deps\n", $config->{verbose}, $config->{LOG}, 4); foreach (@$deps_rpms) { push @rpmsd, @{$_->[6]} if $_->[6] } my $deps = get_pkgs_deps(\@rpmsd, $groups->[$g]); my %deps; foreach my $d_ids (@$deps) { if (ref $d_ids) { foreach (@$d_ids) { $deps{alt}{$_} = $d_ids } } else { $deps{std}{$_} = 1 } } foreach my $d (@$rpms) { # log_("optimize_space check_diff_deps: data $d\n", $config->{verbose}, $config->{LOG}); foreach my $data (@{$d->[5]}) { my $rpm = $data->[0]; # log_("optimize_space check_diff_deps: $rpm ($groups->[$g]{urpm}{rpm}{$rpm})\n", $config->{verbose}, $config->{LOG}); my $id = $groups->[$g]{urpm}{rpm}{$rpm}->id; if ($deps{std}{$id}) { log_("optimize_space check_diff_deps: $rpm depends on these packages\n", $config->{verbose}, $config->{LOG}, 5); return 0 } elsif ($deps{alt}{$id}) { log_("optimize_space check_diff_deps: $rpm depends on these packages as alternatives, trying to find another alternative\n", $config->{verbose}, $config->{LOG}, 5); my $n_pres = 1; foreach (@{$deps{alt}{$id}}) { my $alt_rpm = $groups->[$g]{depslistid}[$_]; if ($local_done->[$g]{rep}{$alt_rpm} <= $rep_num) { $n_pres = 0 } } return 0 if $n_pres } } } 1 }; my $check_previous_deps = sub { my ($rpms1, $rpms2, $g, $src_rep, $dest_rep) = @_; 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); my ($src, $dest); if ($src_rep > $dest_rep) { $src = $src_rep; $dest = $dest_rep; } elsif ($src_rep < $dest_rep) { $dest = $src_rep; $src = $dest_rep; } else { return 1; } if ($src > $dest + 1) { foreach my $rep ($dest+1 .. $src-1) { foreach (@{$local_diff->{idx}}) { my $d = $local_diff->{data}[$_]; push @$rpms1, $d if $d->[3] == $rep } } } return $check_diff_deps->($rpms2, $rpms1, $dest, $g); }; my $exchange = sub { my ($elt, $src_cd, $src_rep, $cd, $rep, $dest_curdir, $idx, $tot_size, $group, $l) = @_; my $rpms; foreach (@{$elt->[5]}) { $local_done->[$group]{list}{$_->[0]} = $l; $local_done->[$group]{rep}{$_->[0]} = $rep; $rpms .= " $_->[0]" } 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); # TODO data is not duplicated, must check to see if this is a pb my @new_elt = @$elt; $new_elt[0] = $dest_curdir; $new_elt[3] = $rep; my $b_idx = push @{$local_diff->{data}}, \@new_elt; $local_diff->{idx}[$idx] = $b_idx-1; $local_size->{disc}[$src_cd] -= $tot_size; my $src_repname = $groups->[$group]{replist}{srpm}[$src_rep-1][1]; $local_size->{rep}{$src_cd}{$src_repname}{$l} -= $tot_size; $local_size->{disc}[$cd] += $tot_size; my $dest_repname = $groups->[$group]{replist}{srpm}[$rep-1][1]; $local_size->{rep}{$cd}{$dest_repname}{$l} += $tot_size; 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); if ($src_cd == $cdnum) { $realgain += $tot_size; log_("optimize_space exchange: current gain $realgain\n", $config->{verbose}, $config->{LOG}, 5); if ($realgain > $gain) { goto optimize_space_ok } } elsif ($cd == $cdnum) { $realgain -= $tot_size; log_("optimize_space exchange: current gain $realgain\n", $config->{verbose}, $config->{LOG}, 5); } 1 }; my $delete = sub { my ($elt, $src_cd, $src_rep, $idx, $tot_size, $group, $l) = @_; my $rpms; # FIXME must test no_src_fit mod foreach (@{$elt->[5]}) { $local_done->[$group]{rep}{$_->[0]} = 0; $local_done->[$group]{list}{$_->[0]} = 0; $to_reject[$group]{$_->[2]}{$_->[0]}{no_space} = 1; $rpms .= " $_->[0]" } # remove entry for (my $i = $idx; $i < @{$local_diff->{idx}} - 1; $i++) { $local_diff->{idx}[$i] = $local_diff->{idx}[$i+1]; } pop @{$local_diff->{idx}}; log_("optimize_space delete: new diff size " . (int @{$local_diff->{idx}}) . "\n", $config->{verbose}, $config->{LOG}); $local_size->{disc}[$src_cd] -= $tot_size; 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}); my $src_repname = $groups->[$group]{replist}{srpm}[$src_rep-1][1]; $local_size->{rep}{$src_cd}{$src_repname}{$l} -= $tot_size; if ($src_cd == $cdnum) { $realgain += $tot_size; log_("optimize_space delete: current gain $realgain\n", $config->{verbose}, $config->{LOG}, 5); if ($realgain > $gain) { goto optimize_space_ok } } 1 }; my $delete_and_check = sub { my ($to_del_d, $i, $type, $prev) = @_; my ($group, $list) = ($to_del_d->[1], $to_del_d->[2]); my ($dn, $needed); my @pkg_to_del; my ($bin_d, $j, $bin_dcd, $bin_d_curdir, $bin_drepnum, $bin_dsize); for ($j = $i; $j >= 0; $j--) { $bin_d = $local_diff->{data}[$local_diff->{idx}[$j]]; ($bin_d_curdir, undef, undef, $bin_drepnum) = @$bin_d; ($bin_dcd) = @$bin_d_curdir; $bin_dsize = $bin_d->[7]; ($bin_d->[4] == 1 || $config->{nosrcfit} || $config->{nosrc} || $groups->[$group]{options}{nosrcfit}) and last; my $bin_srpms; foreach (@{$bin_d->[5]}) { $bin_srpms .= " $_->[0]" } 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); push @pkg_to_del, [$bin_d, $bin_dcd, $bin_drepnum, $j, $bin_dsize, $bin_d->[1], $bin_d->[2]] } log_("optimize_space delete_and_check: deleting rpms from disc $bin_dcd\n", $config->{verbose}, $config->{LOG}, 5); push @pkg_to_del, [$bin_d, $bin_dcd, $bin_drepnum, $j, $bin_dsize, $bin_d->[1], $bin_d->[2]]; my $ok = 1; foreach my $pkg (@pkg_to_del) { my ($d, $dcd, $drepnum, $i, $dsize, $g, $l) = @$pkg; if ($d->[1] != $group || $d->[2] != $list) { 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); $ok = 0; } if ($d->[4] == 1) { foreach (@{$d->[5]}) { if ($_->[2][1]{force} || $_->[2][1]{needed} || $_->[2][1]{done}) { $needed = 1; log_("optimize_space delete_and_check: could not delete $_->[0] needed $_->[2][1]{needed} ($drepnum)\n", $config->{verbose}, $config->{LOG}, 5); last } } if ($needed || @$prev && !$check_diff_deps->($prev, [$d], $drepnum, $g)) { push @$prev, $d; $ok = 0; } } } my $mid = @pkg_to_del; if ($ok) { foreach my $pkg (@pkg_to_del) { my ($d, $dcd, $drepnum, $i, $dsize, $g, $l) = @$pkg; $delete->($d, $dcd, $drepnum, $i, $dsize, $g, $l); } return $mid, $mid } return 0, $mid }; my $move_bin = sub { my ($g, $l, $special, $reverse) = @_; $special && $reverse and return 0; my @test; my @ordered_bin_list_rep = sort { $reverse ? $a->[2] <=> $b->[2] : $b->[2] <=> $a->[2] } grep { $_->[3]{$l} } @{$groups->[$g]{replist}{rpm}}; my $dn; my $pdn = -1; my $spec = $special; log_("optimize_space: moving binaries from group $g list $l (reverse $reverse)\n", $config->{verbose}, $config->{LOG}, 5); while ($dn > $pdn) { move_bin_while: $pdn = $dn; for (my $bin_idx; $bin_idx < $#ordered_bin_list_rep; $bin_idx++) { my @bin_r = @{$ordered_bin_list_rep[$bin_idx]}; my @src_bin_r = @{$ordered_bin_list_rep[$bin_idx+1]}; my ($bin_cd, undef, $bin_num, $hashlist) = @bin_r; next if $bin_cd == $cdnum; my ($src_bin_cd, undef, $src_bin_num) = @src_bin_r; my @next_src_bin_r; my ($next_src_bin_cd, $next_src_bin_num); if ($bin_idx+2 < @ordered_bin_list_rep) { @next_src_bin_r = @{$ordered_bin_list_rep[$bin_idx+2]}; ($next_src_bin_cd, undef, $next_src_bin_num) = @src_bin_r; } next if $bin_cd == $src_bin_cd; my $end; 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); my ($a, $b, $c) = $reverse ? (0, @{$local_diff->{idx}},1) : ($#{$local_diff->{idx}},0, -1); my $next_first_size; if (!$spec && $next_src_bin_num) { my $next_d; my $next_idx; for ($next_idx = $a; $c*$next_idx <= $b; $next_idx += $c) { $next_d = $local_diff->{data}[$local_diff->{idx}[$next_idx]]; ($next_d->[1] == $g && $next_d->[2] == $l && $next_d->[4] == 1 && $next_d->[3] == $next_src_bin_num) and last; } $next_first_size = $next_d->[7]; 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); my $cd_space; if ($next_d->[0][2]{limit}) { log_("optimize_space: rep limit mode for srpm rep $src_bin_cd/$src_bin_num\n", $config->{verbose}, $config->{LOG}, 6); $cd_space = $next_d->[0][2]{limit}{size} - $local_size->{rep}{$src_bin_cd}{$next_d->[0][1]}{$l} } else { $cd_space = $cdsize->[$src_bin_cd] - $local_size->{disc}[$src_bin_cd] } if ($next_first_size < $cd_space) { log_("optimize_space: no need to move from disc $src_bin_cd rep $src_bin_num, trying next\n", $config->{verbose}, $config->{LOG}, 5); next } } my (@previous, $check, $d); my $rep_diff = abs($src_bin_num - $bin_num); foreach my $mode (0,1) { for (my $idx = $a; $c*$idx <= $b; $idx += $c) { my $d = $local_diff->{data}[$local_diff->{idx}[$idx]]; ($d->[1] == $g && $d->[2] == $l && $d->[4] == 1 && $d->[3] == $src_bin_num) or next; my $curdir = $d->[0]; my $first_size = $d->[7]; if ($spec) { log_("optimize_space: try to delete rpms in rep $bin_num\n", $config->{verbose}, $config->{LOG}, 5); foreach my $del_mode (0,1) { my ($to_del_idx, $to_del_d, @prev, $to_del_l); for ($to_del_idx = $#{$local_diff->{idx}}; $to_del_idx >= 0; $to_del_idx--) { $to_del_d = $local_diff->{data}[$local_diff->{idx}[$to_del_idx]]; my $del_bin_cd = $local_diff->{data}[$local_diff->{idx}[$to_del_idx]][0][0]; if (!$to_del_d->[5]) { 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 } $to_del_d->[1] == $g or next; if ($del_mode == 0 && $to_del_d->[2] != $l && $to_del_d->[4] == 1) { push @prev, $to_del_d; next } $spec = 0; my ($nb, $mid) = $delete_and_check->($to_del_d, $to_del_idx, 'rpm', \@prev); $to_del_idx -= $mid - 1; $dn += $nb; if ($idx >= $to_del_idx) { $idx -= $nb } 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; if ($curdir->[2]{limit}) { log_("optimize_space: rep limit mode for rpm rep $bin_cd/$bin_num\n", $config->{verbose}, $config->{LOG}, 6); goto move_bin_try_to_move if $first_size + $local_size->{rep}{$bin_cd}{$curdir->[1]}{$l} < $curdir->[2]{limit}{size}; } else { goto move_bin_try_to_move if $first_size + $local_size->{disc}[$bin_cd] < $cdsize->[$bin_cd]; } if ($to_del_d->[0][2]{limit}) { log_("optimize_space: rep limit mode for rpm rep $del_bin_cd/$to_del_d->[3]\n", $config->{verbose}, $config->{LOG}, 6); 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} } else { goto move_bin_while if $first_size < $cdsize->[$del_bin_cd] - $local_size->{disc}[$del_bin_cd] } } } } move_bin_try_to_move: my $av_space; # FIXME must be checked to validate generic limit option (soft option should be validated too) if ($curdir->[2]{limit}) { log_("optimize_space: rep limit mode for rpm rep $bin_cd/$bin_num\n", $config->{verbose}, $config->{LOG}, 6); $av_space = $curdir->[2]{limit}{size} - $local_size->{rep}{$bin_cd}{$curdir->[1]}{$l}; } else { $av_space = $cdsize->[$bin_cd] - $local_size->{disc}[$bin_cd]; } my $needed; foreach (@{$d->[5]}) { if ($_->[2][1]{needed} || $_->[2][1]{done}) { $needed = 1; log_("optimize_space: could not move $_->[0] needed $_->[2][1]{needed} ($bin_num)\n", $config->{verbose}, $config->{LOG}, 5); last } } if ($needed || ((@previous || $rep_diff > 1) && !$check_previous_deps->(\@previous, [$d], $g, $src_bin_num, $bin_num))) { push @previous, $d; next } if ($first_size < $av_space) { my $dest_curdir = $hashlist->{$l}; $dn += $exchange->($d, $src_bin_cd, $src_bin_num, $bin_cd, $bin_num, $dest_curdir, $idx, $first_size, $g, $l); if ($curdir->[2]{limit}) { log_("optimize_space: rep limit mode for rpm rep $src_bin_cd/$src_bin_num\n", $config->{verbose}, $config->{LOG}, 6); last if $next_first_size + $local_size->{rep}{$src_bin_cd}{$curdir->[1]}{$l} < $curdir->[2]{limit}{size} } else { last if $next_first_size + $local_size->{disc}[$src_bin_cd] < $cdsize->[$src_bin_cd] } } else { if ($mode == 0) { push @previous, $d } else { if ($special && !$spec) { $spec = $special; goto move_bin_while } last } } } } } } $dn }; my $try_to_move = sub { my ($grp, $list, $type, $g, $l, $opti_mode, $cd, $special) = @_; my $dn; if ($opti_mode || $grp != $g || $list != $l) { if ($groups->[$grp]{list_conflict}{$list}{$type}{$g}{$l}{rpm} && (!$cd || $groups->[$grp]{list_cd}{$list}{$cd})) { $dn += $move_bin->($g, $l); } else { 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); } } if ($groups->[$grp]{list_conflict}{$list}{$type}{$g}{$l}{srpm}) { my $spec = 0; foreach my $s_mode (0,1,2) { my $loop_gain = -1; log_("optimize_space try_to_move: srpm mode $s_mode\n", $config->{verbose}, $config->{LOG}, 5); while ($realgain > $loop_gain) { move_src_while: $loop_gain = $realgain; my @max_size; my @prev; for (my $i = $#{$local_diff->{idx}}; $i >= 0; $i--) { my $d = $local_diff->{data}[$local_diff->{idx}[$i]]; $d->[4] != 2 || $d->[1] != $g and next; my ($d_curdir, undef, undef, $drepnum, undef, $ddata) = @$d; my $dcd = $d_curdir->[0]; if (!($spec || $s_mode == 2 || $dcd == $cdnum)) { next } my $dsize = $d->[7]; if (!$s_mode && $dsize > (1.5 * ($gain - $realgain))) { next } if ($max_size[$drepnum]) { next if $dsize > $max_size[$drepnum] } my $srpms; foreach (@$ddata) { $srpms .= " $_->[0]" } log_("optimize_space: trying to move $srpms (size $dsize) from disc $dcd srpm rep $drepnum\n", $config->{verbose}, $config->{LOG}, 5); foreach (@{$groups->[$g]{replist}{srpm}}) { # log_("optimize_space: test $_ group $g list $l", $config->{verbose}, $config->{LOG}, 5); log_(" $_->[3] - $_->[3]{$l}\n", $config->{verbose}, $config->{LOG}, 5); } my @ordered_src_list_rep = sort { $a->[2] <=> $b->[2] } grep { ref $_->[3] && $_->[3]{$l} } @{$groups->[$g]{replist}{srpm}}; my $test_dn = $dn; for (my $k=0; $k < @ordered_src_list_rep; $k++) { my ($dest_cd, $dest_repname, $dest_repnum, $hash_list) = @{$ordered_src_list_rep[$k]}; log_("optimize_space: trying disc $dest_cd srpm rep $dest_repnum\n", $config->{verbose}, $config->{LOG}, 5); $dest_repnum == $drepnum and next; $dest_cd == $cdnum and next; my $dest_curdir = $hash_list->{$l}; log_("optimize_space: trying disc $dest_cd srpm rep $dest_repnum\n", $config->{verbose}, $config->{LOG}, 5); my $cd_space; if ($dest_curdir->[2]{limit}) { 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); $cd_space = $dest_curdir->[2]{limit}{size} - $local_size->{rep}{$dest_cd}{$dest_curdir->[1]}{$l} } else { $cd_space = $cdsize->[$dest_cd] - $local_size->{disc}[$dest_cd] } if ($d->[2] == $l && $dsize <= $cd_space) { log_("optimize_space: moving srpm $srpms from disc $dcd to disc $dest_cd\n", $config->{verbose}, $config->{LOG}, 5); $dn += $exchange->($d, $dcd, $drepnum, $dest_cd, $dest_repnum, $dest_curdir, $i, $dsize, $g, $l); goto move_src_while if $cdnum == $dcd; #$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}; $realgain > $loop_gain ? last : goto try_to_move_end } elsif (!$spec && $special) { $spec = 1; goto move_src_while } elsif ($special) { log_("optimize_space: deleting srpm $srpms from disc $dcd\n", $config->{verbose}, $config->{LOG}, 5); my ($nb, $mid) += $delete_and_check->($d, $i, 'srpm', \@prev); $i -= $mid - 1; $dn += $nb; next if $cdnum == $dcd; $spec = 0; #$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}; $realgain > $loop_gain ? last : goto try_to_move_end } } $max_size[$drepnum] = $dsize if $dn == $test_dn } } } } else { 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); } if ($special && $groups->[$g]{disc_impacted}{$cdnum}) { $dn += $move_bin->($g, $l,1); } try_to_move_end: $dn }; my $opti = sub { my ($grp, $list, $type, $cd, $opti_mode, $special) = @_; my $i; $i++; log_("optimize_space: main loop $i (special $special)\n", $config->{verbose}, $config->{LOG}, 5); if (!$cd || $groups->[$grp]{list_cd}{$list}{$cd}) { $try_to_move->($grp, $list, $type, $grp, $list, $opti_mode, $cd, $special) } foreach my $g (0 .. $#{$groups}) { foreach my $l (keys %{$groups->[$g]{list}}) { if (!$l) { log_("ERROR optimize_space: list 0 must not be defined\n", $config->{verbose}, $config->{LOG}, 2); next } if ($cd || $groups->[$grp]{list_cd}{$list}{$cd}) { $try_to_move->($grp, $list, $type, $g, $l, $opti_mode, $cd, $special) } } } }; my $local_copy = sub { my ($diff, $size) = @_; my ($local_diff, $local_size, $local_done) = ({}, {}, []); $local_diff->{idx} = [ @{$diff->{idx}} ]; for (my $i = 0; $i < @{$diff->{data}}; $i++) { $local_diff->{data}[$i] = [ @{$diff->{data}[$i]} ] if ref $diff->{data}[$i] } for (my $group; $group < @$groups; $group++) { foreach (keys %{$groups->[$group]{done}{rep}}) { $local_done->[$group]{rep}{$_} = $groups->[$group]{done}{rep}{$_}; $local_done->[$group]{list}{$_} = $groups->[$group]{done}{list}{$_} } } $local_size->{disc} = [ @{$size->{disc}} ]; foreach my $cd (keys %{$size->{rep}}) { foreach my $rep (keys %{$size->{rep}{$cd}}) { foreach my $list (keys %{$size->{rep}{$cd}{$rep}}) { log_("optimize_space: local_copy {$cd}{$rep}{$list} -> $size->{rep}{$cd}{$rep}{$list}\n", $config->{verbose}, $config->{LOG}, 6); $local_size->{rep}{$cd}{$rep}{$list} = $size->{rep}{$cd}{$rep}{$list} } } } ($local_diff, $local_size, $local_done) }; my $do_it = sub { my ($local_diff, $local_size, $diff, $size) = @_; log_("optimize_space do_it: apply changes\n", $config->{verbose}, $config->{LOG}, 6); $diff->{idx} = $local_diff->{idx}; $diff->{data} = $local_diff->{data}; $size->{disc} = $local_size->{disc}; $size->{rep} = $local_size->{rep}; for (my $group; $group < @$local_done; $group++) { $groups->[$group]{done} = $local_done->[$group] } for (my $g; $g < @to_reject; $g++) { foreach my $list (keys %{$to_reject[$g]}) { foreach my $rpm (keys %{$to_reject[$g]{$list}}) { foreach (keys %{$to_reject[$g]{$list}{$rpm}}) { push @{$groups->[$g]{rejected}{$list}{$rpm}}, [ $_, 'optimize_space' ] } } } } }; ($local_diff, $local_size, $local_done) = $local_copy->($diff, $size); foreach my $opti_mode (0,1) { my $dn = 1; while ($dn) { $dn = 0; foreach my $cd_d (@cd_sorted, [0]) { my ($cd) = @$cd_d; log_("optimize_space: cd @$cd_d\n", $config->{verbose}, $config->{LOG}, 6); if (defined $grp && defined $list) { my @type_o = $type eq 'rpm' ? ('rpm', 'srpm') : ('srpm', 'rpm'); foreach my $t (@type_o) { $dn = $opti->($grp, $list, $t, $cd, $opti_mode) } if ($special) { foreach my $t (@type_o) { $dn = $opti->($grp, $list, $t, $cd, $opti_mode, 1) } } } else { foreach my $s (0 .. $special) { foreach my $grp (keys %{$config->{disc}[$cdnum]{group_list}}) { foreach my $lst (keys %{$config->{disc}[$cdnum]{group_list}{$grp}}) { if (!$lst) { log_("ERROR optimize_space: list 0 must not be defined\n", $config->{verbose}, $config->{LOG}, 2); next } foreach my $type (keys %{$config->{disc}[$cdnum]{group_list}{$grp}{$lst}}) { $dn = $opti->($grp, $lst, $type, $special) } $dn and goto try_another_time } } } } } try_another_time: @cd_to_test = (); for (my $i; $i < @$cdsize; $i++) { $cdlists->{$i} or next; $groups->[$grp]{disc_impacted}{$i} or next; push @cd_to_test, [ $i, $cdsize->[$i] - $local_size->{disc}[$i] ] } } } optimize_space_ok: log_("optimize_space: manage to gain $realgain\n", $config->{verbose}, $config->{LOG}, 2); if ($realgain < $gain) { log_("optimize_space: setting max gain for disc $cdnum to $realgain\n", $config->{verbose}, $config->{LOG}, 2); $size->{optimize_space}{disc}{$cdnum} = $realgain } else { $do_it->($local_diff, $local_size, $diff, $size) } return $realgain } sub get_pkgs_deps { my ($rpmd, $group) = @_; my (@tdeps, %curID); foreach (@$rpmd) { my $rpm = $_->[0]; $curID{$group->{urpm}{rpm}{$rpm}->id} = 1; $_->[1]{nodeps} and next; $group->{pkgdeps}{$rpm} and push @tdeps, @{$group->{pkgdeps}{$rpm}} } my (@deps, %depsdone); foreach (@tdeps) { if (ref $_) { my @toadd; my $key = join '|', @$_; $depsdone{$key}++ and next; # We could not just remove the $deps inside the foreach loop # otherwize one alternative deps could be removed but not the other, and # this could lead to package rejected for ordering reasons although they should not # As a consequence two foreach loops are needed my $ok; $ok ||= $depsdone{$_} foreach @$_; $ok and next; foreach my $d (@$_) { if ($curID{$d}) { @toadd = (); last } push @toadd, $d } @toadd and push @deps, \@toadd } elsif (!$curID{$_}) { $depsdone{$_}++ and next; push @deps, $_ } } return \@deps } sub print_conflict_matrix { my ($groups) = @_; print "print_listcd_matrix\n"; for (my $i = 0; $i < @$groups; $i++) { ref $groups->[$i]{list_cd} or next; print "Group $i\n"; foreach my $list (keys %{$groups->[$i]{list_cd}}) { ref $groups->[$i]{list_cd}{$list} or next; print "Group $i list $list\n"; foreach my $cd (keys %{$groups->[$i]{list_cd}{$list}}) { ref $groups->[$i]{list_cd}{$list}{$cd} or next; print "Group $i list $list cd $cd\n"; foreach my $type (keys %{$groups->[$i]{list_cd}{$list}{$cd}}) { ref $groups->[$i]{list_cd}{$list}{$cd}{$type} or next; print "Group $i list $list cd $cd type $type -> @{$groups->[$i]{list_cd}{$list}{$cd}{$type}}\n" } } } } print "print_conflict_matrix\n"; for (my $i = 0; $i < @$groups; $i++) { ref $groups->[$i]{list_conflict} or next; #print "Group $i\n"; foreach my $list (keys %{$groups->[$i]{list_conflict}}) { ref $groups->[$i]{list_conflict}{$list} or next; #print "Group $i list $list\n"; foreach my $type (keys %{$groups->[$i]{list_conflict}{$list}}) { ref $groups->[$i]{list_conflict}{$list}{$type} or next; #print "Group $i list $list type $type\n"; foreach my $group (keys %{$groups->[$i]{list_conflict}{$list}{$type}}) { ref $groups->[$i]{list_conflict}{$list}{$type}{$group} or next; #print "Group $i list $list type $type group $group\n"; foreach my $list_2 (keys %{$groups->[$i]{list_conflict}{$list}{$type}{$group}}) { ref $groups->[$i]{list_conflict}{$list}{$type}{$group}{$list_2} or next; #print "Group $i list $list type $type group $group list $list_2\n"; foreach my $type (keys %{$groups->[$i]{list_conflict}{$list}{$type}{$group}{$list_2}}) { 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" } } } } } } }