revert previous commit: compute_deps() is still used by mkcd

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.