summaryrefslogtreecommitdiffstats
path: root/perl-install/pkgs.pm
diff options
context:
space:
mode:
authorFrancois Pons <fpons@mandriva.com>2000-11-20 18:57:14 +0000
committerFrancois Pons <fpons@mandriva.com>2000-11-20 18:57:14 +0000
commita13243d40c5eb72c6a968d57f9a8b129f9be57a0 (patch)
tree3a452d70553371c81c67a83720bff8fb1779a254 /perl-install/pkgs.pm
parent77a98d2dfceb46170e24a522eecc57dd0f614402 (diff)
downloaddrakx-backup-do-not-use-a13243d40c5eb72c6a968d57f9a8b129f9be57a0.tar
drakx-backup-do-not-use-a13243d40c5eb72c6a968d57f9a8b129f9be57a0.tar.gz
drakx-backup-do-not-use-a13243d40c5eb72c6a968d57f9a8b129f9be57a0.tar.bz2
drakx-backup-do-not-use-a13243d40c5eb72c6a968d57f9a8b129f9be57a0.tar.xz
drakx-backup-do-not-use-a13243d40c5eb72c6a968d57f9a8b129f9be57a0.zip
use parsehdlist from rpmtools-2.1-3mdk or above instead of
perl code from DrakX forking to simulate a filelist server. this increase performance by 100 to 150% on selection of packages to upgrade.
Diffstat (limited to 'perl-install/pkgs.pm')
-rw-r--r--perl-install/pkgs.pm46
1 files changed, 29 insertions, 17 deletions
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index e21e12ccd..2b032c16e 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -878,10 +878,12 @@ sub selectPackagesToUpgrade($$$;$$) {
close OUTPUT_CHILD;
select((select(OUTPUT), $| = 1)[0]);
- #- internal reading from the child.
+ #- internal reading from interactive mode of parsehdlist.
my $ask_child = sub {
+ my ($name, $tag) = @_;
my @list;
- print OUTPUT $_[0], "\n";
+ print OUTPUT "$name:$tag\n";
+ log::l("ask_child: ask parsehdlist for $name:$tag");
local $_;
while (<INPUT>) {
@@ -890,7 +892,8 @@ sub selectPackagesToUpgrade($$$;$$) {
push @list, $_;
}
- \@list;
+ log::l("ask_child: ask parsehdlist returned $name:$tag -> " . scalar(@list) . " items");
+ @list;
};
#- mark all files which are not in /etc/rc.d/ for packages which are already installed but which
@@ -965,10 +968,10 @@ sub selectPackagesToUpgrade($$$;$$) {
! -d "$prefix/$_" && ! -l "$prefix/$_") } @files} = ();
});
- my $list = $ask_child->(packageName($p));
- my @commonparts = map { /^=(.*)/ ? ($1) : () } @$list;
- map { delete $installedFilesForUpgrade{$_} } grep { $_ !~ m|^/etc/rc.d/| }
- map { /^(\d)(.*)/ ? ($commonparts[$1] . $2) : /^ (.*)/ ? ($1) : () } @$list;
+# my $list =
+# my @commonparts = map { /^=(.*)/ ? ($1) : () } @$list;
+ map { delete $installedFilesForUpgrade{$_} } grep { $_ !~ m|^/etc/rc.d/| } $ask_child->(packageName($p), "files");
+# map { /^(\d)(.*)/ ? ($commonparts[$1] . $2) : /^ (.*)/ ? ($1) : () } @$list;
#- keep in mind the cumul size of installed package since they will be deleted
#- on upgrade.
@@ -982,10 +985,10 @@ sub selectPackagesToUpgrade($$$;$$) {
my $p = $_;
if (packageFlagSelected($p)) {
- my $list = $ask_child->(packageName($p));
- my @commonparts = map { /^=(.*)/ ? ($1) : () } @$list;
- map { delete $installedFilesForUpgrade{$_} } grep { $_ !~ m|^/etc/rc.d/| }
- map { /^(\d)(.*)/ ? ($commonparts[$1] . $2) : /^ (.*)/ ? ($1) : () } @$list;
+# my $list = $ask_child->(packageName($p));
+# my @commonparts = map { /^=(.*)/ ? ($1) : () } @$list;
+ map { delete $installedFilesForUpgrade{$_} } grep { $_ !~ m|^/etc/rc.d/| } $ask_child->(packageName($p), "files");
+# map { /^(\d)(.*)/ ? ($commonparts[$1] . $2) : /^ (.*)/ ? ($1) : () } @$list;
}
}
@@ -1000,11 +1003,11 @@ sub selectPackagesToUpgrade($$$;$$) {
unless (packageFlagSelected($p)) {
my $toSelect = 0;
- my $list = $ask_child->(packageName($p));
- my @commonparts = map { /^=(.*)/ ? ($1) : () } @$list;
+# my $list = $ask_child->(packageName($p));
+# my @commonparts = map { /^=(.*)/ ? ($1) : () } @$list;
map { if (exists $installedFilesForUpgrade{$_}) {
++$toSelect if ! -d "$prefix/$_" && ! -l "$prefix/$_"; delete $installedFilesForUpgrade{$_} }
- } grep { $_ !~ m|^/etc/rc.d/| } map { /^(\d)(.*)/ ? ($commonparts[$1] . $2) : /^ (.*)/ ? ($1) : () } @$list;
+ } grep { $_ !~ m|^/etc/rc.d/| } $ask_child->(packageName($p), "files"); #map { /^(\d)(.*)/ ? ($commonparts[$1] . $2) : /^ (.*)/ ? ($1) : () } @$list;
if ($toSelect) {
if ($toSelect <= 1 && packageName($p) =~ /-devel/) {
log::l("avoid selecting " . packageName($p) . " as not enough files will be updated");
@@ -1031,9 +1034,10 @@ sub selectPackagesToUpgrade($$$;$$) {
foreach (values %{$packages->[0]}) {
my $p = $_;
- my $list = $ask_child->(packageName($p));
- my @obsoletes = map { /^\*(\S*)/ ? ($1) : () } @$list;
- foreach (@obsoletes) {
+# my $list = $ask_child->(packageName($p));
+# my @obsoletes = map { /^\*(\S*)/ ? ($1) : () } @$list;
+# foreach (@obsoletes) {
+ foreach (map { /^(\S*)/ ? ($1) : () } $ask_child->(packageName($p), "obsoletes")) {
if (c::rpmdbNameTraverse($db, $_) > 0) {
log::l("selecting " . packageName($p) . " by selection on obsoletes");
selectPackage($packages, $p);
@@ -1046,6 +1050,14 @@ sub selectPackagesToUpgrade($$$;$$) {
close INPUT;
waitpid $pid, 0;
} else {
+ close INPUT;
+ close OUTPUT;
+ open STDIN, "<&INPUT_CHILD";
+ open STDOUT, ">&OUTPUT_CHILD";
+ exec "parsehdlist", "--interactive", map { "/tmp/$_->{hdlist}" } values %{$packages->[2]};
+ c::_exit(1);
+
+ #- THE FOLLOWING IS OBSOLETE AND WILL BE REMOVED SOON, OR KEPT FOR INFO
local $_;
#- child process will hashes filelist and answer its parent