- (get_installed_packages) optimized and cleansed up the base flagging loop

1 files changed, 57 insertions, 33 deletions

diff --git a/Rpmdrake/pkg.pm b/Rpmdrake/pkg.pm
index 795a2ae6..112d3457 100644
--- a/Rpmdrake/pkg.pm
+++ b/Rpmdrake/pkg.pm
@@ -308,43 +308,67 @@ sub update_pbar {
 sub get_installed_packages {
     my ($urpm, $db, $all_pkgs, $gurpm) = @_;
 
-    my @base = ("basesystem", split /,\s*/, $urpm->{global_config}{'prohibit-remove'});
-    my (%base, %basepackages, @installed_pkgs, @processed_base);
+    # Walks (breadth-first) the installed packages dependency tree, starting at
+    # basesystem (or any other prohibit-remove'd one), to flag_base all package
+    # that can't be removed since it's the only provider of required
+    # capabilities.
+
+    # Queue of base capabilities
+    my @base_capabilities = ("basesystem", 
+			     split /,\s*/, $urpm->{global_config}{'prohibit-remove'});
+    my @installed_pkgs;
+    my %providers;	
     reset_pbar_count(0.33);
-    while (defined(local $_ = shift @base)) {
-	exists $basepackages{$_} and next;
-	$db->traverse_tag(m|^/| ? 'path' : 'whatprovides', [ $_ ], sub {
-			      update_pbar($gurpm);
-			      my $name = urpm_name($_[0]);
-			      # workaround looping in URPM:
-			      return if member($name, @processed_base);
-			      push @processed_base, $name;
-			      push @{$basepackages{$_}}, $name;
-			      push @base, $_[0]->requires_nosense;
-			  });
-    }
-    foreach (values %basepackages) {
-	my $n = @$_;            #- count number of times it's provided
-	foreach (@$_) {
-	    $base{$_} = \$n;
+    while (my $dep = shift @base_capabilities) {
+
+	# URPM::Package::requires_nosense may return version info at the end of
+	# dependency name
+	$dep =~ s/(.+)\[.+\]$/\1/;
+
+	next if exists $providers{$dep};
+	my $tag = ( $dep =~ m|^/| ) ? 'path' : 'whatprovides';
+	my $n;
+	$n = $db->traverse_tag($tag, [ $dep ], sub {
+	    my $pkg = shift @_;
+	    my $name = urpm_name($pkg);
+	    unless ($all_pkgs->{$name}) {
+		$all_pkgs->{$name} = {
+		    selected => 0,
+		    pkg => $pkg,
+		    urpm_name => $name,
+		    base => \$n
+		};
+		push @installed_pkgs, $name;
+		push @{$providers{$dep}}, $name;
+		push @base_capabilities, $pkg->requires_nosense;
+		update_pbar($gurpm);
+	    }
+	});
+	for (@{$providers{$dep}}) {
+	    $all_pkgs->{$_}{pkg}->set_flag_base(1) if $n == 1;
 	}
     }
-    # costly:
+
+    # Search for all other installed packages (costly operation).
+
     $db->traverse(sub {
-                      my ($pkg) = @_;
-                      update_pbar($gurpm);
-                      my $fullname = urpm_name($pkg);
-                      return if $fullname =~ /@/;
-                      $all_pkgs->{$fullname} = {
-                          selected => 0, pkg => $pkg, urpm_name => urpm_name($pkg),
-                      } if !($all_pkgs->{$fullname} && $all_pkgs->{$fullname}{description});
-                      if (my $name = $base{$fullname}) {
-                          $all_pkgs->{$fullname}{base} = \$name;
-                          $pkg->set_flag_base(1) if $$name == 1;
-                      }
-                      push @installed_pkgs, $fullname;
-                      $pkg->pack_header; # needed in order to call methods on objects outside ->traverse
-                  });
+	my $pkg = shift @_;
+	my $name = urpm_name($pkg);
+	update_pbar($gurpm);
+	unless ($name =~ /@/ or $all_pkgs->{$name}) {
+	    $all_pkgs->{$name} = {
+		selected => 0, 
+		pkg => $pkg, 
+		urpm_name => $name,
+	    } unless ($all_pkgs->{$name} && 
+		      $all_pkgs->{$name}{description});
+
+	    push @installed_pkgs, $name;
+
+	    # Needed in order to call methods on objects outside ->traverse
+	    $pkg->pack_header;
+	}
+    });
     @installed_pkgs;
 }