package Mkcd::Group; my $VERSION = '2.0.2'; use strict; use File::NCopy qw(copy); use File::Path; use Mkcd::Disc; use Mkcd::List; use Mkcd::Build; use Mkcd::Tools qw(cleanrpmsrate printTable printDiscsFile readBatchFile printBatchFile log_); use Mkcd::Package qw(genDeps getSize); use MDK::Common qw(any); #use Mkcd::Optimize qw(print_conflict_matrix); =head1 NAME Group - mkcd module =head1 SYNOPSYS require Mkcd::Group; =head1 DESCRIPTION C include the mkcd high level disc building routines. =head1 SEE ALSO mkcd =head1 COPYRIGHT Copyright (C) 2000,2001,2002,2003,2004 Mandrakesoft 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. =cut my $config; sub new { my ($class, $conf) = @_; $config = $conf; bless { config => $conf, list => new Mkcd::List($conf), build => new Mkcd::Build($conf), disc => new Mkcd::Disc($conf) }, $class; } # # group structure # # $group[group number]{list}{rpm/srpm} = { list => [[cd, repname, {options}],[], ...,[]] } # # $group[group number] # brokendeps => { # rpm_depending_on_non_listed_locales => 1 , # rpm_which_deps_are_broken => 2, # rpm_exluded_from_conf => 3 } # conflict => { $group_number => 1 } this group have common disc with generic like function with group $group_number. # depslistid => [ depslist id ] # depsrep => deps repository name # discdep # discdeps => { cd => { cds it depends on ] } # discrep # disc_impacted=> { cd => 1 } # done => { rpm => rep number } # installDisc => install disc for this group # filelist => [FILELIST] # list # lang => { locale1 => 1, locale2 => 1} # list_conflict=> { list => { type => { grp => { list => { type => 0/1 }}}}} # listmatrix # listmaxrep => { rpm/srpm => { list => max ordered rep_name number for list list } } # listrpm => { list => [ rpm ] } # listsize => { rpm => { list => total rpm size, ... } } # listsort # maxlist # maxrep => max ordered rep_name number # maxsize => rpm maxsize # nodeps => { list => 1} # options # orderedrep => { rpm/srpm => { "rep_name" => num } } # orderedlist => { rpm/srpm } # pkgdeps => { package_name => [depslist dependencies ] } # pkgrate => { rpm => rpmsrate_increase } # globrpm => [ "path1/rpm1" ... "pathn/rpmq" ] # rejected => { rpm => [ "error", "message" ] } # rep => { type => list => [ { "path" => [pkg list] } } ] # rep_pkg => { type => { "path" => [pkg list] } } # replist => { $type => [ [ cd, repname, num, [ [related list, related curdir] [] ] ], [], ..., []] } # reploc # revdeps => [ reversed depslist ] # rpmsrate => { rpmsrate } # rpmsratepath => rpmsrate path # score => [ score weight ] # scoredlist => { rpm_name => score } # size => { rpm_name => [filesize, list number, directory], ... } # srpmname => { srpm => srpm-version-release } # sourcerpm => { rpm => sourcerpm } # urpm => URPM::urpm # option added to urpm # rpmkey # sourcerpm # rpm # sub getGroups { my ($config, $lists) = @_; my (@list, %cd, %done, %list, %repname); log_("getGroups\n", $config->{verbose}, $config->{LOG}, 1); foreach my $i (keys %$lists) { log_("getGroups: disc $i\n", $config->{verbose}, $config->{LOG}, 2); $cd{$i} = 1; ref $config->{disc}[$i]{fastgeneric} or next; foreach my $f (@{$config->{disc}[$i]{fastgeneric}}) { my $repname = $f->[1]{repname}; my @k = keys %{$f->[1]}; ref $f->[1]{lists} or do { log_("ERROR getGroups: disc $i lists not defined for rep $repname\n", $config->{verbose}, $config->{LOG},3); next }; log_("getGroups: lists @{$f->[1]{lists}} repname $repname options (@k)\n", $config->{verbose}, $config->{LOG},3); foreach my $g_list (@{$f->[1]{lists}}) { log_("getGroups: list $g_list\n", $config->{verbose}, $config->{LOG}, 3); my $idx; $idx = push @{$list[$g_list]}, [ $i, ${repname}, $f->[1], {} ]; push @{$repname{$i}{$repname}}, [ $g_list, $idx - 1 ]; log_("getGroups: cd $i repname $repname list $g_list\n", $config->{verbose}, $config->{LOG},3); $list{$g_list} = 0 } } } my @group; my $g = prepare_cloned_discs(\@group, \%done, $config, $lists); my %donerep; foreach my $i (keys %$lists) { my $t = $config->{disc}[$i]{function}{data}{installation}; log_("getGroups: disc $i ($t)\n", $config->{verbose}, $config->{LOG},2); ref $t and do { log_("getGroups: install disc for group $g => ($i)\n", $config->{verbose}, $config->{LOG},3); $group[$g]{installDisc} = $i; $group[$g]{options} = $t->[1]; $group[$g]{score} ||= $t->[1]{score} || [1,1,1]; ($group[$g]{maxrep}{rpm}, $group[$g]{maxlist}{rpm}) = addRepList("rpm", $group[$g], $g, $t->[1]{rpmsdir}, $donerep{$g}, \%done, \%list, \%cd, \%repname, $i, \@list); ($group[$g]{maxrep}{srpm}, $group[$g]{maxlist}{srpm}) = addRepList("srpm", $group[$g], $g, $t->[1]{srpmsdir}, $donerep{$g}, \%done, \%list, \%cd, \%repname, $i, \@list); my $struct_v = $config->{struct_version}; my $media_info = $config->{struct}{$struct_v}{media_info}; $group[$g]{rpmsratepath} ||= $t->[1]{rpmsrate} || "$t->[1]{install}/$media_info/rpmsrate"; log_("getGroups: using $group[$g]{rpmsratepath} as rpmsrate file\n", $config->{verbose}, $config->{LOG},4); $group[$g]{list} and $group[$g]{depsrep} = join '-', keys %{$group[$g]{list}}; log_("getGroups: $group[$g]{depsrep} defined as deps file directory\n", $config->{verbose}, $config->{LOG},4); if (ref $t->[1]{lang}) { foreach (@{$t->[1]{lang}}) { $group[$g]{lang}{$_} = 1 } } $group[$g]{discdeps}{$i} ||= {}; log_("getGroups DEBUG: discdep for group $g => ($group[$g]{discdep})\n", $config->{verbose}, $config->{LOG},5); $g++; } } my %alone; foreach (keys %list) { $list{$_} and next; log_("getGroups: searching alone groups list $_\n", $config->{verbose}, $config->{LOG},2); # FIXME not clean as now with the --group option of generic getAlone add new group $group[$g]{score} = [1,1,1]; $group[$g]{depsrep} = $_; $g = getAlone($list[$_], $_, \@group, $g, \%done, \%alone); $list{$_}++; log_("getGroups: adding a group $g for list $_\n", $config->{verbose}, $config->{LOG},2); $g++ } foreach my $i (keys %$lists) { $done{$i} and next; $done{$i} = {}; log_("getGroups: searching alone disc disc $i does not handled by any group, setting alone group\n", $config->{verbose}, $config->{LOG},2); $group[$g]{discdeps}{$i} ||= {}; log_("getGroups: adding a group $g for disc $i\n", $config->{verbose}, $config->{LOG},2); $g++ } for (my $i; $i < @group; $i++) { $group[$i]{orderedlist}{rpm} ||= []; foreach (@{$group[$i]{orderedlist}{rpm}}) { $group[$i]{list}{$_}{srpm} ||= [] } $group[$i]{orderedlist}{srpm} ||= []; log_("getGroups: ordered rpm list for group $i: @{$group[$i]{orderedlist}{rpm}}\n", $config->{verbose}, $config->{LOG},2); log_("getGroups: ordered srpm list for group $i: @{$group[$i]{orderedlist}{srpm}}\n", $config->{verbose}, $config->{LOG},2); } # $config->{verbose} and printTable(\@group); \@group } sub getAlone { my ($list, $ls, $groups, $g, $done, $alone) = @_; my $num = 1; $list or return; my $lnsort = 1; my $replist_list; my $group = $groups->[$g]; my $grp = $g; my $inc; foreach my $l (@$list) { my ($cd, $rep, $opt) = @$l; $done->{$cd}{$rep}{$ls} and next; log_("WARNING getAlone: rep $rep of list $_ does not belong to any installation disc, setting alone group $g\n", $config->{verbose}, $config->{LOG}, 1); my $type = $opt->{source} ? "srpm" : "rpm"; log_("getAlone: searching alone groups list $ls cd $cd rep $rep type $type\n", $config->{verbose}, $config->{LOG},1); if ($opt->{group}) { $num = 1; if ($alone->{$opt->{group}}) { $grp--; $g = $alone->{$opt->{group}}; log_("getAlone: using existing group $g\n", $config->{verbose}, $config->{LOG},1); $group = $groups->[$g] } else { if ($inc) { $grp++; log_("getAlone: creating a new group $g\n", $config->{verbose}, $config->{LOG},1); $groups->[$grp]{score} = [1,1,1]; $groups->[$grp]{depsrep} = $ls; } $g = $grp; $alone->{$opt->{group}} = $g; $group = $groups->[$g]; $inc = 1 } log_("getAlone: adding list $ls cd $cd rep $rep type $type in group $opt->{group} ($g)\n", $config->{verbose}, $config->{LOG},1); } $group->{list}{$ls}{$type} or push @{$group->{orderedlist}{$type}}, $ls; $group->{listmatrix}{$type}{$ls}{$ls} = 1; $config->{list}[$ls]{disc}{$cd}{$rep}{master} ||= $g; if (! exists $config->{disc}[$cd]{group_master}) { log_("getAlone: setting group $g as master of disc $cd\n", $config->{verbose}, $config->{LOG},2); $config->{disc}[$cd]{group_master} = $g; push @{$group->{master_of_disc}}, $cd } $config->{disc}[$cd]{group_list}{$g}{$ls}{$type} = 1; push @{$group->{list}{$ls}{$type}}, $l; push @{$group->{list_cd}{$ls}{$cd}{$type}}, $l; my $cur_num = \$group->{orderedrep}{$type}{"$cd/$rep"}; print "CUR_NUM group $group ($g) curnum $cur_num $$cur_num\n"; if (! $$cur_num) { $$cur_num = $num; $replist_list = { $ls => $l }; $group->{orderedrep}{$type}{"$cd/$rep"} = $num; $group->{replist}{$type}[$num-1] = [ $cd, $rep, $num, $replist_list ]; $num++ } else { $group->{replist}{$type}[$$cur_num-1][3]{$ls} = $l } print "CUR_NUM $cur_num $$cur_num\n"; foreach my $v (@{$config->{list}[$ls]{virtual}}) { my ($d_cd, $d_rep) = ($v->{disc}, $v->{repname}); log_("getAlone: setting disc_prereq for disc on disc $d_cd for list $ls disc $cd group $g\n", $config->{verbose}, $config->{LOG},2); $group->{disc_prereq}{$d_cd}++ } if (!$group->{listsort}{$ls}{$type}) { $group->{listsort}{$ls}{$type} = $lnsort++ }; $done->{$cd}{$rep}{$ls}++; log_("getAlone: searching alone groups group $g handle disc $l->[0]\n", $config->{verbose}, $config->{LOG},2); # FIXME discdeps may be deprecated for group as hdlists are built without reading real directories. $group->{discdeps}{$l->[0]} ||= {}; $group->{disc_impacted}{$l->[0]} = 1; log_("getAlone: setting nodeps flag for group $g list $ls\n", $config->{verbose}, $config->{LOG},3) if $opt->{nodeps}; $group->{nodeps}{$ls} = $opt->{nodeps}; $group->{options}{nodeps} = $opt->{nodeps} } $grp } sub addRepList { my ($type, $group, $g, $replist, $donerep, $done, $list, $disc, $repname, $i, $listTable) = @_; my $num = 1; my $lnsort = 1; my $replist_list; foreach (@$replist) { my ($cdlist, $cd, $name) = @$_; my $opt = $_->[3] || {}; log_("getGroups: group $g cd $cd repname $name list $cdlist noauto ($opt->{noauto})\n", $config->{verbose}, $config->{LOG},2); if ($donerep->{$type}{$cd}{$name}{$cdlist}) { log_("ERROR getGroups: $cd/$name/$cdlist is defined multiple time for group $g, ignoring\n", $config->{verbose}, $config->{LOG}); next } $donerep->{$type}{$cd}{$name}{$cdlist} = 1; if (!$disc->{$cd}) { log_("ERROR getGroups: disc $cd not in list, ignoring\n", $config->{verbose}, $config->{LOG}); next } my $ln = $repname->{$cd}{$name}; if (!$ln) { log_("ERROR getGroups: $name on disc $cd does not exist\n", $config->{verbose}, $config->{LOG}); next } my $cur_num = \$group->{orderedrep}{$type}{"$cd/$name"}; if (! $$cur_num) { $$cur_num = $num; $replist_list = {}; $group->{orderedrep}{$type}{"$cd/$name"} = $num; @{$group->{reverse_rep}{$type}{$num}}{'cd','name'} = ($cd, $name); log_("getGroups: reverse rep for $num type $type $group->{reverse_rep}{$type}{$num}{cd} - $group->{reverse_rep}{$type}{$num}{name}\n", $config->{verbose}, $config->{LOG},2); $group->{replist}{$type}[$num-1] = [ $cd, $name, $num, $replist_list ]; $num++ } else { $replist_list = $group->{replist}{$type}[$$cur_num-1][3] } $cd != $i and $group->{discdeps}{$i}{$cd}++; $group->{disc_impacted}{$cd} = 1; if ($cd != $i) { log_("getGroups: group $g handle disc $i\n", $config->{verbose}, $config->{LOG},2) } foreach my $l (@$ln) { my ($ls, $idx) = @$l; next if $cdlist && $cdlist != $ls; next if $replist_list->{$ls}; my $list_options = $listTable->[$ls][$idx][2]; if ($group->{listmaxrep}{$type}{$ls} < $group->{orderedrep}{$type}{"$cd/$name"}) { $group->{listmaxrep}{$type}{$ls} = $group->{orderedrep}{$type}{"$cd/$name"} } $group->{list}{$ls}{$type} or push @{$group->{orderedlist}{$type}}, $ls; foreach my $lst (@{$group->{orderedlist}{$type}}) { $group->{listmatrix}{$type}{$ls}{$lst} = 1 } foreach my $lst_ent (@$ln) { $group->{listmatrix}{$type}{$ls}{$lst_ent->[0]} = 1 } if (!$group->{listsort}{$ls}{$type}) { $group->{listsort}{$ls}{$type} = $lnsort++ }; my $curdir = [ $cd, $name, $list_options, $opt ]; push @{$group->{list}{$ls}{$type}}, $curdir; push @{$group->{list_cd}{$ls}{$cd}{$type}}, $curdir; $replist_list->{$ls} = $curdir; foreach my $v (@{$config->{list}[$ls]{virtual}}) { my ($d_cd, $d_rep) = ($v->{disc}, $v->{repname}); log_("addRepList: setting disc_prereq for disc on disc $d_cd for list $ls disc $cd group $g\n", $config->{verbose}, $config->{LOG},2); $group->{disc_prereq}{$d_cd}++ } if ($opt->{fixed}) { if (!$config->{list}[$ls]{disc}{$cd}{$name}{master}) { log_("WARNING addRepList: disc $cd rep $name has no master yet\n", $config->{verbose}, $config->{LOG},2) if !$config->{list}[$ls]{disc}{$cd}{$name}{master}; $config->{list}[$ls]{disc}{$cd}{$name}{master} = $g; } } else { # this group is the master for this rep log_("ERROR addRepList: group $g has already a master, overridding\n", $config->{verbose}, $config->{LOG},2) if $config->{list}[$ls]{disc}{$cd}{$name}{master}; $config->{list}[$ls]{disc}{$cd}{$name}{master} = $g; if (! exists $config->{disc}[$cd]{group_master}) { log_("addRepList: setting group $g as master of disc $cd\n", $config->{verbose}, $config->{LOG},2); $config->{disc}[$cd]{group_master} = $g; push @{$group->{master_of_disc}}, $cd } } $config->{disc}[$cd]{group_list}{$g}{$ls}{$type} = 1; $list->{$ls}++; $done->{$cd}{$name}{$ls}++; } } return $num,$lnsort } sub preCheck { # TODO # may not be necessary } sub orderGroups { my ($config, $groups, $lists, $acds) = @_; my @metagroups; my @tmpmetagroups; my @groupmeta; my $ok; my $check_group = sub { my ($i, $og, $cd) = @_; log_("orderGroups: checking group $i\n", $config->{verbose}, $config->{LOG},1); if (ref $groups->[$i]{master_of_disc}) { if ($groupmeta[$i] == $groupmeta[$og]) { log_("orderGroups: setting group $i different from $og cos of disc $cd\n", $config->{verbose}, $config->{LOG},5); $groupmeta[$i] = $groupmeta[$og] + 1; return 0; } } elsif ($groupmeta[$i] != $groupmeta[$og] && $og == $config->{disc}[$cd]{group_master}) { log_("orderGroups: setting group $i equal to $og cos of disc $cd\n", $config->{verbose}, $config->{LOG}, 5); $groupmeta[$i] = $groupmeta[$og]; return 0 } 1 }; # FIXME This algo can create empty metagroups while (!$ok) { log_("orderGroups: ordering metagroups\n", $config->{verbose}, $config->{LOG}, 4); $ok = 1; my %handled; for (my $i; $i < @$groups; $i++) { if ($groups->[$i]{installDisc}) { $lists->{$groups->[$i]{installDisc}} == 2 or next } log_("orderGroups: group $i (install disc $groups->[$i]{installDisc})\n", $config->{verbose}, $config->{LOG}, 6); foreach my $list (keys %{$groups->[$i]{list}}) { foreach my $type (keys %{$groups->[$i]{list}{$list}}) { foreach my $rep (@{$groups->[$i]{list}{$list}{$type}}) { my ($cd, $r) = ($rep->[0], $rep->[1]); $lists->{$cd} == 2 or next; my $og = $config->{disc}[$cd]{group_master}; $handled{$cd}{$og} = 1; $og == $i and next; log_("orderGroups: master of disc $cd/$r = ($og)\n", $config->{verbose}, $config->{LOG}, 8); $ok &&= $check_group->($i,$og,$cd); } } } } for (my $i; $i < @$groups; $i++) { foreach my $cd (keys %{$groups->[$i]{disc_prereq}}) { log_("ordreGroups: searching for disc_prereq for group $i disc $cd\n", $config->{verbose}, $config->{LOG}, 5); foreach (keys %{$handled{$cd}}) { $_ == $i and next; log_("ordreGroups: disc $cd handled by group $_\n", $config->{verbose}, $config->{LOG}, 5); # I do not want group to be set equal in prereq checking (this happen for alone groups when the CD is owned by another group) #$ok &&= $check_group->($i,$_,$cd); if ($groupmeta[$i] == $groupmeta[$_]) { log_("orderGroups: setting group $i different from $_ cos of disc $cd\n", $config->{verbose}, $config->{LOG}, 3); $groupmeta[$i] = $groupmeta[$_] + 1; $ok = 0 } } } } } for (my $i; $i < @$groups; $i++) { if ($groups->[$i]{installDisc}) { $lists->{$groups->[$i]{installDisc}} == 2 or next } log_("orderGroups: group $i metagroup $groupmeta[$i]\n", $config->{verbose}, $config->{LOG}, 8); push @{$tmpmetagroups[$groupmeta[$i]][0]}, $groups->[$i]; } my %donedisc; for (my $meta; $meta < @tmpmetagroups; $meta++) { my $mg = $tmpmetagroups[$meta]; my %cd; my %cdg; my %iogroup; my %cdiogroup; my $i = 1; foreach (@$acds) { $cd{$_} = $i; $cdiogroup{$_} = $i++ } my $grps = $mg->[0]; my $i = 0; foreach (0 .. $#$grps){ $iogroup{$_} = $i++ } my $loop; my $ok = 0; my %groups_conflict; my %old_values; while (!$ok && !$loop) { ordering_loop: { $ok = 1; # WARNING group number are not definitive here, they must not be saved! foreach my $gn (0 .. $#$grps) { my $g = $grps->[$gn]; log_("orderGroups: group $gn discs " . (join ' ', (keys %{$g->{discdeps}})) . " list " . join(' ', keys %{$g->{list}}) . "\n", $config->{verbose}, $config->{LOG}, 5); foreach my $cd (keys %{$g->{discdeps}}) { log_("orderGroups: disc $cd DONEDISC $donedisc{$cd} group $gn\n", $config->{verbose}, $config->{LOG}, 5); $donedisc{$cd} and next; if ($iogroup{$gn}) { log_("orderGroups: making disc $cd from group $gn in the same iogroup as group $gn ($iogroup{$gn})\n", $config->{verbose}, $config->{LOG}, 5); if ($iogroup{$gn} != $cdiogroup{$cd}) { if ($cdiogroup{$cd} == $old_values{$gn}) { log_("ERROR: orderGroups: loop in discs dependencies, taking manual order\n", $config->{verbose}, $config->{LOG}); $loop = 1; last ordering_loop } $old_values{$gn} = $iogroup{$gn}; $iogroup{$gn} = $cdiogroup{$cd}; foreach my $all_cd (keys %{$g->{discdeps}}) { $cdiogroup{$all_cd} = $iogroup{$gn}; } $ok = 0 } } else { $iogroup{$gn} = $cdiogroup{$cd} } $groups_conflict{$cd}{$gn} = 1; #$g->{conflict} = $groups_conflict{$cd}; #log_("orderGroups: group $gn conflict with group $gn ($g->{conflict}{$gn})\n", $config->{verbose}, $config->{LOG}, 4); log_("orderGroups: orderGroups: disc $cd\n", $config->{verbose}, $config->{LOG}, 5); $lists->{$cd} >= 1 or next; $cdg{$cd} = {}; if (ref $g->{discdeps}{$cd}) { foreach (keys %{$g->{discdeps}{$cd}}) { $donedisc{$_} and next; $cdiogroup{$_} = $cdiogroup{$cd}; log_("orderGroups: disc $cd => $_\n", $config->{verbose}, $config->{LOG}, 7); if ($cdg{$cd}{$_}) { log_("ERROR: orderGroups: loop in discs dependencies, taking manual order\n", $config->{verbose}, $config->{LOG}); $loop = 1; last ordering_loop } $cdg{$cd}{$_} = 1; $cdg{$_} = {}; if ($cd{$cd} <= $cd{$_}) { $cd{$cd} = $cd{$_} + 1; $ok = 0 } } } } } } } if ($loop) { # Does not take care of iogroup in manual mode $metagroups[$meta][0][0] = $mg; foreach my $c (@$acds) { $cdg{$c} and $lists->{$c} == 2 and push @{$metagroups[$meta][0][1]}, $c and $donedisc{$c} = 1 } } else { my @siogroup = sort { $iogroup{$a} <=> $iogroup{$b} } keys %iogroup; my %iogroupcd; $metagroups[$meta][0][0] = []; for (my ($i, $j); $i < @siogroup; $i++) { if ($i && $iogroup{$siogroup[$i]} != $iogroup{$siogroup[$i-1]}) { $j++; $metagroups[$meta][$j][0] = [] } log_("orderGroups: siogroup $i ($siogroup[$i] iogroup $iogroup{$siogroup[$i]} cd " . join(',',keys %{$grps->[$siogroup[$i]]{disc_impacted}}) ." list " . join(',',keys %{$grps->[$siogroup[$i]]{list}}) . ")\n", $config->{verbose}, $config->{LOG}, 8); my $g = $grps->[$siogroup[$i]]; push @{$metagroups[$meta][$j][0]}, $g; $iogroupcd{$_} = $j foreach keys %{$g->{disc_impacted}} } #foreach (keys %iogroup) { # log_("orderGroups: group $_ (CDs " . join(',', keys %{$grps->[$_]{disc_impacted}}) . ") in iogroup $iogroup{$_}\n", 1, $config->{LOG}) #} my @scds = sort { $cd{$a} <=> $cd{$b} } keys %cdg; foreach my $c (@scds) { $lists->{$c} == 2 and push @{$metagroups[$meta][$iogroupcd{$c}][1]}, $c and $donedisc{$c} = 1 } } for (my $iogi; $iogi < @{$metagroups[$meta]}; $iogi++) { ref $metagroups[$meta][$iogi][1] or next; log_("orderGroups: IO group $iogi disc sorting @{$metagroups[$meta][$iogi][1]}\n", $config->{verbose}, $config->{LOG}, 4); } # for (my $i = 0; $i < @$grps; $i++) { # foreach my $ls (keys %{$grps->[$i]{list}}) { # foreach my $l (keys %{$grps->[$i]{list}}) { # log_("orderGroups: group $i listmatrix list $ls - list $l -> $grps->[$i]{listmatrix}{rpm}{$ls}{$l}\n", $config->{verbose}, $config->{LOG}) # } # foreach my $t (keys %{$grps->[$i]{list}{$ls}}) { # my $rep = $grps->[$i]{list}{$ls}{$t}; # for (my $grp = 0; $grp < @$grps; $grp++) { # foreach my $list (keys %{$grps->[$grp]{list}}) { # foreach my $type (keys %{$grps->[$grp]{list}{$list}}) { # my $rep2 = $grps->[$grp]{list}{$list}{$type}; # foreach my $a (@$rep) { # if (any { $a->[0] == $_->[0] } @$rep2) { # log_("orderGroups: group $i list $ls type $t conflicts with group $grp list $list type $type\n", $config->{verbose}, $config->{LOG}); # $grps->[$i]{conflict}{$grp} = 1; # $grps->[$i]{list_conflict}{$ls}{$t}{$grp}{$list}{$type} = 1; # last # } # } # } # } # } # } # } # } } # add alone discs my @cd; foreach (keys %donedisc) { $donedisc{$_} or push @cd, $_ } @cd and push @metagroups, [[0, \@cd]]; for (my $m = 0; $m < @metagroups; $m++) { for (my $iog = 0; $iog < @{$metagroups[$m]}; $iog++) { #log_("GROUP $i iog $iog: $metagroups[$m][$iog][0] (@{$metagroups[$m][$iog][0]})\n", $config->{verbose}, $config->{LOG}, 3); my $grps = $metagroups[$m][$iog][0]; for (my $i = 0; $i < @$grps; $i++) { foreach my $ls (keys %{$grps->[$i]{list}}) { foreach my $l (keys %{$grps->[$i]{list}}) { foreach my $t (keys %{$grps->[$i]{list}{$ls}}) { my $rep = $grps->[$i]{list}{$ls}{$t}; for (my $grp = 0; $grp < @$grps; $grp++) { foreach my $list (keys %{$grps->[$grp]{list}}) { foreach my $type (keys %{$grps->[$grp]{list}{$list}}) { my $rep2 = $grps->[$grp]{list}{$list}{$type}; foreach my $a (@$rep) { if (any { $a->[0] == $_->[0] } @$rep2) { log_("orderGroups: group $i list $ls type $t conflicts with group $grp list $list type $type\n", $config->{verbose}, $config->{LOG}); $grps->[$i]{conflict}{$grp} = 1; $grps->[$grp]{conflict}{$i} = 1; $grps->[$i]{list_conflict}{$ls}{$t}{$grp}{$list}{$type} = 1; last } } } } } } } } } } } \@metagroups } sub getGroupReps { my ($config, $group, $discsFiles) = @_; my $topdir = "$config->{topdir}/build/$config->{name}"; my $check_discsFiles = sub { my ($cd, $rep, $listnumber, $rep_nb) = @_; log_("getGroupReps check_discsfiles: disc $cd rep $rep list $listnumber\n", $config->{verbose} , $config->{LOG}, 5); foreach (keys %{$discsFiles->[$cd]{$rep}{$listnumber}}) { my $type = /src$/ ? 'srpm' : 'rpm'; my $d = $discsFiles->[$cd]{$rep}{$listnumber}{$_}; push @{$group->{rep}{$listnumber}[$rep_nb]{$type}{$d}}, $_; push @{$group->{rep_pkg}{$type}{$d}}, $_ } }; # FIXME sep_arch is not used, maybe a chech should prevent both sep_arch and non sep_arch mode. # However current scheme is more robust. my $check_dir = sub { my ($dir, $listnumber, $rep_nb, $type, $test, $sep_arch) = @_; log_("getGroupReps check_dir: dir $dir list $listnumber rep_nb $rep_nb type $type\n", $config->{verbose}, $config->{LOG},6); my $add_rpm = sub { my ($d, $rpm) = @_; $rpm =~ /($test)\.rpm$/ or return; $rpm = ~/(.*)\.rpm$/ or return; push @{$group->{rep}{$listnumber}[$rep_nb]{$type}{$d}}, $1; push @{$group->{rep_pkg}{$type}{$d}}, $1 }; my $RPMS; if (!opendir $RPMS, $dir) { log_("WARNING getGroupReps: cannot open $dir\n", $config->{verbose}, $config->{LOG}); return } foreach (readdir $RPMS) { if (-d "$dir/$_") { opendir my $rpm_dir, "$dir/$_"; foreach my $r (readdir $RPMS) { $add_rpm->("$dir/$_",$r) } } else { $add_rpm->($dir,$_) } } closedir $RPMS }; my $testarch = join '|', keys %{$config->{ARCH}}; foreach my $listnumber (keys %{$group->{list}}) { my $ok; foreach (@{$group->{list}{$listnumber}{rpm}}) { !$_->[3]{nodeps} and $ok = 1 } if (!$ok) { $group->{nodeps}{$listnumber} = 1 } log_("getGroupReps list $listnumber\n", $config->{verbose}, $config->{LOG},3); my $rep_nb; if (ref $config->{list}[$listnumber]{packages}) { foreach (@{$config->{list}[$listnumber]{packages}}) { log_("getGroupReps: rep num $rep_nb\n", $config->{verbose}, $config->{LOG},4); foreach my $t ('rpm', 'srpm') { foreach my $d (@{$_->{$t}}) { log_("getGroupReps: $d\n", $config->{verbose}, $config->{LOG},5); $check_dir->($d, $listnumber, $rep_nb, $t, $t eq 'rpm' ? $testarch : 'src'); } } $rep_nb++ } } foreach my $d (@{$config->{list}[$listnumber]{virtual}}) { my $cd = $d->{disc}; my $rep = $d->{repname}; my $path = $config->{disc}[$cd]{function}{data}{dir}{$rep}[1]{reploc}; my $sep_arch = $config->{disc}[$cd]{function}{data}{dir}{$rep}[1]{sep_arch}; my $dir = "$topdir/$cd/$path"; log_("getGroupReps: virtual disc $cd path $path (num $rep_nb) in $dir\n", $config->{verbose} , $config->{LOG},3); if ($discsFiles->[$cd]{$rep}{$listnumber}) { $check_discsFiles->($cd,$rep,$listnumber) } elsif (-d $dir) { $check_dir->($dir,$listnumber,$rep_nb, 'rpm',$testarch, $sep_arch); } else { log_("ERROR getGroupReps: could not find virtual disc $cd path $path\n", $config->{verbose} , $config->{LOG}); next } $rep_nb++ } foreach my $cd (keys %{$config->{list}[$listnumber]{disc}}) { foreach my $rep (keys %{$config->{list}[$listnumber]{disc}{$cd}}) { if ($config->{list}[$listnumber]{disc}{$cd}{$rep}{done}) { $check_discsFiles->($cd, $rep, $listnumber) } $rep_nb++ } } } } # TODO at present clone only do full copy sub prepare_cloned_discs { my ($group, $done, $config, $lists) = @_; my $g; foreach my $cd (keys %$lists) { my $loc_conf = $config->{disc}[$cd]{function}; if ($loc_conf->{data}{clone}) { log_("prepare_cloned_discs: disc $cd\n", $config->{verbose}, $config->{LOG},2); # nothing to do, cp -r #if (@{$loc_conf->{list}} == 1 && !$loc_conf->{list}[0][1]{to_del}) { # $loc_conf->{data}{clone}[0][1]{full_copy} = 1; $group->[$g]{disc_impacted}{$cd} = 1; $group->[$g]{discdeps}{$cd} = {}; log_("prepare_cloned_discs: setting group $g as master of disc $cd\n", $config->{verbose}, $config->{LOG}, 4); $config->{disc}[$cd]{group_master} = int $g; push @{$group->[$g]{master_of_disc}}, $cd; foreach (@{$loc_conf->{data}{clone}}) { $group->[$g]{disc_prereq}{$_->[1]{disc}}++ } $done->{$cd} = {}; $g++ # next #} } } $g } sub find_cpu { my $cpu; open my $CPU, "/proc/cpuinfo"; while (<$CPU>) { /processor/ and $cpu++ }; $cpu } sub make_io_group { my ($class, $iog, $config, $log, $lists, $discs_files, $cdsize, $size, $graft, $sort, $inode, $done_deps, $iotask, $metagroups, $mkisos) = @_; my $cds = $iog->[1]; my $groups = $iog->[0]; print $log "Group: $iog (@$cds -- $groups)\n"; # FIXME ordering metagroups can lead to empty groups with the -l option $groups or next; my (@buildlist, @rpmlist, @needed); my @groupok; #print_conflict_matrix($groups); for (my $i; $i < @$groups; $i++) { log_("Get already built discs lists\n", $config->{verbose}, $log, 3); $groups->[$i]{done} = { rep => {}, list => {} }; $class->{disc}->getBuiltDiscs($lists, $groups->[$i], $discs_files); log_("GROUP $i\n", $config->{verbose}, $log, 5); getGroupReps($config, $groups->[$i], $discs_files); log_("genDeps\n", $config->{verbose}, $log, 3); if (! $done_deps->{$groups->[$i]{depsrep}} && ref $groups->[$i]{rep_pkg}{rpm}) { $done_deps->{$groups->[$i]{depsrep}} = genDeps("$config->{tmp}/$config->{name}/$groups->[$i]{depsrep}", $groups->[$i]{rep_pkg}{rpm}, $config->{deps}, $config->{verbose}, $config->{tmp}) or do { log_("ERROR: genDeps failed\n", $config->{verbose}, $log); return 0 } } $groups->[$i]{urpm} = $done_deps->{$groups->[$i]{depsrep}}; log_("getSize\n", $config->{verbose}, $log, 3); my $redeps = getSize($groups->[$i],$config, $config->{verbose}) or do { log_("ERROR: getSize failed\n", $config->{verbose}, $log); return 0 }; $class->{disc}->guessHdlistSize($groups->[$i], $size, $cdsize, $lists, $discs_files); # put in getList to handle package nodeps flag #$groups->[$i]{revdeps} = $class->{list}->reverseDepslist($groups->[$i]); ($groups->[$i]{filelist}, my $norpmsrate) = $class->{list}->getList($groups->[$i], $discs_files); if ($groups->[$i]{rpmsratepath}) { my $struct_v = $config->{struct_version}; my $media_info = $config->{struct}{$struct_v}{media_info}; my $outputdir = "$config->{tmp}/build/$config->{name}/$groups->[$i]{installDisc}/$media_info/"; -d $outputdir or mkpath $outputdir; my $output = "$outputdir/rpmsrate"; # FIXME currently the rpmsrate is updated at group creation, # maybe need to be done again at disc finalizing stage only to include # present packages. However it is harmfull to have packages into the rpmsrate not # present on the discs. log_("cleanrpmsrate $groups->[$i]{rpmsratepath} -> $output\n", $config->{verbose}, $log, 3); $groups->[$i]{rpmsrate} = cleanrpmsrate($groups->[$i]{rpmsratepath}, $output, $norpmsrate, $groups->[$i]{rep_pkg}{rpm}, $groups->[$i]{urpm}) or log_("ERROR: cleanrpmsrate failed\n", $config->{verbose}, $log); $groups->[$i]{options}{rpmsrate} = $output; } log_("build_list group $i\n", $config->{verbose}, $log, 3); ($rpmlist[$i], $groups->[$i]{revdeps}) = $class->{list}->build_list($groups->[$i]) or return 0; $class->{list}->scoreList($groups->[$i]) or return 0; $class->{list}->autodeps($groups->[$i], $rpmlist[$i]); foreach my $l (keys %{$rpmlist[$i]}) { my (@force, @need, @superforce, @limit, @b); foreach (keys %{$rpmlist[$i]{$l}}) { log_("Group: rpm $_\n", $config->{verbose}, $log); # in case of multiple entries $groups->[$i]{limit}{$_} = 0; if (!$_) { log_("ERROR: empty rpmlist key ($rpmlist[$i]{$l}{$_}) KEYS " . keys(%{$rpmlist[$i]{$l}{$_}}) . " \n", $config->{verbose}, $log); next } my $elt = [ $_, $rpmlist[$i]{$l}{$_}, $groups->[$i]{scorelist}{$_} ]; if (!$config->{nodeps} && !$groups->[$i]{options}{nodeps} && !$groups->[$i]{nodeps}{$l} && /basesystem/) { $elt->[1]{needed} = 1; push @superforce, $elt } elsif ($rpmlist[$i]{$l}{$_}{force}) { #$elt->[1]{needed} = 1; push @force, $elt } elsif ($rpmlist[$i]{$l}{$_}{limit}) { $groups->[$i]{limit}{$_} = 1; push @limit, $elt } else { push @b, $elt } push @{$needed[$i]{$l}{alap}[$rpmlist[$i]{$l}{$_}{needed}]}, $elt, if $rpmlist[$i]{$l}{$_}{needed}; # used to check which packages has beed rejected push @{$groups->[$i]{buildlist}}, $_ } $buildlist[$i]{$l} = [ sort { $a->[2] <=> $b->[2] } @b ]; unshift @{$buildlist[$i]{$l}}, sort { $a->[2] <=> $b->[2] } @limit; # needed must not be put first. #push @{$buildlist[$i]{$l}}, sort { $a->[2] <=> $b->[2] } @need; push @{$buildlist[$i]{$l}}, sort { $a->[2] <=> $b->[2] } @force; push @{$buildlist[$i]{$l}}, sort { $a->[2] <=> $b->[2] } @superforce } } # FIXME it must have a cleaner manner to keep buildlist and do not have # to copy it. my @cb; for (my $i = 0; $i < @buildlist; $i++) { foreach my $l (keys %{$buildlist[$i]}) { $cb[$i]{$l} = []; foreach (@{$buildlist[$i]{$l}}) { log_("MakeWithGroups: copying buildlist group $i list $l package $_->[0] score $_->[2] options " . join(' ', keys %{$_->[1]}) . "\n", $config->{verbose}, $log, 4); push @{$cb[$i]{$l}}, $_ } } } my $diff = { data => [], idx => [] }; my $rejected; my $n=1; $rejected = $class->{build}->buildDiscs($groups, \@cb, \@rpmlist, \@groupok, $size, $cdsize,$lists,$cds, \@needed,$diff,$n) if @cb; my $logi; my ($cd, $diff) = $class->{build}->processDiff($groups,$diff, $discs_files); my $ok; # discs_files contains all the rpms, cd contains only the diff log_("make_io_group: $cd->[2]\n", $config->{verbose}, $log, 3); $class->{disc}->makeDiscs(1,$lists,$cds, $size, $mkisos, $discs_files, $graft, $sort, $inode, $cd) or return 0; $ok = $class->{disc}->checkSize($n, $size, $cdsize, $cds, $rejected); #log_("make_io_group: disc_building_tries $config->{disc_building_tries}\n",1,$log); $ok = 1 if $config->{disc_building_tries} < 2; while (!$ok) { $n++; log_("make_io_group: trying to adjust disc size, try $n\n", $config->{verbose}, $log, 3); $ok = 1; my @cb; for (my $i; $i < @buildlist; $i++) { foreach my $l (keys %{$buildlist[$i]}) { $cb[$i]{$l} = []; foreach (@{$buildlist[$i]{$l}}) { push @{$cb[$i]{$l}}, $_ if $groups->[$i]{rejected}{$_->[0]}{$l} } } } $rejected = $class->{build}->buildDiscs($groups, \@cb, \@rpmlist, \@groupok, $size, $cdsize, $lists, $cds, \@needed, $diff, $n) if @cb; my ($cd, $diff) = $class->{build}->processDiff($groups, $diff, $discs_files); $class->{disc}->makeDiscs($n, $lists, $cds, $size, $mkisos, $discs_files, $graft, $sort, $inode, $cd) or return 0; $ok = $class->{disc}->checkSize($n, $size, $cdsize, $cds, $rejected); !$ok and log_("ERROR: one or more disc are too big or too small, trying to correct\n", $config->{verbose}, $log, 2); if ($n >= $config->{disc_building_tries}) { log_("ERROR: could not manage to build discs of correct size, exiting\n", $config->{verbose}, $log); last } } # finally really build the ISOs if ($config->{nofork}) { $class->{disc}->makeDiscs(-1, $lists, $cds, $size, $mkisos, $discs_files, $graft, $sort, $inode, $cd); } else { # FIXME This algo is not correct, it happens that some IO tasks are still parallelized my $pid = fork; $pid and log_("make_io_group: fork to PID $pid to build ISO files\n", $config->{verbose}, $log, 1); if (!$pid) { while (@$iotask) { my $p = pop @$iotask; log_("make_io_group: waiting for IOtask PID $p to finish\n", $config->{verbose}, $log, 2); waitpid $p, 0 } $class->{disc}->makeDiscs(-1, $lists, $cds, $size, $mkisos, $discs_files, $graft, $sort, $inode, $cd); exit } else { push @$iotask, $pid } } for (my $i; $i < @$groups; $i++) { foreach my $list (keys %{$groups->[$i]{list}}) { foreach my $type (keys %{$groups->[$i]{list}{$list}}) { foreach (@{$groups->[$i]{list}{$list}{$type}}) { $config->{list}[$list]{disc}{$_->[0]}{$_->[1]}{done} = 1 } } } } } sub makeWithGroups { my ($class, $lists, $acds) = @_; my $config = $class->{config}; my $log = $config->{LOG}; my $metagroups = orderGroups($config, getGroups($config, $lists), $lists, $acds); my @discsFiles; my (@cdsize, %size, %graft, %sort, %done_deps, %inode, @iotask, @mkisos); for (my $i; $i < @{$config->{disc}}; $i++) { $cdsize[$i] = $config->{disc}[$i]{size}; $size{optimize_space}{disc}{$i} = $cdsize[$i] } foreach my $iog (@$metagroups) { foreach (@$iog) { ref $_->[1] or next; log_("makeWithGroups: Group listing $_ (@{$_->[1]} -- $_->[0])\n", $config->{verbose}, $config->{LOG}, 3); my $cds = $_->[1]; # Do not make first CDs in io groups to keep inter io groups alone directories safe. $class->{disc}->makeDiscs(0, $lists, $cds, \%size, \@mkisos, \@discsFiles, \%graft, \%sort, \%inode); } } $config->{cpu} = find_cpu() if !$config->{cpu}; log_("makeWithGroups: will try to use $config->{cpu} CPUs\n", $config->{verbose}, $config->{LOG}, 3); foreach my $g (@$metagroups) { foreach my $iog (@$g) { make_io_group($class, $iog, $config, $log, $lists, \@discsFiles, \@cdsize, \%size, \%graft, \%sort, \%inode, \%done_deps, \@iotask, $metagroups, \@mkisos); } } printDiscsFile($config, \@discsFiles, $config->{print}, $metagroups); $config->{printscript} and printBatchFile($config, \@discsFiles, $config->{printscript}); foreach my $p (@iotask) { waitpid $p, 0 } print "\n"; 1 } 1 # # Changelog # # 2002 02 21 # add maxlistmaxrep value to group # # 2002 03 03 # change size to an hash that contains disc size and rep size # # 2002 03 09 # make group{discrep} and hash not to have loop in disc dependencies when there are multiple repository on one CD # # 2002 03 14 # BIG change of group source handling # # 2002 03 15 # use new source handling # # 2002 03 23 # change getAlone to be able to build generic CDs without installation # # 2002 06 16 # add conflict in group # # 2002 08 30 # change reps structure, add pkg and pkg_rep in group # # 2004 05 28 # add IO group to be able to separate IO tasks from CPU tasks