summaryrefslogtreecommitdiffstats
path: root/urpm.pm
diff options
context:
space:
mode:
Diffstat (limited to 'urpm.pm')
-rw-r--r--urpm.pm216
1 files changed, 215 insertions, 1 deletions
diff --git a/urpm.pm b/urpm.pm
index dfa782d0..24732b39 100644
--- a/urpm.pm
+++ b/urpm.pm
@@ -3,7 +3,7 @@ package urpm;
use strict;
use vars qw($VERSION @ISA);
-$VERSION = '1.40';
+$VERSION = '1.5';
=head1 NAME
@@ -1125,5 +1125,219 @@ sub upload_source_packages {
@$local_sources, @sources;
}
+sub select_packages_to_upgrade {
+ my ($urpm, $prefix, $packages, $remove_packages, $keep_files) = @_;
+ my $db = rpmtools::db_open($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,
+ );
+
+ #- help removing package which may have different release numbering
+ my %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 $pkg (values %{$urpm->{params}{info}}) {
+ $ask_child->($pkg->{name}, "obsoletes", sub {
+ #- take care of flags and version and release if present
+ if ($_[0] =~ /^(\S*)\s*(\S*)\s*([^\s-]*)-?(\S*)/ &&
+ rpmtools::db_traverse_names($db, [], [$1], undef) > 0) {
+ $3 and eval(rpmtools::version_compare($pkg->{version}, $3) . $2 . 0) or next;
+ $4 and eval(rpmtools::version_compare($pkg->{release}, $4) . $2 . 0) or next;
+ $urpm->{log}("selecting $pkg->{name}-$pkg->{version}-$pkg->{release} using obsoletes");
+ $obsoletedPackages{$1} = undef;
+ $pkg->{selected} = 1;
+ }
+ });
+ }
+
+ #- 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.
+ rpmtools::db_traverse($db, [ qw(name version release files) ], sub {
+ my ($p) = @_;
+ my $otherPackage = $p->{release} !~ /mdk\w*$/ && "$p->{name}-$p->{version}-$p->{release}";
+ my $pkg = $urpm->{params}{info}{$p->{name}};
+
+ if ($pkg) {
+ my $version_cmp = rpmtools::version_compare($p->{version}, $pkg->{version});
+ if ($version_cmp > 0 || $version_cmp == 0 &&
+ rpmtools::version_compare($p->{release}, $pkg->{release}) >= 0) {
+ if ($otherPackage && $version_cmp <= 0) {
+ $toRemove{$otherPackage} = 0;
+ $pkg->{selected} = 1;
+ $urpm->{log}("removing $otherPackage to upgrade ...\n to $pkg->{name}-$pkg->{version}-$pkg->{release} since it will not be updated otherwise");
+ } else {
+ $pkg->{installed} = 1;
+ }
+ } elsif ($upgradeNeedRemove{$pkg->{name}}) {
+ my $otherPackage = "$p->{name}-$p->{version}-$p->{release}";
+ $toRemove{$otherPackage} = 0;
+ $pkg->{selected} = 1;
+ $urpm->{log}("removing $otherPackage to upgrade ...\n to $pkg->{name}-$pkg->{version}-$pkg->{release} since it will not upgrade correctly!");
+ }
+ } else {
+ if (! exists $obsoletedPackages{$p->{name}}) {
+ @installedFilesForUpgrade{grep { ($_ !~ m|^/etc/rc.d/| && $_ !~ m|\.la$| &&
+ ! -d "$prefix/$_" && ! -l "$prefix/$_") }
+ @{$p->{files}}} = ();
+ }
+ }
+ });
+
+ #- find new packages to upgrade.
+ foreach my $pkg (values %{$urpm->{params}{info}}) {
+ my $skipThis = 0;
+ my $count = rpmtools::db_traverse_names($db, [ 'name' ], [ $pkg->{name} ], sub {
+ $skipThis ||= $pkg->{installed};
+ });
+
+ #- skip if not installed (package not found in current install).
+ $skipThis ||= ($count == 0);
+
+ #- select the package if it is already installed with a lower version or simply not installed.
+ unless ($skipThis) {
+ my $cumulSize;
+
+ $pkg->{selected} = 1;
+
+ #- 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.
+ rpmtools::db_traverse_names($db, [ qw(name files) ], [ $pkg->{name} ], sub {
+ my ($p) = @_;
+ @installedFilesForUpgrade{grep { ($_ !~ m|^/etc/rc.d/| && $_ !~ m|\.la$| &&
+ ! -d "$prefix/$_" && ! -l "$prefix/$_") }
+ @{$p->{files}}} = ();
+ });
+
+ $ask_child->($pkg->{name}, "files", sub {
+ delete $installedFilesForUpgrade{$_[0]};
+ });
+ }
+ }
+
+ #- 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 $pkg (values %{$urpm->{params}{info}}) {
+ if ($pkg->{selected}) {
+ $ask_child->($pkg->{name}, "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 $pkg (values %{$urpm->{params}{info}}) {
+ unless ($pkg->{selected}) {
+ my $toSelect = 0;
+ $ask_child->($pkg->{name}, "files", sub {
+ if ($_[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 && $pkg->{name} =~ /-devel/) {
+ $urpm->{log}("avoid selecting $pkg->{name}-$pkg->{version}-$pkg->{release} as not enough files will be updated");
+ } else {
+ #- default case is assumed to allow upgrade.
+ my @deps = map { /\|/ and next; #- do not inspect choice
+ my $p = $urpm->{params}{depslist}[$_];
+ $p && $p->{name} =~ /locales-/ ? ($p) : () } split ' ', $pkg->{deps};
+ if (@deps == 0 || @deps > 0 && (grep { !$_->{selected} && !$_->{installed} } @deps) == 0) {
+ $urpm->{log}("selecting $pkg->{name} by selection on files");
+ $pkg->{selected} = 1;
+ } else {
+ $urpm->{log}("avoid selecting $pkg->{name}-$pkg->{version}-$pkg->{release} 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 "parsehdlist", "--interactive", map { "$urpm->{statedir}/$_->{hdlist}" } grep { ! $_->{ignore} } @{$urpm->{media}}
+ or rpmtools::_exit(1);
+ }
+
+ #- let the caller known about what we found here!
+ foreach my $pkg (values %{$urpm->{params}{info}}) {
+ $packages->{$pkg->{id}} = 0 if $pkg->{selected};
+ }
+
+ #- 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 ($keep_files && keys %toRemove) {
+ rpmtools::db_traverse($db, [ qw(name version release conffiles) ], sub {
+ my ($p) = @_;
+ my $otherPackage = "$p->{name}-$p->{version}-$p->{release}";
+ if (exists $toRemove{$otherPackage}) {
+ @{$keep_files}{@{$p->{conffiles} || []}} = ();
+ }
+ });
+ }
+
+ #- close db, job finished !
+ rpmtools::db_close($db);
+}
1;