summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
authorFrancois Pons <fpons@mandriva.com>2000-03-31 21:54:17 +0000
committerFrancois Pons <fpons@mandriva.com>2000-03-31 21:54:17 +0000
commitc3ce2573ae05a6145f5cd0c71d2b74b1bc9df754 (patch)
tree9d7c0529277964690cb89f73939eea9fe5f7b172 /perl-install
parentbcd0d92e8b0b72d04b45eeaaea541d672cc46ab7 (diff)
downloaddrakx-backup-do-not-use-c3ce2573ae05a6145f5cd0c71d2b74b1bc9df754.tar
drakx-backup-do-not-use-c3ce2573ae05a6145f5cd0c71d2b74b1bc9df754.tar.gz
drakx-backup-do-not-use-c3ce2573ae05a6145f5cd0c71d2b74b1bc9df754.tar.bz2
drakx-backup-do-not-use-c3ce2573ae05a6145f5cd0c71d2b74b1bc9df754.tar.xz
drakx-backup-do-not-use-c3ce2573ae05a6145f5cd0c71d2b74b1bc9df754.zip
*** empty log message ***
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/ChangeLog6
-rw-r--r--perl-install/install_any.pm5
-rw-r--r--perl-install/install_steps_gtk.pm11
-rw-r--r--perl-install/install_steps_interactive.pm4
-rw-r--r--perl-install/pkgs.pm102
5 files changed, 72 insertions, 56 deletions
diff --git a/perl-install/ChangeLog b/perl-install/ChangeLog
index 0eef0c83b..226de0eb3 100644
--- a/perl-install/ChangeLog
+++ b/perl-install/ChangeLog
@@ -1,3 +1,9 @@
+2000-03-31 François Pons <fpons@mandrakesoft.com>
+
+ * install_steps_gtk.pm: made changeMedium sub modification
+ permanent.
+ * pkgs.pm: modified upgrade to avoid use of header.
+
2000-03-31 Pablo Saratxaga <pablo@mandrakesoft.com>
* keyboard.pm: some more choices for PPC keyboards
diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm
index da40d7b6a..30fdec6bc 100644
--- a/perl-install/install_any.pm
+++ b/perl-install/install_any.pm
@@ -46,7 +46,7 @@ sub useMedium($) {
#- does nothing if the function has already been called.
$_[0] and $::o->{method} eq 'cdrom' and setup_postinstall_rpms($::o->{prefix}, $::o->{packages});
- $asked_medium eq $_[0] or log::l("selecting new medium $_[0]");
+ $asked_medium eq $_[0] or log::l("selecting new medium \"$_[0]\"");
$asked_medium = $_[0];
}
sub changeMedium($$) {
@@ -58,7 +58,8 @@ sub relGetFile($) {
local $_ = $_[0];
m|^Mandrake/| and return $_;
/\.img$/ and return "images/$_";
- my $dir = m|/| ? "mdkinst" : /^(?:compss|compssList|compssUsers|depslist.*|hdlist.*)$/ ? "base/": "RPMS$asked_medium/";
+ my $dir = m|/| ? "mdkinst" : /^(?:compss|compssList|compssUsers|filelist|depslist.*|hdlist.*)$/ ?
+ "base/": "RPMS$asked_medium/";
"Mandrake/$dir$_";
}
sub errorOpeningFile($) {
diff --git a/perl-install/install_steps_gtk.pm b/perl-install/install_steps_gtk.pm
index 5d04915ea..eeb41b1c0 100644
--- a/perl-install/install_steps_gtk.pm
+++ b/perl-install/install_steps_gtk.pm
@@ -558,13 +558,12 @@ sub installPackages {
$w->flush;
} else { unshift @_, $m; goto $oldInstallCallback }
};
- my $oldChangeMedium = \&install_any::changeMedium;
- local *install_any::changeMedium = sub {
+ #- the modification is not local as the box should be living for other package installation.
+ undef *install_any::changeMedium;
+ *install_any::changeMedium = sub {
my ($method, $medium) = @_;
- my %medium_msg = (
- '' => _("Installation CD #1"),
- );
- $medium_msg{$medium} or $medium_msg{$medium} = _("Installation CD #%s", $medium);
+ my %medium_msg = ();
+ $medium_msg{$medium} or $medium_msg{$medium} = _("Installation CD #%s", ($medium || 1));
my %method_msg = (
cdrom =>
_("Change your Cd-Rom!
diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm
index a87ab9ea3..aa08eaeba 100644
--- a/perl-install/install_steps_interactive.pm
+++ b/perl-install/install_steps_interactive.pm
@@ -405,7 +405,7 @@ sub configureNetwork($) {
install_steps::configureNetwork($o);
#- added ppp configuration after ethernet one.
- if ($o->ask_yesorno([ _("Modem Configuration") ],
+ if (!$::beginner && $o->ask_yesorno([ _("Modem Configuration") ],
_("Do you want to configure Dialup with modem networking for your system?"), 0)) {
$o->pppConfig;
}
@@ -491,8 +491,6 @@ _("Domain name") => \$m->{domain},
_("First DNS Server") => \$m->{dns1},
_("Second DNS Server") => \$m->{dns2},
]);
-
- $o->miscellaneousNetwork();
}
#------------------------------------------------------------------------------
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index 870904ff4..f9b569dee 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -546,6 +546,19 @@ sub selectPackagesToUpgrade($$$;$$) { #- TODO
my $db = c::rpmdbOpenForTraversal($prefix) or die "unable to open $prefix/var/lib/rpm/packages.rpm";
log::l("opened rpm database for examining existing packages");
+ #- get filelist of package to avoid getting all header into memory.
+ my %filelist;
+ my $current;
+ my $f = install_any::getFile("filelist") or log::l("unable to get filelist of packages");
+ foreach (<$f>) {
+ chomp;
+ if (/^#(.*)/) {
+ $current = $filelist{$1} = [];
+ } else {
+ push @$current, $_;
+ }
+ }
+
local $_; #- else perl complains on the map { ... } grep { ... } @...;
my %installedFilesForUpgrade; #- help searching package to upgrade in regard to already installed files.
@@ -587,9 +600,9 @@ sub selectPackagesToUpgrade($$$;$$) { #- TODO
$toRemove{$otherPackage} = 1; #- force removing for theses other packages, select our.
}
} else {
-# my @files = c::headerGetEntry($header, 'filenames');
-# @installedFilesForUpgrade{grep { ($_ !~ m|^/etc/rc.d/| &&
-# ! -d "$prefix/$_" && ! -l "$prefix/$_") } @files} = ();
+ my @files = c::headerGetEntry($header, 'filenames');
+ @installedFilesForUpgrade{grep { ($_ !~ m|^/etc/rc.d/| &&
+ ! -d "$prefix/$_" && ! -l "$prefix/$_") } @files} = ();
}
});
@@ -617,13 +630,15 @@ sub selectPackagesToUpgrade($$$;$$) { #- TODO
c::rpmdbNameTraverse($db, packageName($p), sub {
my ($header) = @_;
$cumulSize += c::headerGetEntry($header, 'size'); #- all these will be deleted on upgrade.
-# my @files = c::headerGetEntry($header, 'filenames');
-# @installedFilesForUpgrade{grep { ($_ !~ m|^/etc/rc.d/| &&
-# ! -d "$prefix/$_" && ! -l "$prefix/$_") } @files} = ();
+ my @files = c::headerGetEntry($header, 'filenames');
+ @installedFilesForUpgrade{grep { ($_ !~ m|^/etc/rc.d/| &&
+ ! -d "$prefix/$_" && ! -l "$prefix/$_") } @files} = ();
});
-# eval { getHeader ($p) };
-# my @availFiles = $p->{header} ? c::headerGetEntry($p->{header}, 'filenames') : ();
-# map { delete $installedFilesForUpgrade{$_} } grep { $_ !~ m|^/etc/rc.d/| } @availFiles;
+ if (my $list = $filelist{packageName($p)}) {
+ my @commonparts = map { /^=(.*)/ ? ($1) : () } @$list;
+ map { delete $installedFilesForUpgrade{$_} } grep { $_ !~ m|^/etc/rc.d/| }
+ map { /^(\d)(.*)/ ? ($commonparts[$1] . $2) : /^ (.*)/ ? ($1) : () } @$list;
+ }
#- keep in mind the cumul size of installed package since they will be deleted
#- on upgrade.
@@ -633,47 +648,44 @@ sub selectPackagesToUpgrade($$$;$$) { #- TODO
#- 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 (values %{$packages->[0]}) {
-# my $p = $_;
-#
-# if (packageFlagSelected($p)) {
-# eval { getHeader ($p) };
-# my @availFiles = $p->{header} ? c::headerGetEntry($p->{header}, 'filenames') : ();
-# map { delete $installedFilesForUpgrade{$_} } grep { $_ !~ m|^/etc/rc.d/| } @availFiles;
-# }
-# }
+ foreach (values %{$packages->[0]}) {
+ my $p = $_;
+
+ if (packageFlagSelected($p)) {
+ if (my $list = $filelist{packageName($p)}) {
+ my @commonparts = map { /^=(.*)/ ? ($1) : () } @$list;
+ map { delete $installedFilesForUpgrade{$_} } grep { $_ !~ m|^/etc/rc.d/| }
+ map { /^(\d)(.*)/ ? ($commonparts[$1] . $2) : /^ (.*)/ ? ($1) : () } @$list;
+ }
+ }
+ }
#- select packages which contains marked files, then unmark on selection.
-# foreach (values %$packages) {
-# my $p = $_;
-#
-# unless ($p->{selected}) {
-# eval { getHeader ($p) };
-# my @availFiles = $p->{header} ? c::headerGetEntry($p->{header}, 'filenames') : ();
-# my $toSelect = 0;
-# map { if (exists $installedFilesForUpgrade{$_}) {
-# $toSelect ||= ! -d "$prefix/$_" && ! -l "$prefix/$_"; delete $installedFilesForUpgrade{$_} }
-# } grep { $_ !~ m@^/etc/rc.d/@ } @availFiles;
-# selectPackage($packages, $p) if ($toSelect);
-# }
-# }
+ foreach (values %{$packages->[0]}) {
+ my $p = $_;
+
+ unless ($p->{selected}) {
+ my $toSelect = 0;
+ if (my $list = $filelist{packageName($p)}) {
+ my @commonparts = map { /^=(.*)/ ? ($1) : () } @$list;
+ map { if (exists $installedFilesForUpgrade{$_}) {
+ $toSelect ||= ! -d "$prefix/$_" && ! -l "$prefix/$_"; delete $installedFilesForUpgrade{$_} }
+ } grep { $_ !~ m|^/etc/rc.d/| } map { /^(\d)(.*)/ ? ($commonparts[$1] . $2) : /^ (.*)/ ? ($1) : () } @$list;
+ }
+ selectPackage($packages, $p) if ($toSelect);
+ }
+ }
#- select packages which obseletes other package, obselete package are not removed,
#- should we remove them ? this could be dangerous !
-# foreach (values %$packages) {
-# my $p = $_;
-
-# eval { getHeader ($p) };
-# my @obsoletes = $p->{header} ? c::headerGetEntry(getHeader ($p), 'obsoletes'): ();
-# map { selectPackage($packages, $p) if c::rpmdbNameTraverse($db, $_) > 0 } @obsoletes;
-# }
-
- #- select all base packages which are not installed and not selected.
-# foreach (@$base) {
-# my $p = $packages->[0]{$_} or log::l("missing base package $_"), next;
-# log::l("base package $_ is not installed") unless $p->{installed} || $p->{selected}; #- installed not set on upgrade.
-# selectPackage($packages, $p, 1) unless $p->{selected}; #- if installed it cannot be selected.
-# }
+ foreach (values %{$packages->[0]}) {
+ my $p = $_;
+
+ if (my $list = $filelist{packageName($p)}) {
+ my @obsoletes = map { /^\*(.*)/ ? ($1) : () } @$list;
+ map { selectPackage($packages, $p) if c::rpmdbNameTraverse($db, $_) > 0 } @obsoletes;
+ }
+ }
#- clean false value on toRemove.
delete $toRemove{''};