diff options
| -rw-r--r-- | perl-install/ChangeLog | 6 | ||||
| -rw-r--r-- | perl-install/install_any.pm | 5 | ||||
| -rw-r--r-- | perl-install/install_steps_gtk.pm | 11 | ||||
| -rw-r--r-- | perl-install/install_steps_interactive.pm | 4 | ||||
| -rw-r--r-- | perl-install/pkgs.pm | 102 | ||||
| -rw-r--r-- | tools/Makefile | 5 |
6 files changed, 76 insertions, 57 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{''}; diff --git a/tools/Makefile b/tools/Makefile index bece8e754..91646e7ca 100644 --- a/tools/Makefile +++ b/tools/Makefile @@ -7,7 +7,7 @@ CFLAGS = -Wall .PHONY: clean install $(DIRS) -all: $(BASE)/depslist $(DIRS) xhost+ install +all: $(BASE)/depslist $(BASE)/filelist $(DIRS) xhost+ install $(DIRS): make -C $@ @@ -30,6 +30,9 @@ $(BASE)/compss: $(BASE)/hdlists $(BASE)/hdlist.cz2 $(BASE)/depslist: $(BASE)/hdlists $(BASE)/hdlist.cz2 gendepslist2 -o $@ `cat $< | perl -pe 's|(.*)|'$(BASE)'/$$1|' ` +$(BASE)/filelist: $(RPMS) + genfilelist $(ROOTDEST)/Mandrake/RPMS* >$@ + $(BASE)/hdlist.cz2: genhdlists --noclean --distrib $(ROOTDEST) |