retrieve package descriptions from XML meta-data instead of from huge hdlists

(fix not displaying packages description in network installs) (mga#549)

3 files changed, 43 insertions, 2 deletions

diff --git a/perl-install/install/NEWS b/perl-install/install/NEWS
index eabf35c93..6d3d203d2 100644
--- a/perl-install/install/NEWS
+++ b/perl-install/install/NEWS
@@ -1,3 +1,6 @@
+- retrieve package descriptions from XML meta-data instead of from huge hdlists
+  (fix not displaying packages description in network installs) (mga#549)
+
 Version 14.50.1 - 15 November 2012
 
 - include Parse::EDID for monitor-parse-edid (mga#8076)
diff --git a/perl-install/install/pkgs.pm b/perl-install/install/pkgs.pm
index e41c6c31c..588aea420 100644
--- a/perl-install/install/pkgs.pm
+++ b/perl-install/install/pkgs.pm
@@ -108,6 +108,44 @@ sub size2time {
     }
 }
 
+# Based on Rpmdrake::pkg::extract_header():
+sub get_pkg_info {
+    my ($p) = @_;
+
+    my $urpm = $::o->{packages};
+    my $name = $p->fullname;
+
+    my $medium = URPM::pkg2media($urpm->{media}, $p);
+    my ($local_source, %xml_info_pkgs, $description);
+    my $dir = urpm::file_from_local_url($medium->{url});
+    $local_source = "$dir/" . $p->filename if $dir;
+
+    if (-s $local_source) {
+	log::l("getting information from $dir...");
+	$p->update_header($local_source) and $description = $p->description;
+	log::l("Warning, could not extract header for $name from $medium!") if !$description;
+    }
+    if (!$description) {
+	my $_w = $::o->wait_message(undef, N("Getting package information from XML meta-data..."));
+	if (my $xml_info_file = eval { urpm::media::any_xml_info($urpm, $medium, 'info', undef, urpm::download::sync_logger) }) {
+	    require urpm::xml_info;
+	    require urpm::xml_info_pkg;
+	    log::l("getting information from $xml_info_file");
+	    my %nodes = eval { urpm::xml_info::get_nodes('info', $xml_info_file, [ $name ]) };
+	    goto header_non_available if $@;
+	    put_in_hash($xml_info_pkgs{$name} ||= {}, $nodes{$name});
+	} else {
+	    $urpm->{info}(N("No xml info for medium \"%s\", only partial result for package %s", $medium->{name}, $name));
+	}
+    }
+
+    if (!$description && $xml_info_pkgs{$name}) {
+	$description = $xml_info_pkgs{$name}{description};
+    }
+  header_non_available:
+    $description || N("No description");
+}
+
 sub packagesProviding {
     my ($packages, $name) = @_;
     grep { $_->is_arch_compat } URPM::packages_providing($packages, $name);
diff --git a/perl-install/install/steps_gtk.pm b/perl-install/install/steps_gtk.pm
index c4a612b58..a8f998f7a 100644
--- a/perl-install/install/steps_gtk.pm
+++ b/perl-install/install/steps_gtk.pm
@@ -405,7 +405,7 @@ sub choosePackagesTree {
 			    },
 			    get_info => sub {
 				my $p = install::pkgs::packageByName($packages, $_[0]) or return '';
-                                install::pkgs::extractHeaders([$p], $packages->{media});
+				my $description = install::pkgs::get_pkg_info($p);
 
 				my $imp = translate($install::pkgs::compssListDesc{$p->flag_base ? 5 : $p->rate});
 
@@ -415,7 +415,7 @@ sub choosePackagesTree {
                                     [ N("Version: "), $tag ], [ $p->version . '-' . $p->release . "\n" ],
                                     [ N("Size: "), $tag ], [ N("%d KB\n", $p->size / 1024) ],
                                     if_($imp, [ N("Importance: "), $tag ], [ "$imp\n" ]),
-                                    [ "\n" ], [ formatLines($p->description || N("No description")) ] ];
+                                    [ "\n" ], [ formatLines($description) ] ];
 			    },
 			    toggle_nodes => sub {
 				my $set_state = shift @_;