summaryrefslogtreecommitdiffstats
path: root/perl-install/pkgs.pm
diff options
context:
space:
mode:
authorFrancois Pons <fpons@mandriva.com>2002-07-18 15:53:32 +0000
committerFrancois Pons <fpons@mandriva.com>2002-07-18 15:53:32 +0000
commitf250526dd66a5eaecccdeba591ca1310b359f8d7 (patch)
tree03aa1936447b86d0c06e93bae393ea4a9a6efa8b /perl-install/pkgs.pm
parent59656117c5c71887e70cab14e268a35c8ab548da (diff)
downloaddrakx-backup-do-not-use-f250526dd66a5eaecccdeba591ca1310b359f8d7.tar
drakx-backup-do-not-use-f250526dd66a5eaecccdeba591ca1310b359f8d7.tar.gz
drakx-backup-do-not-use-f250526dd66a5eaecccdeba591ca1310b359f8d7.tar.bz2
drakx-backup-do-not-use-f250526dd66a5eaecccdeba591ca1310b359f8d7.tar.xz
drakx-backup-do-not-use-f250526dd66a5eaecccdeba591ca1310b359f8d7.zip
removed all the commented out code obsoleted.
Diffstat (limited to 'perl-install/pkgs.pm')
-rw-r--r--perl-install/pkgs.pm538
1 files changed, 2 insertions, 536 deletions
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index 93b10e69d..21877e2d3 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -33,25 +33,8 @@ my @preferred = qw(perl-GTK postfix gcc gcc-cpp gcc-c++ proftpd ghostscript-X vi
#- constant for small transaction.
$limitMinTrans = 8;
-##- constant for package accessor (via table).
-#my $FILE = 0;
-#my $FLAGS = 1;
-#my $SIZE_DEPS = 2;
-#my $MEDIUM = 3;
-#my $PROVIDES = 4;
-#my $VALUES = 5;
-#my $HEADER = 6;
-#my $INSTALLED_CUMUL_SIZE = 7;
-#my $EPOCH = 8;
-#
-##- constant for packing flags, see below.
-#my $PKGS_SELECTED = 0x00ffffff;
-#my $PKGS_FORCE = 0x01000000;
-#my $PKGS_INSTALLED = 0x02000000;
-#my $PKGS_BASE = 0x04000000;
-#my $PKGS_UPGRADE = 0x20000000;
-
-#- package to ignore, typically in Application CD.
+
+#- package to ignore, typically in Application CD. OBSOLETED ?
my %ignoreBadPkg = (
'civctp-demo' => 1,
'eus-demo' => 1,
@@ -61,73 +44,12 @@ my %ignoreBadPkg = (
'rt2-demo' => 1,
);
-#- basic methods for extracting informations about packages.
-#- to save memory, (name, version, release) are no more stored, they
-#- are directly generated from (file).
-#- all flags are grouped together into (flags), these includes the
-#- following flags : selected, force, installed, base, skip.
-#- size and deps are grouped to save memory too and make a much
-#- simpler and faster depslist reader, this gets (sizeDeps).
-#sub packageHeaderFile { $_[0] ? $_[0]->[$FILE]
-# : die "invalid package from\n" . backtrace() }
-#sub packageName { $_[0] && $_[0]->[$FILE] =~ /^([^:\s]*)-[^:\-\s]+-[^:\-\s]+\.[^:\.\-\s]*(?::.*)?/ ? $1
-# : die "invalid file `" . ($_[0] && $_[0]->[$FILE]) . "'\n" . backtrace() }
-#sub packageVersion { $_[0] && $_[0]->[$FILE] =~ /^[^:\s]*-([^:\-\s]+)-[^:\-\s]+\.[^:\.\-\s]*(?::.*)?/ ? $1
-# : die "invalid file `" . ($_[0] && $_[0]->[$FILE]) . "'\n" . backtrace() }
-#sub packageRelease { $_[0] && $_[0]->[$FILE] =~ /^[^:\s]*-[^:\-\s]+-([^:\-\s]+)\.[^:\.\-\s]*(?::.*)?/ ? $1
-# : die "invalid file `" . ($_[0] && $_[0]->[$FILE]) . "'\n" . backtrace() }
-#sub packageArch { $_[0] && $_[0]->[$FILE] =~ /^[^:\s]*-[^:\-\s]+-[^:\-\s]+\.([^:\.\-\s]*)(?::.*)?/ ? $1
-# : die "invalid file `" . ($_[0] && $_[0]->[$FILE]) . "'\n" . backtrace() }
-#sub packageFile { $_[0] && $_[0]->[$FILE] =~ /^([^:\s]*-[^:\-\s]+-[^:\-\s]+\.[^:\.\-\s]*)(?::(.*))?/ ? ($2 || $1) . ".rpm"
-# : die "invalid file `" . ($_[0] && $_[0]->[$FILE]) . "'\n" . backtrace() }
-#sub packageEpoch { $_[0] && $_[0]->[$EPOCH] || 0 }
-#
-#sub packageSize { to_int($_[0] && ($_[0]->[$SIZE_DEPS] - ($_[0]->[$INSTALLED_CUMUL_SIZE] || 0))) }
-#sub packageDepsId { split ' ', ($_[0] && ($_[0]->[$SIZE_DEPS] =~ /^\d*\s*(.*)/)[0]) }
-#
-#sub packageFlagSelected { $_[0] && $_[0]->[$FLAGS] & $PKGS_SELECTED }
-#sub packageFlagForce { $_[0] && $_[0]->[$FLAGS] & $PKGS_FORCE }
-#sub packageFlagInstalled { $_[0] && $_[0]->[$FLAGS] & $PKGS_INSTALLED }
-#sub packageFlagBase { $_[0] && $_[0]->[$FLAGS] & $PKGS_BASE }
-#sub packageFlagUpgrade { $_[0] && $_[0]->[$FLAGS] & $PKGS_UPGRADE }
-#
-#sub packageSetFlagSelected { $_[0]->[$FLAGS] &= ~$PKGS_SELECTED; $_[0]->[$FLAGS] |= $_[1] & $PKGS_SELECTED; }
-#
-#sub packageSetFlagForce { $_[0] or die "invalid package from\n" . backtrace();
-# $_[1] ? ($_[0]->[$FLAGS] |= $PKGS_FORCE) : ($_[0]->[$FLAGS] &= ~$PKGS_FORCE); }
-#sub packageSetFlagInstalled { $_[0] or die "invalid package from\n" . backtrace();
-# $_[1] ? ($_[0]->[$FLAGS] |= $PKGS_INSTALLED) : ($_[0]->[$FLAGS] &= ~$PKGS_INSTALLED); }
-#sub packageSetFlagBase { $_[0] or die "invalid package from\n" . backtrace();
-# $_[1] ? ($_[0]->[$FLAGS] |= $PKGS_BASE) : ($_[0]->[$FLAGS] &= ~$PKGS_BASE); }
-#sub packageSetFlagUpgrade { $_[0] or die "invalid package from\n" . backtrace();
-# $_[1] ? ($_[0]->[$FLAGS] |= $PKGS_UPGRADE) : ($_[0]->[$FLAGS] &= ~$PKGS_UPGRADE); }
-#
sub packageMedium { my ($packages, $p) = @_; $p or die "invalid package from\n" . backtrace();
foreach (values %{$packages->{mediums}}) {
$p->id >= $_->{start} && $p->id <= $_->{end} and return $_;
}
return }
-#sub packageProvides { $_[1] or die "invalid package from\n" . backtrace();
-# map { $_[0]->{depslist}[$_] || die "unkown package id $_" } unpack "s*", $_[1]->[$PROVIDES] }
-#
-#sub packageRate { substr($_[0] && $_[0]->[$VALUES], 0, 1) }
-#sub packageRateRFlags { my ($rate, @flags) = split "\t", $_[0] && $_[0]->[$VALUES]; ($rate, @flags) }
-#sub packageSetRateRFlags { my ($pkg, $rate, @flags) = @_; $pkg or die "invalid package from\n" . backtrace();
-# $pkg->[$VALUES] = join("\t", $rate, @flags) }
-#
-#sub packageHeader { $_[0] && $_[0]->[$HEADER] }
-#sub packageFreeHeader { $_[0] && c::headerFree(delete $_[0]->[$HEADER]) }
-
-#sub packageSelectedOrInstalled { $_[0] && ($_[0]->flag_selected || $_[0]->flag_installed) }
-
-#sub packageId {
-# my ($packages, $pkg) = @_;
-# my $i = 0;
-# foreach (@{$packages->{depslist}}) { return $i if $pkg == $packages->{depslist}[$i]; $i++ }
-# return;
-#}
-
sub cleanHeaders {
my ($prefix) = @_;
rm_rf("$prefix/tmp/headers") if -e "$prefix/tmp/headers";
@@ -504,132 +426,16 @@ sub psUsingHdlist {
#OBSOLETED TODO
sub getOtherDeps($$) {
return; #TODO
-# my ($packages, $f) = @_;
-#
-# #- this version of getDeps is customized for handling errors more easily and
-# #- convert reference by name to deps id including closure computation.
-# local $_;
-# while (<$f>) {
-# my ($name, $version, $release, $size, $deps) = /^(\S*)-([^-\s]+)-([^-\s]+)\s+(\d+)\s+(.*)/;
-# my $pkg = $packages->{names}{$name};
-#
-# $pkg or log::l("ignoring package $name-$version-$release in depslist is not in hdlist"), next;
-# $version eq packageVersion($pkg) and $release eq packageRelease($pkg)
-# or log::l("warning package $name-$version-$release in depslist mismatch version or release in hdlist ($version ne ",
-# packageVersion($pkg), " or $release ne ", packageRelease($pkg), ")"), next;
-#
-# my $index = scalar @{$packages->{depslist}};
-# $index >= packageMedium($packages, $pkg)->{min} && $index <= packageMedium($packages, $pkg)->{max}
-# or log::l("ignoring package $name-$version-$release in depslist outside of hdlist indexation");
-#
-# #- here we have to translate referenced deps by name to id.
-# #- this include a closure on deps too.
-# my %closuredeps;
-# @closuredeps{map { packageId($packages, $_), packageDepsId($_) }
-# grep { $_ }
-# map { packageByName($packages, $_) or do { log::l("unknown package $_ in depslist for closure"); undef } }
-# split /\s+/, $deps} = ();
-#
-# $pkg->[$SIZE_DEPS] = join " ", $size, keys %closuredeps;
-#
-# push @{$packages->{depslist}}, $pkg;
-# }
-#
-# #- check for same number of package in depslist and hdlists, avoid being to hard.
-# scalar(keys %{$packages->{names}}) == scalar(@{$packages->{depslist}})
-# or log::l("other depslist has not same package as hdlist file");
}
#OBSOLETED TODO
sub getDeps {
return; #TODO
-# my ($prefix, $packages) = @_;
-#
-# #- this is necessary for urpmi.
-# install_any::getAndSaveFile('Mandrake/base/depslist.ordered', "$prefix/var/lib/urpmi/depslist.ordered");
-# install_any::getAndSaveFile('Mandrake/base/provides', "$prefix/var/lib/urpmi/provides");
-#
-# #- beware of heavily mismatching depslist.ordered file against hdlist files.
-# my $mismatch = 0;
-#
-# #- count the number of packages in deplist that are also in hdlist
-# my $nb_deplist = 0;
-#
-# #- update dependencies list, provides attributes are updated later
-# #- cross reference to be resolved on id (think of loop requires)
-# #- provides should be updated after base flag has been set to save
-# #- memory.
-# local *F; open F, "$prefix/var/lib/urpmi/depslist.ordered" or die "can't find dependancies list";
-# local $_;
-# while (<F>) {
-# my ($name, $version, $release, $arch, $epoch, $sizeDeps) =
-# /^([^:\s]*)-([^:\-\s]+)-([^:\-\s]+)\.([^:\.\-\s]*)(?::(\d+)\S*)?\s+(.*)/;
-# my $pkg = $packages->{names}{$name};
-#
-# #- these verification are necessary in case of error, but are no more fatal as
-# #- in case of only one medium taken into account during install, there should be
-# #- silent warning for package which are unknown at this point.
-# $pkg or
-# log::l("ignoring $name-$version-$release.$arch in depslist is not in hdlist");
-# $pkg && $version ne packageVersion($pkg) and
-# log::l("ignoring $name-$version-$release.$arch in depslist mismatch version in hdlist"), $pkg = undef;
-# $pkg && $release ne packageRelease($pkg) and
-# log::l("ignoring $name-$version-$release.$arch in depslist mismatch release in hdlist"), $pkg = undef;
-# $pkg && $arch ne packageArch($pkg) and
-# log::l("ignoring $name-$version-$release.$arch in depslist mismatch arch in hdlist"), $pkg = undef;
-#
-# if ($pkg) {
-# $nb_deplist++;
-# $epoch && $epoch > 0 and $pkg->[$EPOCH] = $epoch; #- only 5% of the distribution use epoch (serial).
-# $pkg->[$SIZE_DEPS] = $sizeDeps;
-#
-# #- check position of package in depslist according to precomputed
-# #- limit by hdlist, very strict :-)
-# #- above warning have chance to raise an exception here, but may help
-# #- for debugging.
-# my $i = scalar @{$packages->{depslist}};
-# $i >= packageMedium($packages, $pkg)->{min} && $i <= packageMedium($packages, $pkg)->{max} or
-# log::l("inconsistency in position for $name-$version-$release.$arch in depslist and hdlist"), $mismatch = 1;
-# }
-#
-# #- package are already sorted in depslist to enable small transaction and multiple medium.
-# push @{$packages->{depslist}}, $pkg;
-# }
-#
-# #- check for mismatching package, it should break with above die unless depslist has too many errors!
-# $mismatch and die "depslist.ordered mismatch against hdlist files";
-#
-# #- check for same number of package in depslist and hdlists.
-# my $nb_hdlist = keys %{$packages->{names}};
-# $nb_hdlist == $nb_deplist or die "depslist.ordered has not same package as hdlist files ($nb_deplist != $nb_hdlist)";
}
#OBSOLETED TODO
sub getProvides($) {
return; #TODO
-# my ($packages) = @_;
-#
-# #- update provides according to dependencies, here are stored
-# #- reference to package directly and choice are included, this
-# #- assume only 1 of the choice is selected, else on unselection
-# #- the provided package will be deleted where other package still
-# #- need it.
-# #- base package are not updated because they cannot be unselected,
-# #- this save certainly a lot of memory since most of them may be
-# #- needed by a large number of package.
-# #- now using a packed of signed short, this means no more than 32768
-# #- packages can be managed by DrakX (currently about 2000).
-# my $i = 0;
-# foreach my $pkg (@{$packages->{depslist}}) {
-# $pkg or next;
-# unless (packageFlagBase($pkg)) {
-# foreach (map { split '\|' } grep { !/^NOTFOUND_/ } packageDepsId($pkg)) {
-# my $provided = packageById($packages, $_) or next;
-# packageFlagBase($provided) or $provided->[$PROVIDES] = pack "s*", (unpack "s*", $provided->[$PROVIDES]), $i;
-# }
-# }
-# ++$i;
-# }
}
sub read_rpmsrate {
@@ -1000,304 +806,6 @@ sub selectPackagesToUpgrade {
$packages->resolve_packages_to_upgrade($packages->{rpmdb}, $state, requested => undef);
$packages->resolve_requested($packages->{rpmdb}, $state, callback_choices => \&packageCallbackChoices);
}
-# return;
-# my ($packages, $prefix, $base, $toRemove, $toSave) = @_;
-# local $_; #- else perl complains on the map { ... } grep { ... } @...;
-#
-# local (*UPGRADE_INPUT, *UPGRADE_OUTPUT); pipe UPGRADE_INPUT, UPGRADE_OUTPUT;
-# if (my $pid = fork()) {
-# @{$toRemove || []} = (); #- reset this one.
-#
-# close UPGRADE_OUTPUT;
-# while (<UPGRADE_INPUT>) {
-# chomp;
-# my ($action, $name) = /^([\w\d]*):(.*)/;
-# for ($action) {
-# /remove/ and do { push @$toRemove, $name; next };
-# /keepfiles/ and do { push @$toSave, $name; next };
-#
-# my $p = $packages->{names}{$name} or die "unable to find package ($name)";
-# /^\d*$/ and do { $p->[$INSTALLED_CUMUL_SIZE] = $action; next };
-# /installed/ and do { packageSetFlagInstalled($p, 1); next };
-# /select/ and do { selectPackage($packages, $p); next };
-#
-# die "unknown action ($action)";
-# }
-# }
-# close UPGRADE_INPUT;
-# waitpid $pid, 0;
-# } else {
-# close UPGRADE_INPUT;
-#
-# my $db = rebuild_db_open_for_traversal($packages, $prefix);
-# #- used for package that are not correctly updated.
-# #- should only be used when nothing else can be done correctly.
-# my %upgradeNeedRemove = (
-## 'libstdc++' => 1,
-## 'compat-glibc' => 1,
-## 'compat-libs' => 1,
-# );
-#
-# #- generel purpose for forcing upgrade of package whatever version is.
-# my %packageNeedUpgrade = (
-# #'lilo' => 1, #- this package has been misnamed in 7.0.
-# );
-#
-# #- help removing package which may have different release numbering
-# my %toRemove; map { $toRemove{$_} = 1 } @{$toRemove || []};
-#
-# #- help searching package to upgrade in regard to already installed files.
-# my %installedFilesForUpgrade;
-#
-# #- help keeping memory by this set of package that have been obsoleted.
-# my %obsoletedPackages;
-#
-# #- make a subprocess here for reading filelist, this is important
-# #- not to waste a lot of memory for the main program which will fork
-# #- latter for each transaction.
-# local (*INPUT, *OUTPUT_CHILD); pipe INPUT, OUTPUT_CHILD;
-# local (*INPUT_CHILD, *OUTPUT); pipe INPUT_CHILD, OUTPUT;
-# if (my $pid = fork()) {
-# close INPUT_CHILD;
-# close OUTPUT_CHILD;
-# select((select(OUTPUT), $| = 1)[0]);
-#
-# #- internal reading from interactive mode of parsehdlist.
-# #- takes a code to call with the line read, this avoid allocating
-# #- memory for that.
-# my $ask_child = sub {
-# my ($name, $tag, $code) = @_;
-# $code or die "no callback code for parsehdlist output";
-# print OUTPUT "$name:$tag\n";
-#
-# local $_;
-# while (<INPUT>) {
-# chomp;
-# /^\s*$/ and last;
-# $code->($_);
-# }
-# };
-#
-# #- select packages which obseletes other package, obselete package are not removed,
-# #- should we remove them ? this could be dangerous !
-# foreach my $p (values %{$packages->{names}}) {
-# $ask_child->(packageName($p), "obsoletes", sub {
-# #- take care of flags and version and release if present
-# local ($_) = @_;
-# if (my ($n,$o,$v,$r) = /^(\S*)\s*(\S*)\s*([^\s-]*)-?(\S*)/) {
-# my $obsoleted = 0;
-# my $check_obsoletes = sub {
-# my ($header) = @_;
-# (!$v || eval(versionCompare(c::headerGetEntry($header, 'version'), $v) . $o . 0)) &&
-# (!$r || versionCompare(c::headerGetEntry($header, 'version'), $v) != 0 ||
-# eval(versionCompare(c::headerGetEntry($header, 'release'), $r) . $o . 0)) or return;
-# ++$obsoleted;
-# };
-# c::rpmdbNameTraverse($db, $n, $check_obsoletes);
-# if ($obsoleted > 0) {
-# log::l("selecting " . packageName($p) . " by selection on obsoletes");
-# $obsoletedPackages{$1} = undef;
-# selectPackage($packages, $p);
-# }
-# }
-# });
-# }
-#
-# #- mark all files which are not in /etc/rc.d/ for packages which are already installed but which
-# #- are not in the packages list to upgrade.
-# #- the 'installed' property will make a package unable to be selected, look at select.
-# c::rpmdbTraverse($db, sub {
-# my ($header) = @_;
-# my $otherPackage = (c::headerGetEntry($header, 'release') !~ /mdk\w*$/ &&
-# (c::headerGetEntry($header, 'name'). '-' .
-# c::headerGetEntry($header, 'version'). '-' .
-# c::headerGetEntry($header, 'release')));
-# my $p = $packages->{names}{c::headerGetEntry($header, 'name')};
-#
-# if ($p) {
-# my $epoch_cmp = c::headerGetEntry($header, 'epoch') <=> packageEpoch($p);
-# my $version_cmp = $epoch_cmp == 0 && versionCompare(c::headerGetEntry($header, 'version'),
-# packageVersion($p));
-# my $version_rel_test = $epoch_cmp > 0 || $epoch_cmp == 0 &&
-# ($version_cmp > 0 || $version_cmp == 0 &&
-# versionCompare(c::headerGetEntry($header, 'release'), packageRelease($p)) >= 0);
-# if ($packageNeedUpgrade{packageName($p)}) {
-# log::l("package ". packageName($p) ." need to be upgraded");
-# } elsif ($version_rel_test) { #- by default, package are upgraded whatever version is !
-# if ($otherPackage && $version_cmp <= 0) {
-# log::l("force upgrading $otherPackage since it will not be updated otherwise");
-# } else {
-# #- let the parent known this installed package.
-# print UPGRADE_OUTPUT "installed:" . packageName($p) . "\n";
-# packageSetFlagInstalled($p, 1);
-# }
-# } elsif ($upgradeNeedRemove{packageName($p)}) {
-# my $otherPackage = (c::headerGetEntry($header, 'name'). '-' .
-# c::headerGetEntry($header, 'version'). '-' .
-# c::headerGetEntry($header, 'release'));
-# log::l("removing $otherPackage since it will not upgrade correctly!");
-# $toRemove{$otherPackage} = 1; #- force removing for theses other packages, select our.
-# }
-# } else {
-# if (exists $obsoletedPackages{c::headerGetEntry($header, 'name')}) {
-# my @files = c::headerGetEntry($header, 'filenames');
-# @installedFilesForUpgrade{grep { ($_ !~ m|^/dev/| && $_ !~ m|^/etc/rc.d/| && $_ !~ m|\.la$| &&
-# ! -d "$prefix/$_" && ! -l "$prefix/$_") } @files} = ();
-# }
-# }
-# });
-#
-# #- find new packages to upgrade.
-# foreach my $p (values %{$packages->{names}}) {
-# my $skipThis = 0;
-# my $count = c::rpmdbNameTraverse($db, packageName($p), sub {
-# my ($header) = @_;
-# $skipThis ||= packageFlagInstalled($p);
-# });
-#
-# #- skip if not installed (package not found in current install).
-# $skipThis ||= ($count == 0);
-#
-# #- make sure to upgrade package that have to be upgraded.
-# $packageNeedUpgrade{packageName($p)} and $skipThis = 0;
-#
-# #- select the package if it is already installed with a lower version or simply not installed.
-# unless ($skipThis) {
-# my $cumulSize;
-#
-# selectPackage($packages, $p);
-#
-# #- keep in mind installed files which are not being updated. doing this costs in
-# #- execution time but use less memory, else hash all installed files and unhash
-# #- all file for package marked for upgrade.
-# c::rpmdbNameTraverse($db, packageName($p), sub {
-# my ($header) = @_;
-# $cumulSize += c::headerGetEntry($header, 'size');
-# my @files = c::headerGetEntry($header, 'filenames');
-# @installedFilesForUpgrade{grep { ($_ !~ m|^/dev/| && $_ !~ m|^/etc/rc.d/| && $_ !~ m|\.la$| &&
-# ! -d "$prefix/$_" && ! -l "$prefix/$_") } @files} = ();
-# });
-#
-# $ask_child->(packageName($p), "files", sub {
-# delete $installedFilesForUpgrade{$_[0]};
-# });
-#
-# #- keep in mind the cumul size of installed package since they will be deleted
-# #- on upgrade, only for package that are allowed to be upgraded.
-# if (allowedToUpgrade(packageName($p))) {
-# print UPGRADE_OUTPUT "$cumulSize:" . packageName($p) . "\n";
-# }
-# }
-# }
-#
-# #- unmark all files for all packages marked for upgrade. it may not have been done above
-# #- since some packages may have been selected by depsList.
-# foreach my $p (values %{$packages->{names}}) {
-# if (packageFlagSelected($p)) {
-# $ask_child->(packageName($p), "files", sub {
-# delete $installedFilesForUpgrade{$_[0]};
-# });
-# }
-# }
-#
-# #- select packages which contains marked files, then unmark on selection.
-# #- a special case can be made here, the selection is done only for packages
-# #- requiring locales if the locales are selected.
-# #- another special case are for devel packages where fixes over the time has
-# #- made some files moving between the normal package and its devel couterpart.
-# #- if only one file is affected, no devel package is selected.
-# foreach my $p (values %{$packages->{names}}) {
-# unless (packageFlagSelected($p)) {
-# my $toSelect = 0;
-# $ask_child->(packageName($p), "files", sub {
-# if ($_[0] !~ m|^/dev/| && $_[0] !~ m|^/etc/rc.d/| && $_ !~ m|\.la$| && exists $installedFilesForUpgrade{$_[0]}) {
-# ++$toSelect if ! -d "$prefix/$_[0]" && ! -l "$prefix/$_[0]";
-# }
-# delete $installedFilesForUpgrade{$_[0]};
-# });
-# if ($toSelect) {
-# if ($toSelect <= 1 && packageName($p) =~ /-devel/) {
-# log::l("avoid selecting " . packageName($p) . " as not enough files will be updated");
-# } else {
-# #- default case is assumed to allow upgrade.
-# my @deps = map { my $p = packageById($packages, $_);
-# if_($p && packageName($p) =~ /locales-/, $p) } packageDepsId($p);
-# if (@deps == 0 || @deps > 0 && (grep { !packageFlagSelected($_) } @deps) == 0) {
-# log::l("selecting " . packageName($p) . " by selection on files");
-# selectPackage($packages, $p);
-# } else {
-# log::l("avoid selecting " . packageName($p) . " as its locales language is not already selected");
-# }
-# }
-# }
-# }
-# }
-#
-# #- clean memory...
-# %installedFilesForUpgrade = ();
-#
-# #- no need to still use the child as this point, we can let him to terminate.
-# close OUTPUT;
-# close INPUT;
-# waitpid $pid, 0;
-# } else {
-# close INPUT;
-# close OUTPUT;
-# open STDIN, "<&INPUT_CHILD";
-# open STDOUT, ">&OUTPUT_CHILD";
-# exec if_($ENV{LD_LOADER}, $ENV{LD_LOADER}), "parsehdlist", "--interactive", map { "/tmp/$_->{hdlist}" } values %{$packages->{mediums}}
-# or c::_exit(1);
-# }
-#
-# #- let the parent known about what we found here!
-# foreach my $p (values %{$packages->{names}}) {
-# print UPGRADE_OUTPUT "select:" . packageName($p) . "\n" if packageFlagSelected($p);
-# }
-#
-# #- clean false value on toRemove.
-# delete $toRemove{''};
-#
-# #- get filenames that should be saved for packages to remove.
-# #- typically config files, but it may broke for packages that
-# #- are very old when compabilty has been broken.
-# #- but new version may saved to .rpmnew so it not so hard !
-# if ($toSave && keys %toRemove) {
-# c::rpmdbTraverse($db, sub {
-# my ($header) = @_;
-# my $otherPackage = (c::headerGetEntry($header, 'name'). '-' .
-# c::headerGetEntry($header, 'version'). '-' .
-# c::headerGetEntry($header, 'release'));
-# if ($toRemove{$otherPackage}) {
-# print UPGRADE_OUTPUT "remove:$otherPackage\n";
-# if (packageFlagBase($packages->{names}{c::headerGetEntry($header, 'name')})) {
-# delete $toRemove{$otherPackage}; #- keep it selected, but force upgrade.
-# } else {
-# my @files = c::headerGetEntry($header, 'filenames');
-# my @flags = c::headerGetEntry($header, 'fileflags');
-# for my $i (0..$#flags) {
-# if ($flags[$i] & c::RPMFILE_CONFIG()) {
-# print UPGRADE_OUTPUT "keepfiles:$files[$i]\n" unless $files[$i] =~ /kdelnk/;
-# }
-# }
-# }
-# }
-# });
-# }
-#
-# #- close db, job finished !
-# c::rpmdbClose($db);
-# log::l("done selecting packages to upgrade");
-#
-# close UPGRADE_OUTPUT;
-# c::_exit(0);
-# }
-#
-# #- keep a track of packages that are been selected for being upgraded,
-# #- these packages should not be unselected (unless expertise)
-# foreach my $p (values %{$packages->{names}}) {
-# packageSetFlagUpgrade($p, 1) if packageFlagSelected($p);
-# }
-#}
sub allowedToUpgrade { $_[0] !~ /^(kernel|kernel22|kernel2.2|kernel-secure|kernel-smp|kernel-linus|kernel-linus2.2|hackkernel|kernel-enterprise)$/ }
@@ -1600,48 +1108,6 @@ sub selected_leaves {
foreach (@{$packages->{depslist}}) {
$_->flag_requested && !$_->flag_base and push @leaves, $_->name;
}
-# my %l;
-#
-# #- initialize l with all id, not couting base package.
-# foreach my $id (0 .. $#{$packages->{depslist}}) {
-# my $pkg = packageById($packages, $id) or next;
-# packageSelectedOrInstalled($pkg) && !$pkg->flag_base or next;
-# $l{$id} = 1;
-# }
-#
-# foreach my $id (keys %l) {
-# #- when a package is in a choice, increase its value in hash l, because
-# #- it has to be examined before when we will select them later.
-# #- NB: this number may be computed before to save time.
-# my $p = $packages->{depslist}[$id] or next;
-# foreach (packageDepsId($p)) {
-# if (/\|/) {
-# foreach (split '\|') {
-# exists $l{$_} or next;
-# $l{$_} > 1 + $l{$id} or $l{$_} = 1 + $l{$id};
-# }
-# }
-# }
-# }
-#
-# #- at this level, we can remove selected packages that are already
-# #- required by other, but we have to sort according to choice usage.
-# foreach my $id (sort { $l{$b} <=> $l{$a} || $b <=> $a } keys %l) {
-# #- do not count already deleted id, else cycles will be removed.
-# $l{$id} or next;
-#
-# my $p = $packages->{depslist}[$id] or next;
-# foreach (packageDepsId($p)) {
-# #- choices need no more to be examined, this has been done above.
-# /\|/ and next;
-# #- improve value of this one, so it will be selected before.
-# $l{$id} < $l{$_} and $l{$id} = $l{$_};
-# $l{$_} = 0;
-# }
-# }
-#
-# #- now sort again according to decrementing value, and gives packages name.
-# [ map { packageName($packages->{depslist}[$_]) } sort { $l{$b} <=> $l{$a} } grep { $l{$_} > 0 } keys %l ];
\@leaves;
}