summaryrefslogtreecommitdiffstats
path: root/perl-install/pkgs.pm
diff options
context:
space:
mode:
authorFrancois Pons <fpons@mandriva.com>1999-10-01 15:57:39 +0000
committerFrancois Pons <fpons@mandriva.com>1999-10-01 15:57:39 +0000
commit3cf33eab50fd8e7eb927c617986f62938e0485a1 (patch)
tree9f585993cd1b4d0cace49969a118ea56227044f9 /perl-install/pkgs.pm
parent4d03533983eda1325e04122a4dc478d892862471 (diff)
downloaddrakx-3cf33eab50fd8e7eb927c617986f62938e0485a1.tar
drakx-3cf33eab50fd8e7eb927c617986f62938e0485a1.tar.gz
drakx-3cf33eab50fd8e7eb927c617986f62938e0485a1.tar.bz2
drakx-3cf33eab50fd8e7eb927c617986f62938e0485a1.tar.xz
drakx-3cf33eab50fd8e7eb927c617986f62938e0485a1.zip
*** empty log message ***
Diffstat (limited to 'perl-install/pkgs.pm')
-rw-r--r--perl-install/pkgs.pm78
1 files changed, 75 insertions, 3 deletions
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index 75a2434f5..489c2dc83 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -136,9 +136,9 @@ sub psUsingHdlist() {
$packages{$name} = {
name => $name, header => $header, selected => 0, deps => [],
- version => c::headerGetEntry($header, 'version'),
- release => c::headerGetEntry($header, 'release'),
- size => c::headerGetEntry($header, 'size'),
+ version => c::headerGetEntry($header, 'version'),
+ release => c::headerGetEntry($header, 'release'),
+ size => c::headerGetEntry($header, 'size'),
};
}
log::l("psUsingHdlist read " . scalar keys(%packages) . " headers");
@@ -288,6 +288,78 @@ sub getHeader($) {
$p->{header};
}
+sub findPackagesToUpgrade($$) {
+ my ($packages, $prefix) = @_;
+
+ log::l("reading /usr/lib/rpm/rpmrc");
+ c::rpmReadConfigFiles() or die "can't read rpm config files";
+ log::l("\tdone");
+
+ my $db = c::rpmdbOpenForTraversal($prefix) or die "unable to open $prefix/var/lib/rpm/packages.rpm";
+ my %installedFilesToRemove; #- files installed but not present in the package to upgrade -> to remove.
+
+ #- mark all files which are not in /etc/rc.d/ for packages which are already installed.
+ c::rpmdbTraverse($db, sub {
+ my ($header) = @_;
+ my @filenames = c::headerGetEntry($header, 'filenames');
+ @installedFilesToRemove{grep { $_ !~ m@/etc/rc.d/@ } @filenames} = ();
+ });
+
+ #- find new packages to upgrade.
+ foreach (values %$packages) {
+ my $p = $_;
+ my $skipThis = 0;
+ $skipThis ||= 1 if c::rpmdbNameTraverse($db, $p->{name}, sub {
+ my ($header) = @_;
+ $skipThis ||= (c::headerGetEntry($header, 'version') ge $p->{version});
+ }) == 0; #- skip if not installed (package not found in current install).
+ #- select the package if it is already installed with a lower version or simply not installed.
+ pkgs::select($packages, $p) unless ($skipThis || $p->{selected});
+ }
+
+ #- unmark all files for all packages marked for upgrade.
+ foreach (values %$packages) {
+ my $p = $_;
+
+ if ($p->{selected}) {
+ my @availFiles = $p->{filename} ? c::headerGetEntry($p->{header}, 'filename') : ();
+ map { delete $installedFilesToRemove{$_} } grep { $_ !~ m@/etc/rc.d/@ } @availFiles;
+ }
+ }
+
+ #- select packages which contains marked files, then unmark on selection.
+ foreach (values %$packages) {
+ my $p = $_;
+
+ unless ($p->{selected}) {
+ my @availFiles = $p->{filename} ? c::headerGetEntry($p->{header}, 'filename') : ();
+ my $toSelect = 0;
+ map { if (exists $installedFilesToRemove{$_}) {
+ $toSelect = 1; delete $installedFilesToRemove{$_} } } grep { $_ !~ m@/etc/rc.d/@ } @availFiles;
+ pkgs::select($packages, $p) if ($toSelect);
+ }
+ }
+
+ #- select packages which obseletes other package, TODO.
+
+ #- consistency check: deselect all packages with a version lower to already existing.
+ foreach (values %$packages) {
+ my $p = $_;
+ my $skipThis = 0;
+ if ($p->{selected}) {
+ c::rpmdbNameTraverse($db, $p->{name}, sub {
+ my ($header) = @_;
+ $skipThis ||= (c::headerGetEntry($header, 'version') ge $p->{version});
+ });
+ #- unselect the package if it is already installed with a greater or equal version.
+ pkgs::unselect($packages, $p) if ($skipThis);
+ }
+ }
+
+ #- close db, job finished !
+ c::rpmdbClose($db);
+}
+
sub install($$) {
my ($prefix, $toInstall) = @_;