From f250526dd66a5eaecccdeba591ca1310b359f8d7 Mon Sep 17 00:00:00 2001 From: Francois Pons Date: Thu, 18 Jul 2002 15:53:32 +0000 Subject: removed all the commented out code obsoleted. --- perl-install/pkgs.pm | 538 +-------------------------------------------------- 1 file changed, 2 insertions(+), 536 deletions(-) (limited to 'perl-install/pkgs.pm') 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 () { -# 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 () { -# 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 () { -# 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; } -- cgit v1.2.1