4.0-10mdk

4 files changed, 147 insertions, 54 deletions

diff --git a/urpm.pm b/urpm.pm
index e67dc760..bfa3ea31 100644
--- a/urpm.pm
+++ b/urpm.pm
@@ -1710,7 +1710,7 @@ sub deselect_unwanted_packages {
 #- match exactly the number of medium registered, ignored medium always
 #- have a null list.
 sub get_source_packages {
-    my ($urpm, $packages) = @_;
+    my ($urpm, $packages, %options) = @_;
     my ($id, $error, %local_sources, @list, @local_to_removes, %fullname2id, %file2fullnames);
     local (*D, *F, $_);
 
@@ -1734,7 +1734,8 @@ sub get_source_packages {
     opendir D, "$urpm->{cachedir}/rpms";
     while (defined($_ = readdir D)) {
 	if (/([^\/]*)\.rpm/) {
-	    if (-s "$urpm->{cachedir}/rpms/$1.rpm") {
+	    if (!$options{clean} && -s "$urpm->{cachedir}/rpms/$1.rpm") {
+		#print STDERR "looking at $urpm->{cachedir}/rpms/$1.rpm\n";
 		if (keys(%{$file2fullnames{$1} || {}}) > 1) {
 		    $urpm->{error}(_("there are multiple packages with the same rpm filename \"%s\""), $1);
 		    next;
@@ -1745,9 +1746,13 @@ sub get_source_packages {
 		    } else {
 			push @local_to_removes, "$urpm->{cachedir}/rpms/$1.rpm";
 		    }
+		} else {
+		    push @local_to_removes, "$urpm->{cachedir}/rpms/$1.rpm";
 		}
 	    } else {
 		#- this is an invalid file in cache, remove it and ignore it.
+		#- or clean options has been given meaning ignore any file in cache
+		#- remove it too.
 		unlink "$urpm->{cachedir}/rpms/$1.rpm";
 	    }
 	} #- no error on unknown filename located in cache (because .listing)
@@ -1991,7 +1996,7 @@ sub install {
     my ($urpm, $remove, $install, $upgrade, %options) = @_;
     my $db = URPM::DB::open($urpm->{root}, !$options{test}); #- open in read/write mode unless testing installation.
     my $trans = $db->create_transaction($urpm->{root});
-    my @l;
+    my (@l, %file2pkg);
     local *F;
 
     foreach (@$remove) {
@@ -1999,11 +2004,13 @@ sub install {
     }
     foreach (keys %$install) {
 	my $pkg = $urpm->{depslist}[$_];
+	$file2pkg{$install->{$_}} = $pkg;
 	$pkg->update_header($install->{$_});
 	$trans->add($pkg, 0) or $urpm->{error}(_("unable to install package %s", $install->{$_}));
     }
     foreach (keys %$upgrade) {
 	my $pkg = $urpm->{depslist}[$_];
+	$file2pkg{$upgrade->{$_}} = $pkg;
 	$pkg->update_header($upgrade->{$_});
 	$trans->add($pkg, 1) or $urpm->{error}(_("unable to install package %s", $upgrade->{$_}));
     }
@@ -2034,6 +2041,20 @@ sub install {
 	$options{callback_trans} ||= \&install_logger;
     }
     @l = $trans->run($urpm, %options);
+
+    #- examine the local repository to delete package which have been installed.
+    if ($options{post_clean_cache}) {
+	foreach (keys %$install, keys %$upgrade) {
+	    my $pkg = $urpm->{depslist}[$_];
+	    $db->traverse_tag('name', [ $pkg->name ], sub {
+				  my ($p) = @_;
+				  $p->fullname eq $pkg->fullname or return;
+				  unlink "$urpm->{cachedir}/rpms/".$pkg->filename;
+			      });
+	}
+    }
+
+    @l;
 }
 
 #- install all files to node as remembered according to resolving done.
diff --git a/urpme b/urpme
index 675098e2..9bd8adde 100644
--- a/urpme
+++ b/urpme
@@ -18,7 +18,7 @@
 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
 #We only make good software ;-)
-use strict;
+#use strict;
 
 #use strict qw(subs vars refs);
 use URPM;
@@ -28,7 +28,7 @@ use urpm;
 #- get I18N translation method.
 import urpm _;
 
-my ($auto, $matches, $maymatch, @l, @m, @toremove);
+my ($auto, $matches, $maymatch, @l, @m, @toremove, %base);
 my $askok = _("Is it OK?");
 my $askrm = _("Remove them all?");
 # Translator: Add here the keys which might be pressed in the "No"-case.
@@ -46,43 +46,95 @@ if ( / --?h/ || @ARGV == 0 ) {
 $matches = / -a /;
 $auto = / --?auto /;
 
-@l = grep { !/^-/ } @ARGV;
-if (!$matches) {
-    @m = map { chop; $_ } `rpm -q @l 2>&1`;
-    if ($?) {
-	$maymatch = _("unknown package(s) ") . join(", ", map { /package (\S+) is not installed/ ? $1 : () } @m) . "\n";
-	$auto || @l > 1 and die $maymatch;
-    }
-}
-if ($matches || $maymatch) {
-    my $match = join "|", map { quotemeta } @l;
-    @m = grep { /$match/ } map { chop; $_ } `rpm -qa`;
-
-    if ($maymatch) {
-	@m or die $maymatch;
-        my $msg = _("Using \"%s\" as a substring, I found", $match);
-        print STDOUT "$msg:\n@m\n$askrm" . _(" (y/N) ");
-        <STDIN> =~ /[$yesexpr]/ or exit 1;
-    }
-}
-
-my $urpm = new urpm;
-my $state = {};
-
-my %base;
-my @base = qw(basesystem);
-my %basepackages;
+$urpm = new urpm;
+$state = {};
 
-#- closure all package asked to be removed.
+#- open database to examine packages...
 {
-    my $db = URPM::DB::open;
-    foreach (@m) {
-	my ($n) = /(.*)-[^-]*-[^-]*/;
-	$db->traverse_tag('name', [ $n ], sub {
-			      my ($p) = @_;
-			      join('-', ($p->fullname)[0..2]) eq $_ or return;
-			      $urpm->resolve_closure_ask_remove($db, $state, $p, undef);
-			  }) or die _("unknown package ") . "$_\n";
+    my $db = URPM::DB::open('/', 0); #- open in read/write mode directly (so open it only once).
+
+    @l = grep { !/^-/ } @ARGV;
+    if (!$matches) {
+	foreach (@l) {
+	    my ($n, $found);
+
+	    #- check if name-version-release may have been given.
+	    if (($n) = /^(.*)-[^\-]*-[^\-]*\.[^\.\-]*$/) {
+		$db->traverse_tag('name', [ $n ], sub {
+				      my ($p) = @_;
+				      $p->fullname eq $_ or return;
+				      $urpm->resolve_closure_ask_remove($db, $state, $p);
+				      push @m, join('-', ($p->fullname)[0..2]);
+				      $found = 1;
+				  });
+		$found and next;
+	    }
+
+	    #- check if name-version-release may have been given.
+	    if (($n) = /^(.*)-[^\-]*-[^\-]*$/) {
+		$db->traverse_tag('name', [ $n ], sub {
+				      my ($p) = @_;
+				      join('-', ($p->fullname)[0..2]) eq $_ or return;
+				      $urpm->resolve_closure_ask_remove($db, $state, $p);
+				      push @m, join('-', ($p->fullname)[0..2]);
+				      $found = 1;
+				  });
+		$found and next;
+	    }
+
+	    #- check if name-version may have been given.
+	    if (($n) = /^(.*)-[^\-]*$/) {
+		$db->traverse_tag('name', [ $n ], sub {
+				      my ($p) = @_;
+				      join('-', ($p->fullname)[0..1]) eq $_ or return;
+				      $urpm->resolve_closure_ask_remove($db, $state, $p);
+				      push @m, join('-', ($p->fullname)[0..2]);
+				      $found = 1;
+				  });
+		$found and next;
+	    }
+
+	    #- check if only name may have been given.
+	    $db->traverse_tag('name', [ $_ ], sub {
+				  my ($p) = @_;
+				  $p->name eq $_ or return;
+				  $urpm->resolve_closure_ask_remove($db, $state, $p);
+				  push @m, join('-', ($p->fullname)[0..2]);
+				  $found = 1;
+			      });
+	    $found and next;
+
+	    #- nothing has been found for the given name.
+	    $maymatch .= ($maymatch && ", ") . $_;
+	}
+	if ($maymatch) {
+	    my $msg = $maymatch =~ /, / ? _("unknown packages ") : _("unknown package ");
+	    $msg =~ /\s$/ or $msg .= ' '; #- add trailing space to avoid fixing bad translator (too late now for 9.0).
+	    $maymatch = "$msg$maymatch\n";
+	}
+	$maymatch && ($auto || @l > 1) and die $maymatch;
+    }
+    if ($matches || $maymatch) {
+	my $match = join "|", map { quotemeta } @l;
+
+	#- reset what has been already found.
+	$state = {};
+	@m = ();
+
+	#- search for package that matches, and perform closure again.
+	$db->traverse(sub {
+			  my ($p) = @_;
+			  $p->fullname =~ /$match/ or return;
+			  $urpm->resolve_closure_ask_remove($db, $state, $p);
+			  push @m, join('-', ($p->fullname)[0..2]);
+		      });
+
+	if ($maymatch) {
+	    @m or die $maymatch;
+	    my $msg = _("Using \"%s\" as a substring, I found", $match);
+	    print STDOUT "$msg:\n@m\n$askrm" . _(" (y/N) ");
+	    <STDIN> =~ /[$yesexpr]/ or exit 1;
+	}
     }
 
     #- if nothing need to be removed.
@@ -91,6 +143,9 @@ my %basepackages;
 	exit(0);
     }
 
+    my @base = qw(basesystem);
+    my %basepackages;
+
     #- check if a package to be removed is a part of basesystem requires.
     while (defined($_ = shift @base)) {
 	exists $basepackages{$_} and next;
@@ -100,14 +155,15 @@ my %basepackages;
 			      push @base, $p->requires_nosense;
 			  });
     }
-}
 
-foreach (values %basepackages) {
-    my $n = @$_;
-    foreach (@$_) {
-	$base{$_} = \$n;
+    foreach (values %basepackages) {
+	my $n = @$_;
+	foreach (@$_) {
+	    $base{$_} = \$n;
+	}
     }
 }
+
 my $base_str = '';
 my @toremove = keys %{$state->{ask_remove}};
 foreach (@toremove) {
@@ -121,7 +177,9 @@ $base_str and die $base_str;
 
 if (@toremove > @l && !$auto) {
     my $sum = 0;
-    map { $sum += $_ } `rpm -q --queryformat "%{SIZE}\n" @toremove`;
+    foreach (@toremove) {
+	$sum += $state->{ask_remove}{$_}{size};
+    }
     my $msg = _("To satisfy dependencies, the following packages are going to be removed (%d MB)", toMb($sum));
     print STDOUT "$msg:\n@toremove\n$askok" . _(" (Y/n) ");
     <STDIN> =~ /[$noexpr]/ and exit 0;
diff --git a/urpmi b/urpmi
index 39f286d3..0d33b188 100755
--- a/urpmi
+++ b/urpmi
@@ -41,7 +41,10 @@ my $rpm_opt = "vh";
 my $use_provides = 1;
 my $fuzzy = 0;
 my $src = 0;
+my $clean = 0;
 my $noclean = 0;
+my $pre_clean_cache = 0;
+my $post_clean_cache = 1;
 my $verbose = 0;
 my $root = '';
 my $bug = '';
@@ -74,6 +77,7 @@ usage:
 ") . _("  --auto-select  - automatically select packages to upgrade the system.
 ") . _("  --fuzzy        - impose fuzzy search (same as -y).
 ") . _("  --src          - next package is a source package (same as -s).
+") . _("  --clean        - remove rpm from cache before anything else.
 ") . _("  --noclean      - keep rpm not used in cache.
 ") . _("  --force        - force invocation even if some packages do not exist.
 ") . _("  --allow-nodeps - allow asking user to install packages without
@@ -124,7 +128,10 @@ while (defined($_ = shift @ARGV)) {
     /^--auto-select$/ and do { $auto_select = 1; next };
     /^--fuzzy$/ and do { $fuzzy = 1; next };
     /^--src$/ and do { $src = 1; next };
-    /^--noclean$/ and do { $noclean = 1; next };
+    /^--clean$/ and do { $clean = 1; $noclean = 0; next };
+    /^--noclean$/ and do { $clean = 0; $noclean = 1; next };
+    /^--(no-)?pre-clean$/ and do { $pre_clean_cache = !$1; next };
+    /^--(no-)?post-clean$/ and do { $post_clean_cache = !$1; next };
     /^--force$/ and do { $force = 1; next };
     /^--allow-nodeps$/ and do { $allow_nodeps = 1; next };
     /^--allow-force$/ and do { $allow_force = 1; next };
@@ -430,12 +437,12 @@ if (@root_only) {
 }
 
 #- if not root, the list become invisible and no download will be possible.
-my ($local_sources, $list, $local_to_removes) = $urpm->get_source_packages($state->{selected});
+my ($local_sources, $list, $local_to_removes) = $urpm->get_source_packages($state->{selected}, clean => $clean);
 unless ($local_sources || $list) {
     $urpm->{fatal}(3, _("unable to get source packages, aborting"));
 }
 #- clean cache with file that are not necessary with this transaction.
-unless ($noclean) {
+if (!$noclean && $pre_clean_cache) {
     foreach (@$local_to_removes) {
 	unlink $_;
     }
@@ -523,7 +530,7 @@ if (%sources_install || %sources) {
 	    } else {
 		my @l = $urpm->install([ keys %{$state->{ask_remove} || {}} ], \%sources_install, \%sources,
 				       translate_message => 1,
-				       test => $test, oldpackage => $state->{oldpackage});
+				       test => $test, oldpackage => $state->{oldpackage}, post_clean_cache => $post_clean_cache);
 		if (@l) {
 		    message(_("Installation failed") . ":\n" . join("\n",  map { "\t$_" } @l));
 
@@ -537,7 +544,7 @@ if (%sources_install || %sources) {
 		    $urpm->{log}("starting installing packages without deps");
 		    @l = $urpm->install([ keys %{$state->{ask_remove} || {}} ], \%sources_install, \%sources,
 					translate_message => 1, nodeps => 1,
-					test => $test, oldpackage => $state->{oldpackage});
+					test => $test, oldpackage => $state->{oldpackage}, post_clean_cache => $post_clean_cache);
 		    if (@l) {
 			message(_("Installation failed") . ":\n" . join("\n", map { "\t$_" } @l));
 			!$allow_force and exit 1;
@@ -546,7 +553,7 @@ if (%sources_install || %sources) {
 			$urpm->{log}("starting force installing packages without deps");
 			@l = $urpm->install([ keys %{$state->{ask_remove} || {}} ], \%sources_install, \%sources,
 					    translate_message => 1, nodeps => 1, force => 1,
-					    test => $test, oldpackage => $state->{oldpackage});
+					    test => $test, oldpackage => $state->{oldpackage}, post_clean_cache => $post_clean_cache);
 			@l and $urpm->fatal(2, _("Installation failed") . ":\n" . join("\n", map { "\t$_" } @l));
 		    }
 		} else {
diff --git a/urpmi.spec b/urpmi.spec
index 29802815..c2ab0e63 100644
--- a/urpmi.spec
+++ b/urpmi.spec
@@ -9,7 +9,7 @@ Source1: %{name}.logrotate
 Summary: User mode rpm install
 URL: http://cvs.mandrakesoft.com/cgi-bin/cvsweb.cgi/soft/urpmi
 Requires: eject webfetch perl-DateManip >= 5.40
-PreReq: perl-Locale-gettext rpmtools >= 4.3-6mdk perl-URPM >= 0.70-3mdk
+PreReq: perl-Locale-gettext rpmtools >= 4.3-6mdk perl-URPM >= 0.70-6mdk
 BuildRequires: bzip2-devel gettext rpm-devel >= 4.0.3
 BuildRoot: %{_tmppath}/%{name}-buildroot
 BuildArch: noarch
@@ -196,7 +196,14 @@ fi
 
 
 %changelog
-* Fri Aug 30 2002 Frederic Crozat <fcrozat@mandrakesoft.com> 4.0-10mdk
+* Fri Aug 30 2002 François Pons <fpons@mandrakesoft.com> 4.0-10mdk
+- fixed cache management (there could exist some files left in cache
+  which were never deleted).
+- added default cache management to post-clean (remove files of
+  package correctly installed), it is still possible to keep old
+  behaviour with "--pre-clean --no-post-clean".
+- added --clean options to urpmi to clean cache completely.
+- improved urpme to no more use rpm executable.
 - (fcrozat) Move gurpmi to /usr/sbin and add consolehelper support for it 
   and register it to handle application/x-rpm mimetype.