diff options
Diffstat (limited to 'URPM')
| -rw-r--r-- | URPM/Build.pm | 214 |
1 files changed, 214 insertions, 0 deletions
diff --git a/URPM/Build.pm b/URPM/Build.pm index b1efee3..f5a3aff 100644 --- a/URPM/Build.pm +++ b/URPM/Build.pm @@ -179,6 +179,220 @@ sub fuzzy_parse { return (); } +# DEPRECATED. ONLY USED BY MKCD +#- compute dependencies, result in stored in info values of urpm. +#- operations are incremental, it is possible to read just one hdlist, compute +#- dependencies and read another hdlist, and again. +#- parameters are : +#- callback : callback to relocate reference to package id. +sub compute_deps { + my ($urpm, %options) = @_; + my %propagated_weight = ( + basesystem => 10000, + msec => 20000, + filesystem => 50000, + ); + my ($locales_weight, $step_weight, $fixed_weight) = (-5000, 10000, $propagated_weight{basesystem}); + + #- avoid recomputing already present infos, take care not to modify + #- existing entries, as the array here is used instead of values of infos. + my $start = @{$urpm->{deps} ||= []}; + my $end = $#{$urpm->{depslist} || []}; + + #- check if something has to be done. + $start > $end and return; + + #- keep track of prereqs. + my %prereqs; + + #- take into account in which hdlist a package has been found. + #- this can be done by an incremental take into account generation + #- of depslist.ordered part corresponding to the hdlist. + #- compute closed requires, do not take into account choices. + foreach ($start .. $end) { + my $pkg = $urpm->{depslist}[$_]; + + my %required_packages; + my @required_packages; + my %requires; + + foreach ($pkg->requires) { + my ($n, $prereq) = /^([^\s\[]*)(\[\*\])?/; + $requires{$n} = $prereq && 1; + } + my @requires = keys %requires; + + while (my $req = shift @requires) { + $req =~ /^basesystem/ and next; #- never need to requires basesystem directly as always required! what a speed up! + my $treq = ( + $req =~ /^\d+$/ ? [ $req ] + : $urpm->{provides}{$req} ? [ keys %{$urpm->{provides}{$req}} ] + : [ ($req !~ /NOTFOUND_/ ? "NOTFOUND_" : "") . $req ] + ); + if (@$treq > 1) { + #- this is a choice, no closure need to be done here. + push @required_packages, $treq; + } else { + #- this could be nothing if the provides is a file not found. + #- and this has been fixed above. + foreach (@$treq) { + my $pkg_ = /^\d+$/ && $urpm->{depslist}[$_]; + exists $required_packages{$_} and $pkg_ = undef; + $required_packages{$_} ||= $requires{$req}; $pkg_ or next; + foreach ($pkg_->requires_nosense) { + exists $requires{$_} or push @requires, $_; + $requires{$_} ||= $requires{$req}; + } + } + } + } + #- examine choice to remove those which are not mandatory. + foreach (@required_packages) { + unless (grep { exists $required_packages{$_} } @$_) { + $required_packages{join '|', sort { $a <=> $b } @$_} = undef; + } + } + + #- store a short representation of requires. + $urpm->{requires}[$_] = join ' ', keys %required_packages; + foreach my $d (keys %required_packages) { + $required_packages{$d} or next; + $prereqs{$d}{$_} = undef; + } + } + + #- expand choices and closure again. + my %ordered; + foreach ($start .. $end) { + my @requires = $_; + my ($dep, %requires); + while (defined ($dep = shift @requires)) { + exists $requires{$dep} || /^[^\d\|]*$/ and next; + foreach ($dep, split ' ', (defined $urpm->{deps}[$dep] ? $urpm->{deps}[$dep] : $urpm->{requires}[$dep])) { + if (/\|/) { + push @requires, split /\|/, $_; + } else { + /^\d+$/ and $requires{$_} = undef; + } + } + } + + my $pkg = $urpm->{depslist}[$_]; + my $delta = 1 + $propagated_weight{$pkg->name}; + foreach (keys %requires) { + $ordered{$_} += $delta; + } + } + + #- some package should be sorted at the beginning. + foreach (qw(basesystem msec rpm locales filesystem setup glibc sash bash libtermcap2 termcap readline ldconfig)) { + foreach (keys %{$urpm->{provides}{$_} || {}}) { + /^\d+$/ and $ordered{$_} = $fixed_weight; + } + /locales/ and $locales_weight += $fixed_weight; + $fixed_weight += $step_weight; + } + foreach ($start .. $end) { + my $pkg = $urpm->{depslist}[$_]; + + $pkg->name =~ /locales-[a-zA-Z]/ and $ordered{$_} = $locales_weight; + } + + #- compute base flag, consists of packages which are required without + #- choices of basesystem and are ALWAYS installed. these packages can + #- safely be removed from requires of others packages. + foreach (qw(basesystem glibc kernel)) { + foreach (keys %{$urpm->{provides}{$_} || {}}) { + foreach ($_, split ' ', (defined $urpm->{deps}[$_] ? $urpm->{deps}[$_] : $urpm->{requires}[$_])) { + /^\d+$/ and $urpm->{depslist}[$_] and $urpm->{depslist}[$_]->set_flag_base(1); + } + } + } + + #- give an id to each packages, start from number of package already + #- registered in depslist. + my %remap_ids; @remap_ids{sort { + exists $prereqs{$b}{$a} && ! exists $prereqs{$a}{$b} ? 1 : + $ordered{$b} <=> $ordered{$a} or do { + my ($na, $nb) = map { $urpm->{depslist}[$_]->name } ($a, $b); + my ($sa, $sb) = map { /^lib(.*)/ ? $1 : '' } ($na, $nb); + $sa && $sb ? $sa cmp $sb : $sa ? -1 : $sb ? 1 : $na cmp $nb; + } } ($start .. $end)} = ($start .. $end); + + #- now it is possible to clean ordered and prereqs. + %ordered = %prereqs = (); + + #- recompute requires to use packages id, drop any base packages or + #- reference of a package to itself. + my @depslist; + foreach ($start .. $end) { + my $pkg = $urpm->{depslist}[$_]; + + #- set new id. + $pkg->set_id($remap_ids{$_}); + + my ($id, $base, %requires_id, %not_founds); + foreach (split ' ', $urpm->{requires}[$_]) { + if (/\|/) { + #- all choices are grouped together at the end of requires, + #- this allow computation of dropable choices. + my ($to_drop, @choices_base_id, @choices_id); + foreach (split /\|/, $_) { + my ($id, $base) = (exists($remap_ids{$_}) ? $remap_ids{$_} : $_, $urpm->{depslist}[$_]->flag_base); + $base and push @choices_base_id, $id; + $base &&= ! $pkg->flag_base; + $to_drop ||= $id == $pkg->id || exists $requires_id{$id} || $base; + push @choices_id, $id; + } + + #- package can safely be dropped as it will be selected in requires directly. + $to_drop and next; + + #- if a base package is in a list, keep it instead of the choice. + if (@choices_base_id) { + @choices_id = @choices_base_id; + $base = 1; + } + if (@choices_id == 1) { + $id = $choices_id[0]; + } else { + my $choices_key = join '|', sort { $a <=> $b } @choices_id; + $requires_id{$choices_key} = undef; + next; + } + } elsif (/^\d+$/) { + ($id, $base) = (exists($remap_ids{$_}) ? $remap_ids{$_} : $_, $urpm->{depslist}[$_]->flag_base); + } else { + $not_founds{$_} = undef; + next; + } + + #- select individual package from choices or defined package. + $base &&= ! $pkg->flag_base; + $base || $id == $pkg->id or $requires_id{$id} = undef; + } + #- be smart with memory usage. + delete $urpm->{requires}[$_]; + $urpm->{deps}[$remap_ids{$_}] = join ' ', ((sort { ($a =~ /^(\d+)/)[0] <=> ($b =~ /^(\d+)/)[0] } keys %requires_id), + keys %not_founds); + $depslist[$remap_ids{$_}-$start] = $pkg; + } + + #- remap all provides ids for new package position and update depslist. + delete $urpm->{requires}; + @{$urpm->{depslist}}[$start .. $end] = @depslist; + foreach my $h (values %{$urpm->{provides}}) { + my %provided; + foreach (keys %{$h || {}}) { + $provided{exists($remap_ids{$_}) ? $remap_ids{$_} : $_} = delete $h->{$_}; + } + $h = \%provided; + } + $options{callback} and $options{callback}->($urpm, \%remap_ids, %options); + + ($start, $end); +} + #- build an hdlist from existing depslist, from start to end inclusive. #- parameters are : #- hdlist : hdlist file to use. |