summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
authorFrancois Pons <fpons@mandriva.com>1999-12-08 18:58:45 +0000
committerFrancois Pons <fpons@mandriva.com>1999-12-08 18:58:45 +0000
commit1934b3123c81c2ccb425626aa61ed29e38780ddf (patch)
treec66e075fb0a7ffa7f7cd6f53a65e015ec864b855 /perl-install
parent1cf2e9bf3d2dd8e82380afdcf3cb8f68c6285dcc (diff)
downloaddrakx-backup-do-not-use-1934b3123c81c2ccb425626aa61ed29e38780ddf.tar
drakx-backup-do-not-use-1934b3123c81c2ccb425626aa61ed29e38780ddf.tar.gz
drakx-backup-do-not-use-1934b3123c81c2ccb425626aa61ed29e38780ddf.tar.bz2
drakx-backup-do-not-use-1934b3123c81c2ccb425626aa61ed29e38780ddf.tar.xz
drakx-backup-do-not-use-1934b3123c81c2ccb425626aa61ed29e38780ddf.zip
*** empty log message ***
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/c/stuff.pm1
-rw-r--r--perl-install/c/stuff.xs.pm32
-rw-r--r--perl-install/install2.pm1
-rw-r--r--perl-install/install_any.pm2
-rw-r--r--perl-install/install_steps.pm22
-rw-r--r--perl-install/pkgs.pm43
6 files changed, 78 insertions, 23 deletions
diff --git a/perl-install/c/stuff.pm b/perl-install/c/stuff.pm
index daf5d8ef3..2cea57d2c 100644
--- a/perl-install/c/stuff.pm
+++ b/perl-install/c/stuff.pm
@@ -24,6 +24,7 @@ sub headerGetEntry {
$q eq 'filenames' and return headerGetEntry_string_list($h, RPMTAG_FILENAMES());
$q eq 'obsoletes' and return headerGetEntry_string_list($h, RPMTAG_OBSOLETES());
$q eq 'requires' and return headerGetEntry_string_list($h, RPMTAG_REQUIRENAME());
+ $q eq 'fileflags' and return headerGetEntry_int_list($h, RPMTAG_FILEFLAGS());
}
1;
diff --git a/perl-install/c/stuff.xs.pm b/perl-install/c/stuff.xs.pm
index 092b136d3..6ca1e32d3 100644
--- a/perl-install/c/stuff.xs.pm
+++ b/perl-install/c/stuff.xs.pm
@@ -251,7 +251,7 @@ rpmdbTraverse(db, ...)
}
count = 0;
num = rpmdbFirstRecNum(db);
- while (num) {
+ while (num>0) {
if (callback != &PL_sv_undef && SvROK(callback)) {
h = rpmdbGetRecord(db, num);
{
@@ -623,19 +623,37 @@ headerGetEntry_int(h, query)
RETVAL
void
+headerGetEntry_int_list(h, query)
+ void *h
+ int query
+ PPCODE:
+ int i, type, count = 0;
+ int_32 *intlist = (void **) NULL;
+ if (headerGetEntry((Header) h, query, &type, (void**) &intlist, &count)) {
+ if (count > 0) {
+ EXTEND(SP, count);
+ for (i = 0; i < count; i++) {
+ PUSHs(sv_2mortal(newSViv(intlist[i])));
+ }
+ }
+ }
+
+void
headerGetEntry_string_list(h, query)
void *h
int query
PPCODE:
int i, type, count = 0;
char **strlist = (char **) NULL;
- if (headerGetEntry((Header) h, query, &type, (void**) &strlist, &count) && count) {
- EXTEND(SP, count);
- for (i = 0; i < count; i++) {
- PUSHs(sv_2mortal(newSVpv(strlist[i], 0)));
+ if (headerGetEntry((Header) h, query, &type, (void**) &strlist, &count)) {
+ if (count > 0) {
+ EXTEND(SP, count);
+ for (i = 0; i < count; i++) {
+ PUSHs(sv_2mortal(newSVpv(strlist[i], 0)));
+ }
}
+ free(strlist);
}
- free(strlist);
';
@macros = (
@@ -645,7 +663,7 @@ headerGetEntry_string_list(h, query)
VT_ACTIVATE VT_WAITACTIVE VT_GETSTATE CDROM_LOCKDOOR CDROMEJECT
) ],
);
-push @macros, [ qw(int RPMTAG_NAME RPMTAG_GROUP RPMTAG_SIZE RPMTAG_VERSION RPMTAG_SUMMARY RPMTAG_DESCRIPTION RPMTAG_RELEASE RPMTAG_ARCH RPMTAG_FILENAMES RPMTAG_OBSOLETES RPMTAG_REQUIRENAME) ]
+push @macros, [ qw(int RPMTAG_NAME RPMTAG_GROUP RPMTAG_SIZE RPMTAG_VERSION RPMTAG_SUMMARY RPMTAG_DESCRIPTION RPMTAG_RELEASE RPMTAG_ARCH RPMTAG_FILENAMES RPMTAG_OBSOLETES RPMTAG_REQUIRENAME RPMTAG_FILEFLAGS RPMFILE_CONFIG) ]
if $ENV{C_RPM};
$\= "\n";
diff --git a/perl-install/install2.pm b/perl-install/install2.pm
index 3b9330cb5..4aa49b6e4 100644
--- a/perl-install/install2.pm
+++ b/perl-install/install2.pm
@@ -140,6 +140,7 @@ $o = $::o = {
lang => 'en',
isUpgrade => 0,
toRemove => [],
+ toSave => [],
#- simple_themes => 1,
#- installClass => "normal",
diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm
index b8bea61b0..b4e432f30 100644
--- a/perl-install/install_any.pm
+++ b/perl-install/install_any.pm
@@ -153,7 +153,7 @@ sub selectPackagesToUpgrade($) {
my ($o) = @_;
require pkgs;
- pkgs::selectPackagesToUpgrade($o->{packages}, $o->{prefix}, $o->{base}, $o->{toRemove});
+ pkgs::selectPackagesToUpgrade($o->{packages}, $o->{prefix}, $o->{base}, $o->{toRemove}, $o->{toSave});
}
sub addToBeDone(&$) {
diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm
index 56f8c9064..c650032dc 100644
--- a/perl-install/install_steps.pm
+++ b/perl-install/install_steps.pm
@@ -211,15 +211,21 @@ sub installPackages($$) {
my ($o, $packages) = @_;
if (@{$o->{toRemove} || []}) {
- my @mdkgisave = qw( /etc/passwd );
-
#- hack to ensure proper upgrade of packages from other distribution,
- #- as release number are not mandrake based. this causes save of very
- #- important files (not all) and restore them after.
- #- it is not enough to dop only that.
- do { unlink "$o->{prefix}/$_.mdkgisave"; rename "$o->{prefix}/$_", "$o->{prefix}/$_.mdkgisave"; } foreach @mdkgisave;
+ #- as release number are not mandrake based. this causes save of
+ #- important files and restore them after.
+ foreach (@{$o->{toSave} || []}) {
+ if (-e "$o->{prefix}/$_") {
+ unlink "$o->{prefix}/$_.mdkgisave"; rename "$o->{prefix}/$_", "$o->{prefix}/$_.mdkgisave";
+ }
+ }
pkgs::remove($o->{prefix}, $o->{toRemove});
- do { unlink "$o->{prefix}/$_"; rename "$o->{prefix}/$_.mdkgisave", "$o->{prefix}/$_"; } foreach @mdkgisave;
+ foreach (@{$o->{toSave} || []}) {
+ if (-e "$o->{prefix}/$_.mdkgisave") {
+ unlink "$o->{prefix}/$_"; rename "$o->{prefix}/$_.mdkgisave", "$o->{prefix}/$_";
+ }
+ }
+ $o->{toSave} = [];
}
#- hack to ensure proper ordering for installation of packages.
@@ -574,7 +580,7 @@ sub setupXfreeAfter {
Xconfigurator::rewriteInittab(3) unless $::testing; #- disable automatic start-up of X11 on error.
}
}
- if ($o->{X}{card}{default_depth} >= 16 || $o->{X}{card}{default_wres} >= 1024) {
+ if ($o->{X}{card}{default_depth} >= 16 && $o->{X}{card}{default_wres} >= 1024) {
log::l("setting large icon style for kde");
install_any::kderc_largedisplay($o->{prefix});
}
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index 870d8bb9c..57a4e1d67 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -363,8 +363,8 @@ sub versionCompare($$) {
}
}
-sub selectPackagesToUpgrade($$$;$) {
- my ($packages, $prefix, $base, $toRemove) = @_;
+sub selectPackagesToUpgrade($$$;$$) {
+ my ($packages, $prefix, $base, $toRemove, $toSave) = @_;
log::l("reading /usr/lib/rpm/rpmrc");
c::rpmReadConfigFiles() or die "can't read rpm config files";
@@ -377,8 +377,7 @@ sub selectPackagesToUpgrade($$$;$) {
my %installedFilesForUpgrade; #- help searching package to upgrade in regard to already installed files.
#- help removing package which may have different release numbering
- my %toRemove;
- map { $toRemove{$_} = 1 } @{$toRemove || []};
+ my %toRemove; map { $toRemove{$_} = 1 } @{$toRemove || []};
#- 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.
@@ -391,14 +390,15 @@ sub selectPackagesToUpgrade($$$;$) {
c::headerGetEntry($header, 'version'). '-' .
c::headerGetEntry($header, 'release')));
if ($p) {
- if ($otherPackage && versionCompare(c::headerGetEntry($header, 'version'), $p->{version}) <= 0) {
+ my $version_cmp = versionCompare(c::headerGetEntry($header, 'version'), $p->{version});
+ if ($otherPackage && $version_cmp <= 0) {
$toRemove{$otherPackage} = 1;
} else {
eval { getHeader($p) }; $@ && log::l("cannot get the header for package $p->{name}");
$p->{installed} = 1 if $p->{header} ?
c::rpmVersionCompare($header, $p->{header}) >= 0 :
- (versionCompare(c::headerGetEntry($header, 'version'), $p->{version}) > 0 ||
- versionCompare(c::headerGetEntry($header, 'version'), $p->{version}) == 0 &&
+ ($version_cmp > 0 ||
+ $version_cmp == 0 &&
versionCompare(c::headerGetEntry($header, 'release'), $p->{release} >= 0));
}
} else {
@@ -496,6 +496,35 @@ sub selectPackagesToUpgrade($$$;$) {
#- 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 are saved to .rpmnew so it not so hard !
+ if ($toSave && keys %toRemove) {
+ c::rpmdbTraverse($db, sub {
+ my ($header) = @_;
+ print "header=$header\n";
+ my $otherPackage = (c::headerGetEntry($header, 'name'). '-' .
+ c::headerGetEntry($header, 'version'). '-' .
+ c::headerGetEntry($header, 'release'));
+ print "other=$otherPackage\n";
+ if ($toRemove{$otherPackage}) {
+ my @files = c::headerGetEntry($header, 'filenames');
+ my @flags = c::headerGetEntry($header, 'fileflags');
+ print "count-1=$#files\n";
+ for my $i (0..$#flags) {
+ if ($flags[$i] & c::RPMFILE_CONFIG()) {
+ print "before adding ... ";
+ push @$toSave, $files[$i];
+ print "after adding ... $files[$i]\n";
+ }
+ }
+ }
+ print "before leaving........\n\n";
+ });
+ }
+
+ log::l("before closing db");
#- close db, job finished !
c::rpmdbClose($db);
log::l("done selecting packages to upgrade");