3.4-3mdk

4 files changed, 62 insertions, 55 deletions

diff --git a/urpm.pm b/urpm.pm
index ac582f4e..92119d62 100644
--- a/urpm.pm
+++ b/urpm.pm
@@ -1429,23 +1429,9 @@ sub search_packages {
 #- version, try to upgrade to minimize upgrade errors.
 #- all additional package selected have a true value.
 sub filter_packages_to_upgrade {
-    my ($urpm, $packages, $select_choices, %options) = @_;
+    my ($urpm, $db, $packages, $select_choices, %options) = @_;
     my ($id, %track, %track_requires, %installed, %selected, %conflicts);
-    my ($db, @packages) = (URPM::DB::open($options{root}), keys %$packages);
-    my $sig_handler = sub { undef $db; exit 3 };
-    local $SIG{INT} = $sig_handler;
-    local $SIG{QUIT} = $sig_handler;
-
-    #- common routines that are called at different points.
-    my $check_installed = sub {
-	my ($pkg) = @_;
-	$pkg->arch eq 'src' and return;
-	$options{keep_alldeps} || exists $installed{$pkg->id} and return 0;
-	$db->traverse_tag('name', [ $pkg->name ], sub {
-			      my ($p) = @_;
-			      $installed{$pkg->id} ||= $pkg->compare_pkg($p) <= 0;
-			  });
-    };
+    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.
@@ -1463,7 +1449,13 @@ sub filter_packages_to_upgrade {
 	    #- are installed).
 	    foreach (@$id) {
 		my $pkg = $urpm->{depslist}[$_];
-		if (exists $packages->{$_} || $check_installed->($pkg) > 0) {
+		$pkg->arch eq 'src' and return;
+		$options{keep_alldeps} || exists $installed{$pkg->id} and return 0;
+		my $count = $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, $_;
@@ -1662,7 +1654,12 @@ sub filter_packages_to_upgrade {
 	    foreach my $pkg (@pre_choices) {
 		push @choices, $pkg;
 
-		$check_installed->($pkg);
+		$pkg->arch eq 'src' and return;
+		$options{keep_alldeps} || exists $installed{$pkg->id} and return 0;
+		$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;
 	    }
@@ -1698,8 +1695,6 @@ sub filter_packages_to_upgrade {
 	}
     }
 
-    undef $db;
-
     #- rpm db will be closed automatically on destruction of $db.
     \%track;
 }
@@ -1977,11 +1972,7 @@ sub extract_packages_to_install {
 }
 
 sub select_packages_to_upgrade {
-    my ($urpm, $prefix, $packages, $remove_packages, $keep_files, %options) = @_;
-    my $db = URPM::DB::open($prefix);
-    my $sig_handler = sub { undef $db; exit 3 };
-    local $SIG{INT} = $sig_handler;
-    local $SIG{QUIT} = $sig_handler;
+    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.
@@ -2151,7 +2142,6 @@ sub select_packages_to_upgrade {
 			  }
 		      });
     }
-    undef $db;
 }
 
 1;
diff --git a/urpmi b/urpmi
index d98abe65..b0cb8be6 100755
--- a/urpmi
+++ b/urpmi
@@ -27,7 +27,6 @@ my $update = 0;
 my $media = 0;
 my $auto = 0;
 my $allow_medium_change = 0;
-my $complete = 0;
 my $auto_select = 0;
 my $force = 0;
 my $sync = undef;
@@ -68,7 +67,6 @@ usage:
 ") . _("  --fuzzy        - impose fuzzy search (same as -y).
 ") . _("  --src          - next package is a source package (same as -s).
 ") . _("  --noclean      - keep rpm not used in cache.
-") . _("  --complete     - use parsehdlist server to complete selection.
 ") . _("  --force        - force invocation even if some packages do not exist.
 ") . _("  --wget         - use wget to retrieve distant files.
 ") . _("  --curl         - use curl to retrieve distant files.
@@ -100,7 +98,6 @@ for (@ARGV) {
     /^--fuzzy$/ and do { $fuzzy = 1; next };
     /^--src$/ and do { $src = 1; next };
     /^--noclean$/ and do { $noclean = 1; next };
-    /^--complete$/ and do { $complete = 1; next };
     /^--force$/ and do { $force = 1; next };
     /^--wget$/ and do { $sync = \&urpm::sync_wget; next };
     /^--curl$/ and do { $sync = \&urpm::sync_curl; next };
@@ -246,21 +243,30 @@ my $ask_choice = sub {
     $choices_id[$n - 1];
 };
 
-#- auto select package for upgrading the distribution.
-if ($auto_select) {
-    my (%to_remove, %keep_files);
+#- open/close of database should be moved here, in order to allow testing
+#- some bogus case and check for integrity.
+{
+    my $db = URPM::DB::open($root);
+    my $sig_handler = sub { undef $db; exit 3 };
+    local $SIG{INT} = $sig_handler;
+    local $SIG{QUIT} = $sig_handler;
 
-    $urpm->select_packages_to_upgrade($root, \%packages, \%to_remove, \%keep_files, use_parsehdlist => $complete);
+    #- auto select package for upgrading the distribution.
+    if ($auto_select) {
+	my (%to_remove, %keep_files);
 
-#-    if (keys(%to_remove) > 0) {
-#-	print STDERR "some packages have to be removed for being upgraded, this is not supported yet\n";
-#-    }
-}
+	$urpm->select_packages_to_upgrade($db, \%packages, \%to_remove, \%keep_files);
 
-$urpm->filter_packages_to_upgrade(\%packages, $ask_choice, root => $root);
-#- my $track = $urpm->filter_packages_to_upgrade(\%packages, $ask_choice, track => 1);
-#- require Data::Dumper;
-#- print STDERR Data::Dumper->Dump([$track], ['$track']);
+	if (keys(%to_remove) > 0) {
+	    $urpm->{error}(_("some packages have to be removed for being upgraded, this is not supported yet\n"));
+	}
+    }
+
+    $urpm->filter_packages_to_upgrade($db, \%packages, $ask_choice);
+    #- my $track = $urpm->filter_packages_to_upgrade(\%packages, $ask_choice, track => 1);
+    #- require Data::Dumper;
+    #- print STDERR Data::Dumper->Dump([$track], ['$track']);
+}
 
 #- get out of package that should not be upgraded.
 $urpm->deselect_unwanted_packages(\%packages);
diff --git a/urpmi.spec b/urpmi.spec
index 661ff0f7..389a872f 100644
--- a/urpmi.spec
+++ b/urpmi.spec
@@ -2,7 +2,7 @@
 
 Name: urpmi
 Version: 3.4
-Release: 2mdk
+Release: 3mdk
 License: GPL
 Source0: %{name}.tar.bz2
 Source1: %{name}.logrotate
@@ -144,6 +144,10 @@ fi
 
 
 %changelog
+* Wed Jun  5 2002 François Pons <fpons@mandrakesoft.com> 3.4-3mdk
+- avoid sub of sub with different level of variable closure in perl,
+  this cause the interpreter to lose its memory usage.
+
 * Wed Jun  5 2002 François Pons <fpons@mandrakesoft.com> 3.4-2mdk
 - fix rpmdb non closed when traversing it.
 - fix ftp and http medium with bad list generation.
diff --git a/urpmq b/urpmq
index 8cceb79f..e408b8a5 100755
--- a/urpmq
+++ b/urpmq
@@ -137,21 +137,28 @@ if (@src_names) {
 	or $query->{force} or exit 1;
 }
 
-#- auto select package for upgrading the distribution.
-if ($query->{auto_select}) {
-    my (%to_remove, %keep_files);
-
-    $urpm->select_packages_to_upgrade($query->{root}, \%packages, \%to_remove, \%keep_files);
-
-    if (keys(%to_remove) > 0) {
-	$urpm->{error}(_("some packages have to be removed for being upgraded, this is not supported yet\n"));
+#- open/close of database should be moved here, in order to allow testing
+#- some bogus case and check for integrity.
+if ($query->{auto_select} || $query->{deps}) {
+    my $db = URPM::DB::open($root);
+    my $sig_handler = sub { undef $db; exit 3 };
+    local $SIG{INT} = $sig_handler;
+    local $SIG{QUIT} = $sig_handler;
+
+    #- auto select package for upgrading the distribution.
+    if ($query->{auto_select}) {
+	my (%to_remove, %keep_files);
+
+	$urpm->select_packages_to_upgrade($db, \%packages, \%to_remove, \%keep_files);
+
+	if (keys(%to_remove) > 0) {
+	    $urpm->{error}(_("some packages have to be removed for being upgraded, this is not supported yet\n"));
+	}
     }
-}
 
-#- filter to add in packages selected required packages.
-$query->{deps} and $urpm->filter_packages_to_upgrade(\%packages, undef,
-						     keep_alldeps => !$query->{upgrade},
-						     root => $query->{root});
+    #- filter to add in packages selected required packages.
+    $query->{deps} and $urpm->filter_packages_to_upgrade($db, \%packages, undef, keep_alldeps => !$query->{upgrade});
+}
 
 #- get out of package that should not be upgraded.
 $urpm->deselect_unwanted_packages(\%packages);