*** empty log message ***

1 files changed, 102 insertions, 17 deletions

diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index 020ccf7c2..a9eef2b89 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -352,28 +352,57 @@ sub getHeader($) {
     $p->{header};
 }
 
-sub selectPackagesToUpgrade($$$) {
-    my ($packages, $prefix, $base) = @_;
+sub versionCompare($$) {
+    my ($a, $b) = @_;
+    local $_;
+
+    while ($a && $b) {
+	my ($sb, $sa) =  map { $1 if $a =~ /^\W*\d/ ? s/^\W*0*(\d+)// : s/^\W*(\D+)// } ($b, $a);
+	$_ = length($sa) cmp length($sb) || $sa cmp $sb and return $_;
+    }
+}
+
+sub selectPackagesToUpgrade($$$;$) {
+    my ($packages, $prefix, $base, $toRemove) = @_;
 
     log::l("reading /usr/lib/rpm/rpmrc");
     c::rpmReadConfigFiles() or die "can't read rpm config files";
     log::l("\tdone");
 
     my $db = c::rpmdbOpenForTraversal($prefix) or die "unable to open $prefix/var/lib/rpm/packages.rpm";
+    log::l("opened rpm database for examining existing packages");
+
+    local $_; #- else perl complains on the map { ... } grep { ... } @...;
     my %installedFilesForUpgrade; #- help searching package to upgrade in regard to already installed files.
 
+    #- help removing package which may have different release numbering
+    my %toRemove;
+    map { $toRemove{$_} = 1 } @{$toRemove || []};
+
     #- mark all files which are not in /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.
     c::rpmdbTraverse($db, sub {
 			 my ($header) = @_;
 			 my $p = $packages->{c::headerGetEntry($header, 'name')};
+			 my $otherPackage = (c::headerGetEntry($header, 'release') !~ /mdk\w*$/ &&
+					     (c::headerGetEntry($header, 'name'). '-' .
+					      c::headerGetEntry($header, 'version'). '-' .
+					      c::headerGetEntry($header, 'release')));
 			 if ($p) {
-			     eval { getHeader($p) }; $@ && log::l("cannot get the header for package $p->{name}"); #- not having a header will cause using a bad test for version, should change but a header should always be available.
-			     $p->{installed} = 1 if $p->{header} ? c::rpmVersionCompare($header, $p->{header}) >= 0 : c::headerGetEntry($header, 'version') ge $p->{version};
+			     if ($otherPackage && versionCompare(c::headerGetEntry($header, 'version'), $p->{version}) <= 0) {
+				 $toRemove{$otherPackage} = 1;
+			     } else {
+				 eval { getHeader($p) }; $@ && log::l("cannot get the header for package $p->{name}");
+				 $p->{installed} = 1 if $p->{header} ?
+				   c::rpmVersionCompare($header, $p->{header}) >= 0 :
+				       (versionCompare(c::headerGetEntry($header, 'version'), $p->{version}) > 0 ||
+					versionCompare(c::headerGetEntry($header, 'version'), $p->{version}) == 0 &&
+					versionCompare(c::headerGetEntry($header, 'release'), $p->{release} >= 0));
+			     }
 			 } else {
-			     my @installedFiles = c::headerGetEntry($header, 'filenames');
-			     @installedFilesForUpgrade{grep { $_ !~ m@^/etc/rc.d/@ } @installedFiles} = ();
+			     my @files = c::headerGetEntry($header, 'filenames');
+			     map { $installedFilesForUpgrade{$_} = $otherPackage } grep { $_ !~ m@^/etc/rc.d/@ } @files;
 			 }
 		     });
 
@@ -400,13 +429,18 @@ sub selectPackagesToUpgrade($$$) {
 	    #- all file for package marked for upgrade.
 	    c::rpmdbNameTraverse($db, $p->{name}, sub {
 				     my ($header) = @_;
+				     my $otherPackage = (c::headerGetEntry($header, 'release') !~ /mdk\w*$/ &&
+							 (c::headerGetEntry($header, 'name'). '-' .
+							  c::headerGetEntry($header, 'version'). '-' .
+							  c::headerGetEntry($header, 'release')));
 				     $cumulSize += c::headerGetEntry($header, 'size'); #- all these will be deleted on upgrade.
-				     my @installedFiles = c::headerGetEntry($header, 'filenames');
-				     @installedFilesForUpgrade{ grep { $_ !~ m@^/etc/rc.d/@ } @installedFiles} = ();
+				     $toRemove{$otherPackage} = 1;
+				     my @files = c::headerGetEntry($header, 'filenames');
+				     map { $installedFilesForUpgrade{$_} = $otherPackage } grep { $_ !~ m@^/etc/rc.d/@ } @files;
 				 });
 	    eval { getHeader($p) };
 	    my @availFiles = $p->{header} ? c::headerGetEntry($p->{header}, 'filenames') : ();
-	    map { delete $installedFilesForUpgrade{$_} } grep { $_ !~ m@^/etc/rc.d/@ } @availFiles;
+	    map { $toRemove{delete $installedFilesForUpgrade{$_}} = 1 } grep { $_ !~ m@^/etc/rc.d/@ } @availFiles;
 
 	    #- keep in mind the cumul size of installed package since they will be deleted
 	    #- on upgrade.
@@ -422,7 +456,7 @@ sub selectPackagesToUpgrade($$$) {
 	if ($p->{selected}) {
 	    eval { getHeader($p) };
 	    my @availFiles = $p->{header} ? c::headerGetEntry($p->{header}, 'filenames') : ();
-	    map { delete $installedFilesForUpgrade{$_} } grep { $_ !~ m@^/etc/rc.d/@ } @availFiles;
+	    map { $toRemove{delete $installedFilesForUpgrade{$_}} = 1 } grep { $_ !~ m@^/etc/rc.d/@ } @availFiles;
 	}
     }
 
@@ -435,7 +469,8 @@ sub selectPackagesToUpgrade($$$) {
 	    my @availFiles = $p->{header} ? c::headerGetEntry($p->{header}, 'filenames') : ();
 	    my $toSelect = 0;
 	    map { if (exists $installedFilesForUpgrade{$_}) {
-		$toSelect = 1; delete $installedFilesForUpgrade{$_} } } grep { $_ !~ m@^/etc/rc.d/@ } @availFiles;
+		$toSelect = $toRemove{delete $installedFilesForUpgrade{$_}} = 1; }
+	      } grep { $_ !~ m@^/etc/rc.d/@ } @availFiles;
 	    pkgs::select($packages, $p) if ($toSelect);
 	}
     }
@@ -457,9 +492,15 @@ sub selectPackagesToUpgrade($$$) {
 	pkgs::select($packages, $p, 1) unless $p->{selected}; #- if installed it cannot be selected.
     }
 
+    #- clean false value on toRemove.
+    delete $toRemove{''};
+
     #- close db, job finished !
     c::rpmdbClose($db);
     log::l("done selecting packages to upgrade");
+
+    #- update external copy with local one.
+    @{$toRemove || []} = keys %toRemove;
 }
 
 sub installCallback {
@@ -468,16 +509,18 @@ sub installCallback {
     log::l($msg .": ". join(',', @_));
 }
 
-sub install($$) {
-    my ($prefix, $toInstall) = @_;
+sub install($$$) {
+    my ($prefix, $isUpgrade, $toInstall) = @_;
     my %packages;
 
     return if $::g_auto_install;
 
+    log::l("reading /usr/lib/rpm/rpmrc");
     c::rpmReadConfigFiles() or die "can't read rpm config files";
+    log::l("\tdone");
 
     my $db = c::rpmdbOpen($prefix) or die "error opening RPM database: ", c::rpmErrorString();
-    log::l("opened rpm database");
+    log::l("opened rpm database for installing new packages");
 
     my $trans = c::rpmtransCreateSet($db, $prefix);
 
@@ -489,7 +532,7 @@ sub install($$) {
 	                       $p->{name}, $p->{version}, $p->{release},
 			       c::headerGetEntry(getHeader($p), 'arch');
 	$packages{$p->{name}} = $p;
-	c::rpmtransAddPackage($trans, getHeader($p), $p->{name}, $p->{name} !~ /kernel/); #- TODO: replace `named kernel' by `provides kernel'
+	c::rpmtransAddPackage($trans, getHeader($p), $p->{name}, $isUpgrade && $p->{name} !~ /kernel/); #- TODO: replace `named kernel' by `provides kernel'
 	$nb++;
 	$total += $p->{size};
     }
@@ -512,8 +555,6 @@ sub install($$) {
     };
     my $callbackClose = sub { $packages{$_[0]}{installed} = 1; };
     my $callbackMessage = \&pkgs::installCallback;
-#-    my $callbackStart = sub { log::ld("starting installing package ", $_[0]) };
-#-    my $callbackProgress = sub { log::ld("progressing installation ", $_[0], "/", $_[1]) };
 
     #- do not modify/translate the message used with installCallback since
     #- these are keys during progressing installation, or change in other
@@ -534,4 +575,48 @@ sub install($$) {
     log::l("rpm database closed");
 }
 
+sub remove($$) {
+    my ($prefix, $toRemove) = @_;
+
+    return if $::g_auto_install || !@{$toRemove || []};
+
+    log::l("reading /usr/lib/rpm/rpmrc");
+    c::rpmReadConfigFiles() or die "can't read rpm config files";
+    log::l("\tdone");
+
+    my $db = c::rpmdbOpen($prefix) or die "error opening RPM database: ", c::rpmErrorString();
+    log::l("opened rpm database for removing old packages");
+
+    my $trans = c::rpmtransCreateSet($db, $prefix);
+
+    foreach my $p (@$toRemove) {
+	#- stuff remove all packages that matches $p, not a problem since $p has name-version-release format.
+	c::rpmtransRemovePackages($db, $trans, $p) if $p !~ /kernel/;
+    }
+
+    eval { fs::mount("/proc", "$prefix/proc", "proc", 0) };
+
+    my $callbackOpen = sub { log::l("trying to open file from $_[0] which should not happen"); };
+    my $callbackClose = sub { log::l("trying to close file from $_[0] which should not happen"); };
+    my $callbackMessage = \&pkgs::installCallback;
+
+    #- we are not checking depends since it should come when
+    #- upgrading a system. although we may remove some functionalities ?
+
+    #- do not modify/translate the message used with installCallback since
+    #- these are keys during progressing installation, or change in other
+    #- place (install_steps_gtk.pm,...).
+    &$callbackMessage("Starting removing other packages", scalar @$toRemove);
+
+    if (my @probs = c::rpmRunTransactions($trans, $callbackOpen, $callbackClose, $callbackMessage, 0)) {
+	die "removing of old rpms failed:\n  ", join("\n  ", @probs);
+    }
+    c::rpmtransFree($trans);
+    c::rpmdbClose($db);
+    log::l("rpm database closed");
+
+    #- keep in mind removing of these packages by cleaning $toRemove.
+    @{$toRemove || []} = ();
+}
+
 1;