From e63b7115099a54abb6af829d96d1eae603c78039 Mon Sep 17 00:00:00 2001
From: Francois Pons <fpons@mandriva.com>
Date: Thu, 27 Jun 2002 09:48:15 +0000
Subject: 3.6-1mdk with remove support.

---
 urpm.pm | 456 +---------------------------------------------------------------
 1 file changed, 4 insertions(+), 452 deletions(-)

(limited to 'urpm.pm')

diff --git a/urpm.pm b/urpm.pm
index d75a2246..64925093 100644
--- a/urpm.pm
+++ b/urpm.pm
@@ -3,7 +3,7 @@ package urpm;
 use strict;
 use vars qw($VERSION @ISA);
 
-$VERSION = '3.5';
+$VERSION = '3.6';
 @ISA = qw(URPM);
 
 =head1 NAME
@@ -740,14 +740,15 @@ sub update_media {
 		  $error = 1, $urpm->{error}(_("copy of [%s] failed", "$with_hdlist_dir"));
 
 		#- check if the file are equals... and no force copy...
-		unless ($error || $options{force}) {
+		unless ($error || $options{force} || ! -e "$urpm->{statedir}/synthesis.$medium->{hdlist}") {
 		    my @sstat = stat "$urpm->{cachedir}/partial/$medium->{hdlist}";
 		    my @lstat = stat "$urpm->{statedir}/$medium->{hdlist}";
 		    if ($sstat[7] == $lstat[7] && $sstat[9] == $lstat[9]) {
 			#- the two files are considered equal here, the medium is so not modified.
 			$medium->{modified} = 0;
 			unlink "$urpm->{cachedir}/partial/$medium->{hdlist}";
-			#- as previously done, just read synthesis file here, this is enough.
+			#- as previously done, just read synthesis file here, this is enough, but only
+			#- if synthesis exists, else it need to be recomputed.
 			$urpm->{log}(_("examining synthesis file [%s]", "$urpm->{statedir}/synthesis.$medium->{hdlist}"));
 			($medium->{start}, $medium->{end}) = $urpm->parse_synthesis("$urpm->{statedir}/synthesis.$medium->{hdlist}");
 			unless (defined $medium->{start} && defined $medium->{end}) {
@@ -1404,282 +1405,6 @@ sub search_packages {
     $result;
 }
 
-#- filter minimal list, upgrade packages only according to rpm requires
-#- satisfied, remove upgrade for package already installed or with a better
-#- version, try to upgrade to minimize upgrade errors.
-#- all additional package selected have a true value.
-sub filter_packages_to_upgrade {
-    my ($urpm, $db, $packages, $select_choices, %options) = @_;
-    my ($id, %track, %track_requires, %installed, %selected, %conflicts);
-    my @packages = keys %$packages;
-
-    #- at this level, compute global closure of what is requested, regardless of
-    #- choices for which all package in the choices are taken and their dependencies.
-    #- allow iteration over a modifying list.
-    while (defined($id = shift @packages)) {
-	$id =~ /\|/ and delete $packages->{$id}, $id = [ split '\|', $id ]; #- get back choices...
-	if (ref $id) {
-	    my (@forced_selection, @selection);
-
-	    #- at this point we have almost only choices to resolves.
-	    #- but we have to check if one package here is already selected
-	    #- previously, if this is the case, use it instead.
-	    #- if a choice is proposed with package already installed (this is the case for
-	    #- a provide with a lot of choices, we have to filter according to those who
-	    #- are installed).
-	    foreach (@$id) {
-		my $pkg = $urpm->{depslist}[$_];
-		$pkg->arch eq 'src' and return;
-		my $count = $options{keep_alldeps} || exists $installed{$pkg->id} ? 0 :
-		  $db->traverse_tag('name', [ $pkg->name ], sub {
-					my ($p) = @_;
-					$installed{$pkg->id} ||= $pkg->compare_pkg($p) <= 0;
-				    });
-		if (exists $packages->{$_} || $count > 0) {
-		    $installed{$pkg->id} or push @forced_selection, $_;
-		} else {
-		    push @selection, $_;
-		}
-	    }
-
-	    #- propose the choice to the user now, or select the best one (as it is supposed to be).
-	    @selection = @forced_selection ? @forced_selection :
-	      $select_choices ? (@selection > 1 ? ($select_choices->($urpm, undef, @selection)) : ($selection[0])) :
-		(join '|', @selection);
-	    foreach (@selection) {
-		unless (exists $packages->{$_}) {
-		    /\|/ or unshift @packages, $_;
-		    $packages->{$_} = 1;
-		}
-	    }
-	    next;
-	}
-	my $pkg = $urpm->{depslist}[$id];
-	defined $pkg->id or next; #- id has been removed for package that only exists on some arch.
-
-	#- search for package that will be upgraded, and check the difference
-	#- of provides to see if something will be altered and need to be upgraded.
-	#- this is bogus as it only take care of == operator if any.
-	#- defining %provides here could slow the algorithm but it solves multi-pass
-	#- where a provides is A and after A == version-release, when A is already
-	#- installed.
-	my (%diff_provides, %provides);
-
-	if ($pkg->arch ne 'src') {
-	    my @upgraded;
-
-	    foreach ($pkg->name, $pkg->obsoletes) {
-		if (my ($n, $o, $v) = /^([^\s\[]*)(?:\[\*\])?(?:\s+|\[)?([^\s\]]*)\s*([^\s\]]*)/) {
-		    $db->traverse_tag('name', [ $n ], sub {
-					  my ($p) = @_;
-					  eval($p->compare($v) . $o . 0) or return;
-					  $options{track} and $p->pack_header, push @upgraded, $p;
-					  foreach ($p->provides) {
-					      s/\[\*\]//;
-					      s/\[([^\]]*)\]/ $1/;
-					      $diff_provides{$_} = $p->fullname;
-					  }
-				      });
-		}
-	    }
-	    $options{track} and $track{$pkg->id}{upgraded} = \@upgraded;
-
-	    foreach ($pkg->provides) {
-		s/\[\*\]//;
-		s/\[([^\]]*)\]/ $1/;
-		delete $diff_provides{$_};
-	    }
-
-	    foreach (keys %diff_provides) {
-		#- analyse the difference in provides and select other package.
-		if (my ($n, $o, $v) = /^(\S*)\s*(\S*)\s*(\S*)/) {
-		    my $check = sub {
-			my ($p) = @_;
-			my ($needed, $satisfied) = (0, 0);
-			foreach ($p->requires) {
-			    if (my ($pn, $po, $pv) = /^([^\s\[]*)(?:\[\*\])?(?:\s+|\[)?([^\s\]]*)\s*([^\s\]]*)/) {
-				if ($po || $o) {
-				    $pn eq $n && $pn eq $pkg->name or next;
-				    ++$needed;
-				    eval($pkg->compare($pv) . $po . 0) or next;
-				    #- an existing provides (propably the one examined) is satisfying the underlying.
-				    ++$satisfied;
-				} else {
-				    $pn eq $n or next;
-				    #- a property has been removed since in diff_provides.
-				    ++$needed;
-				}
-			    }
-			}
-			#- check if the package need to be updated because it
-			#- losts some of its requires regarding the current diff_provides.
-			if ($needed > $satisfied) {
-			    $selected{$p->name} ||= undef;
-			    if ($options{track}) {
-				$p->pack_header;
-				push @{$track{$pkg->id}{diff_provides} ||= []}, $p;
-			    }
-			}
-		    };
-		    $db->traverse_tag('whatrequires', [ $n ], $check);
-		}
-	    }
-
-	    $selected{$pkg->name} ||= undef;
-	}
-
-	#- iterate over requires of the packages, register them.
-	foreach ($pkg->requires) {
-	    if (my ($n, $o, $v) = /^([^\s\[]*)(?:\[\*\])?(?:\s+|\[)?([^\s\]]*)\s*([^\s\]]*)/) {
-		exists $provides{$_} and next;
-		#- if the provides is not found, it will be resolved at next step, else
-		#- it will be resolved by searching the rpm database.
-		$provides{$_} ||= undef;
-		unless ($options{keep_alldeps}) {
-		    my $check_pkg = sub {
-			my ($p) = @_;
-			exists $selected{$p->name} and return;
-			$o and $n eq $p->name || return;
-			eval($p->compare($v) . $o . 0) or return;
-			$provides{$_} = $p->fullname;
-		    };
-		    $db->traverse_tag($n =~ m|^/| ? 'path' : 'whatprovides', [ $n ], $check_pkg);
-		}
-		$options{track} and $track_requires{$_}{$pkg->id} = $_;
-	    }
-	}
-
-	#- examine conflicts and try to resolve them.
-	#- if there is a conflicts with a too old version, it need to be upgraded.
-	#- if there is a provides (by using a obsoletes on it too), examine obsolete (provides) too.
-	foreach ($pkg->conflicts) {
-	    if (my ($n, $o, $v) = /^([^\s\[]*)(?:\[\*\])?(?:\s+|\[)?([^\s\]]*)\s*([^\s\]]*)/) {
-		my $check_pkg = sub {
-		    my ($p) = @_;
-		    $o and $n eq $p->name || return;
-		    eval($p->compare($v) . $o . 0) or return;
-		    $conflicts{$p->fullname} = 1;
-		    $selected{$p->name} ||= undef;
-		    if ($options{track}) {
-			$p->pack_header;
-			push @{$track{$pkg->id}{conflicts} ||= []}, $p;
-		    }
-		};
-		$db->traverse_tag($n =~ m|^/| ? 'path' : 'whatprovides', [ $n ], $check_pkg);
-		foreach my $id (keys %{$urpm->{provides}{$n} || {}}) {
-		    my $p = $urpm->{depslist}[$id];
-		    $p->arch eq 'src' and next;
-		    $o and $n eq $p->name || next;
-		    eval($p->compare($v) . $o . 0) or next;
-		    $conflicts{$p->fullname} ||= 0;
-		}
-	    }
-	}
-
-	#- at this point, all unresolved provides (requires) should be fixed by
-	#- provides files, try to minimize choice at this level.
-	foreach (keys %provides, grep { !$selected{$_} } keys %selected) {
-	    my (%pre_choices, @pre_choices, @choices, @upgradable_choices, %choices_id);
-	    if (my ($n, $o, $v) = /^([^\s\[]*)(?:\[\*\])?(?:\s+|\[)?([^\s\]]*)\s*([^\s\]]*)/) {
-		$provides{$_} and next;
-
-		foreach my $id (keys %{$urpm->{provides}{$n} || {}}) {
-		    my $pkg = $urpm->{depslist}[$id];
-		    exists $conflicts{$pkg->fullname} and next;
-		    $pkg->arch eq 'src' and next;
-		    $selected{$n} || $selected{$pkg->name} and %pre_choices=(), last;
-		    #- check if a unsatisfied selection on a package is needed,
-		    #- which need a obsolete on a package with different name or
-		    #- a package with the given name.
-		    #- if an obsolete is given, it will be satisfied elsewhere. CHECK TODO
-		    if ($n ne $pkg->name) {
-			unless (exists $selected{$n}) {
-			    #- a virtual provides exists with a specific version and maybe release.
-			    #- try to resolve.
-			    foreach ($pkg->provides) {
-				if (my ($pn, $po, $pv) = /^([^\s\[]*)(?:\[\*\])?(?:\s+|\[)?([^\s\]]*)\s*([^\s\]]*)/) {
-				    $pn eq $n or next;
-				    my $no = $po eq '==' ? $o : $po; #- CHECK TODO ?
-#TODO				    (!$pv || !$v || eval(rpmtools::version_compare($pv, $v) . $no . 0)) &&
-#TODO				      (!$pr || !$r || rpmtools::version_compare($pv, $v) != 0 ||
-#TODO				       eval(rpmtools::version_compare($pr, $r) . $no . 0)) or next;
-				    push @{$pre_choices{$pkg->name}}, $pkg;
-				}
-			    }
-			}
-		    } else {
-			eval($pkg->compare($v) . $o . 0) or next;
-			push @{$pre_choices{$pkg->name}}, $pkg;
-		    }
-		}
-	    }
-	    foreach (values %pre_choices) {
-		#- there is at least one element in each list of values.
-		if (@$_ == 1) {
-		    push @pre_choices, $_->[0];
-		} else {
-		    #- take the best one, according to id used.
-		    my $chosen_pkg;
-		    foreach my $id (%$packages) {
-			my $candidate_pkg = $urpm->{depslist}[$id];
-			$candidate_pkg->name eq $pkg->name or next;
-			foreach my $pkg (@$_) {
-			    $pkg == $candidate_pkg and $chosen_pkg = $pkg, last;
-			}
-		    }
-		    $chosen_pkg ||= $urpm->{names}{$_->[0]->name}; #- at least take the best normally used.
-		    push @pre_choices, $chosen_pkg;
-		}
-	    }
-	    foreach my $pkg (@pre_choices) {
-		push @choices, $pkg;
-
-		$pkg->arch eq 'src' and return;
-		unless ($options{keep_alldeps} || exists $installed{$pkg->id}) {
-		    $db->traverse_tag('name', [ $pkg->name ], sub {
-					  my ($p) = @_;
-					  $installed{$pkg->id} ||= $pkg->compare_pkg($p) <= 0;
-				      });
-		}
-		$installed{$pkg->id} and delete $packages->{$pkg->id};
-		exists $installed{$pkg->id} and push @upgradable_choices, $pkg;
-	    }
-	    foreach my $pkg (@pre_choices) {
-		if (exists $packages->{$pkg->id} || $installed{$pkg->id}) {
-		    #- the package is already selected, or installed with a better version and release.
-		    @choices = @upgradable_choices = ();
-		    last;
-		}
-	    }
-	    @upgradable_choices > 0 and @choices = @upgradable_choices;
-	    $choices_id{$_->id} = $_ foreach @choices;
-	    if (keys(%choices_id) == 1) {
-		my ($id) = keys(%choices_id);
-		$selected{$choices_id{$id}->name} = 1;
-		unless ($packages->{$id}) {
-		    $packages->{$id} = 1;
-		    if ($options{track} && $track_requires{$_}) {
-			foreach my $deps (keys %{$track_requires{$_}}) {
-			    $track{$deps}{requires}{$id} = $_;
-			}
-		    }
-		}
-		unshift @packages, $id;
-	    } elsif (keys(%choices_id) > 1) {
-		push @packages, [ sort { $a <=> $b } keys %choices_id ];
-		if ($options{track} && $track_requires{$_}) {
-		    foreach my $deps (keys %{$track_requires{$_}}) {
-			$track{$deps}{requires}{join '|', sort { $a <=> $b } keys %choices_id} = $_;
-		    }
-		}
-	    }
-	}
-    }
-
-    #- rpm db will be closed automatically on destruction of $db.
-    \%track;
-}
-
 #- get out of package that should not be upgraded.
 sub deselect_unwanted_packages {
     my ($urpm, $packages, %options) = @_;
@@ -1952,177 +1677,4 @@ sub extract_packages_to_install {
     \%inst;
 }
 
-sub select_packages_to_upgrade {
-    my ($urpm, $db, $packages, $remove_packages, $keep_files, %options) = @_;
-
-    #- used for package that are not correctly updated.
-    #- should only be used when nothing else can be done correctly.
-    my %upgradeNeedRemove = (
-			     #'libstdc++' => 1,
-			     #'compat-glibc' => 1,
-			     #'compat-libs' => 1,
-			    );
-
-    #- installed flag on id.
-    my %installed;
-
-    #- help removing package which may have different release numbering
-    my %toRemove;
-
-    #- help searching package to upgrade in regard to already installed files.
-    my %installedFilesForUpgrade;
-
-    #- help keeping memory by this set of package that have been obsoleted.
-    my %obsoletedPackages;
-
-    #- select packages which obseletes other package, obselete package are not removed,
-    #- should we remove them ? this could be dangerous !
-    foreach my $pkg (@{$urpm->{depslist}}) {
-	defined $pkg->id && $pkg->arch ne 'src' or next;
-	foreach ($pkg->obsoletes) {
-	    #- take care of flags and version and release if present
-	    if (my ($n,$o,$v) = /^([^\s\[]*)(?:\[\*\])?(?:\s+|\[)?([^\s\]]*)\s*([^\s\]]*)/) {
-		my $obsoleted = 0;
-		my $check_obsoletes = sub {
-		    my ($p) = @_;
-		    eval($p->compare($v) . $o . 0) or return;
-		    ++$obsoleted;
-		};
-		$db->traverse_tag("name", [ $n ], $check_obsoletes);
-		if ($obsoleted > 0) {
-		    $urpm->{log}(_("selecting %s using obsoletes", $pkg->fullname));
-		    $obsoletedPackages{$n} = undef;
-		    exists $packages->{$pkg->id} or $packages->{$pkg->id} = 1;
-		}
-	    }
-	}
-    }
-
-    #- mark all files which are not in /dev or /etc/rc.d/ for packages which are already installed
-    #- but which are not in the packages list to upgrade.
-    #- the 'installed' property will make a package unable to be selected, look at select.
-    $db->traverse(sub {
-		      my ($p) = @_;
-		      my $otherPackage = $p->release !~ /mdk\w*$/ && ($p->name.'-'.$p->version.'-'.$p->release);
-		      my $pkg = $urpm->{names}{$p->name};
-			  
-		      if ($pkg) {
-			  if ($p->compare_pkg($pkg) >= 0) {
-			      if ($otherPackage && $p->compare($pkg->version) <= 0) {
-				  $toRemove{$otherPackage} = 0;
-				  exists $packages->{$pkg->id} or $packages->{$pkg->id} = 1;
-				  $urpm->{log}(_("removing %s to upgrade to %s ...
-  since it will not be updated otherwise", $otherPackage, $pkg->name.'-'.$pkg->version.'-'.$pkg->release));
-			      } else {
-				  $installed{$pkg->id} = undef;
-			      }
-			  } elsif ($upgradeNeedRemove{$pkg->name}) {
-			      my $otherPackage = $p->name.'-'.$p->version.'-'.$p->release;
-			      $toRemove{$otherPackage} = 0;
-			      exists $packages->{$pkg->id} or $packages->{$pkg->id} = 1;
-			      $urpm->{log}(_("removing %s to upgrade to %s ...
-  since it will not upgrade correctly!", $otherPackage, $pkg->name.'-'.$pkg->version.'-'.$pkg->release));
-			  }
-		      } else {
-			  if (exists $obsoletedPackages{$p->name}) {
-			      @installedFilesForUpgrade{$p->upgrade_files} = ();
-			  }
-		      }
-		  });
-
-    #- find new packages to upgrade.
-    foreach my $pkg (@{$urpm->{depslist}}) {
-	defined $pkg->id && $pkg->arch ne 'src' or next;
-
-	my $skipThis = 0;
-	my $count = $db->traverse_tag("name", [ $pkg->name ], sub {
-					  $skipThis ||= exists $installed{$pkg->id};
-				      });
-
-	#- skip if not installed (package not found in current install).
-	$skipThis ||= ($count == 0);
-
-	#- select the package if it is already installed with a lower version or simply not installed.
-	unless ($skipThis) {
-	    my $cumulSize;
-
-	    exists $packages->{$pkg->id} or $packages->{$pkg->id} = 1;
-
-	    #- keep in mind installed files which are not being updated. doing this costs in
-	    #- execution time but use less memory, else hash all installed files and unhash
-	    #- all file for package marked for upgrade.
-	    $db->traverse_tag("name", [ $pkg->name ], sub {
-				  my ($p) = @_;
-				  @installedFilesForUpgrade{$p->upgrade_files} = ();
-			      });
-
-	    foreach ($pkg->files) {
-		delete $installedFilesForUpgrade{$_};
-	    }
-	}
-    }
-
-    #- unmark all files for all packages marked for upgrade. it may not have been done above
-    #- since some packages may have been selected by depsList.
-    foreach my $pkg (@{$urpm->{depslist}}) {
-	defined $pkg->id && $pkg->arch ne 'src' or next;
-	if (exists $packages->{$pkg->id}) {
-	    foreach ($pkg->files) {
-		delete $installedFilesForUpgrade{$_};
-	    }
-	}
-    }
-
-    #- select packages which contains marked files, then unmark on selection.
-    #- a special case can be made here, the selection is done only for packages
-    #- requiring locales if the locales are selected.
-    #- another special case are for devel packages where fixes over the time has
-    #- made some files moving between the normal package and its devel couterpart.
-    #- if only one file is affected, no devel package is selected.
-    foreach my $pkg (@{$urpm->{depslist}}) {
-	defined $pkg->id && $pkg->arch ne 'src' or next;
-	unless (exists $packages->{$pkg->id}) {
-	    my $toSelect = 0;
-	    foreach ($pkg->upgrade_files) {
-		delete $installedFilesForUpgrade{$_} and ++$toSelect;
-	    }
-	    if ($toSelect) {
-		if ($toSelect <= 1 && $pkg->name =~ /-devel/) {
-		    $urpm->{log}(_("avoid selecting %s as not enough files will be updated", $pkg->fullname));
-		} else {
-		    #- default case is assumed to allow upgrade.
-		    my @deps = grep { $_ } map { $urpm->{names}{$_} } grep { /locales-/ } $pkg->requires_nosense;
-		    if (@deps == 0 || @deps > 0 && (grep { ! exists $packages->{$pkg->id} &&
-							     ! exists $installed{$_->{id}} } @deps) == 0) {
-			$urpm->{log}(_("selecting %s by selection on files", $pkg->name));
-			$packages->{$pkg->id} = 1;
-		    } else {
-			$urpm->{log}(_("avoid selecting %s as its locales language is not already selected", $pkg->fullname));
-		    }
-		}
-	    }
-	}
-    }
-
-    #- clean memory...
-    %installedFilesForUpgrade = ();
-
-    #- clean false value on toRemove.
-    delete $toRemove{''};
-
-    #- get filenames that should be saved for packages to remove.
-    #- typically config files, but it may broke for packages that
-    #- are very old when compabilty has been broken.
-    #- but new version may saved to .rpmnew so it not so hard !
-    if ($keep_files && keys %toRemove) {
-	$db->traverse(sub {
-			  my ($p) = @_;
-			  my $otherPackage = $p->name.'-'.$p->version.'-'.$p->release;
-			  if (exists $toRemove{$otherPackage}) {
-			      @{$keep_files}{$p->conf_files} = ();
-			  }
-		      });
-    }
-}
-
 1;
-- 
cgit v1.2.1