summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/ChangeLog10
-rw-r--r--perl-install/install2.pm21
-rw-r--r--perl-install/install_any.pm28
-rw-r--r--perl-install/install_steps.pm32
-rw-r--r--perl-install/install_steps_gtk.pm29
-rw-r--r--perl-install/install_steps_interactive.pm24
-rw-r--r--perl-install/pkgs.pm507
7 files changed, 406 insertions, 245 deletions
diff --git a/perl-install/ChangeLog b/perl-install/ChangeLog
index a9339b7c5..44ac3f18d 100644
--- a/perl-install/ChangeLog
+++ b/perl-install/ChangeLog
@@ -1,3 +1,13 @@
+2000-03-01 François Pons <fpons@mandrakesoft.com>
+
+ * *.pm: heavy modification to take into account smaller
+ transaction during installation.
+ still a lot of test to perform, no provides updated currently and
+ building of hdlist.cz2 and depslist.ordered need old files...
+ nothing done for hdlist.gz during post installation, but
+ hdlist.cz2 is already copied in /var/lib/urpmi [and is used during
+ installation of packages as extract_archive need a true file].
+
2000-03-01 Pixel <pixel@mandrakesoft.com>
* install_steps_gtk.pm (new): more intelligent SIGCHLD handler
diff --git a/perl-install/install2.pm b/perl-install/install2.pm
index 18698608b..ed08b72a3 100644
--- a/perl-install/install2.pm
+++ b/perl-install/install2.pm
@@ -338,7 +338,7 @@ sub formatPartitions {
}
mkdir "$o->{prefix}/$_", 0755 foreach
qw(dev etc etc/profile.d etc/sysconfig etc/sysconfig/console etc/sysconfig/network-scripts
- home mnt tmp var var/tmp var/lib var/lib/rpm);
+ home mnt tmp var var/tmp var/lib var/lib/rpm var/lib/urpmi);
mkdir "$o->{prefix}/$_", 0700 foreach qw(root);
raid::prepare_prefixed($o->{raid}, $o->{prefix});
@@ -353,17 +353,26 @@ sub formatPartitions {
#------------------------------------------------------------------------------
sub choosePackages {
require pkgs;
+ print "a\n";
$o->setPackages if $_[1] == 1;
+ print "b\n";
$o->selectPackagesToUpgrade($o) if $o->{isUpgrade} && $_[1] == 1;
+ print "c\n";
if ($_[1] > 1 || !$o->{isUpgrade} || $::expert) {
if ($_[1] == 1) {
$o->{compssUsersChoice}{$_} = 1 foreach @{$o->{compssUsersSorted}}, 'Miscellaneous';
$o->{compssUsersChoice}{KDE} = 0 if $o->{lang} =~ /ja|el|ko|th|vi|zh/; #- gnome handles much this fonts much better
}
+ print "d\n";
$o->choosePackages($o->{packages}, $o->{compss},
$o->{compssUsers}, $o->{compssUsersSorted}, $_[1] == 1);
- pkgs::unselect($o->{packages}, $o->{packages}{kdesu}) if $o->{packages}{kdesu} && $o->{security} > 3;
- $o->{packages}{$_}{selected} = 1 foreach @{$o->{base}}; #- already done by selectPackagesToUpgrade.
+ print "e\n";
+ my $pkg = pkgs::packageByName($o->{packages}, 'kdesu');
+ print "f\n";
+ pkgs::unselectPackage($o->{packages}, $pkg) if $pkg && $o->{security} > 3;
+ print "g\n";
+ pkgs::packageSetFlagSelected(pkgs::packageByName($o->{packages}, $_), 1) foreach @{$o->{base}}; #- already done by selectPackagesToUpgrade.
+ print "h\n";
}
}
@@ -371,9 +380,13 @@ sub choosePackages {
sub doInstallStep {
$o->readBootloaderConfigBeforeInstall if $_[1] == 1;
+ print "i\n";
$o->beforeInstallPackages;
+ print "j\n";
$o->installPackages($o->{packages});
+ print "k\n";
$o->afterInstallPackages;
+ print "l\n";
}
#------------------------------------------------------------------------------
sub miscellaneous {
@@ -470,7 +483,7 @@ sub configureX {
fs::write($o->{prefix}, $o->{fstab}, $o->{manualFstab}, $o->{useSupermount});
modules::write_conf("$o->{prefix}/etc/conf.modules");
- $o->setupXfree if $o->{packages}{XFree86}{installed} || $clicked;
+ $o->setupXfree if pkgs::packageFlagInstalled(pkgs::packageByName($o->{packages}, 'XFree86')) || $clicked;
}
#------------------------------------------------------------------------------
sub exitInstall { $o->exitInstall(getNextStep() eq "exitInstall") }
diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm
index 10572a2e1..b7a4f0e09 100644
--- a/perl-install/install_any.pm
+++ b/perl-install/install_any.pm
@@ -36,7 +36,7 @@ sub relGetFile($) {
local $_ = $_[0];
/\.img$/ and return "images/$_";
my $dir = m|/| ? "mdkinst" :
- member($_, qw(compss compssList compssUsers depslist hdlist)) ? "base/" : "/RPMS/";
+ member($_, qw(compss compssList compssUsers depslist depslist.ordered hdlist hdlist.cz hdlist.cz2)) ? "base/" : "/RPMS/";
$_ = "Mandrake/$dir$_";
s/i386/i586/;
$_;
@@ -123,8 +123,8 @@ sub setPackages($) {
require pkgs;
if (is_empty_hash_ref($o->{packages})) {
- my $useHdlist = $o->{method} !~ /nfs|hd/ || $o->{isUpgrade};
- eval { $o->{packages} = pkgs::psUsingHdlist() } if $useHdlist;
+ my $useHdlist = 1; #$o->{method} !~ /nfs|hd/ || $o->{isUpgrade};
+ eval { $o->{packages} = pkgs::psUsingHdlist($o->{prefix}) } if $useHdlist;
$o->{packages} = pkgs::psUsingDirectory() if !$useHdlist || $@;
push @{$o->{default_packages}}, "nfs-utils-clients" if $o->{method} eq "nfs";
@@ -148,21 +148,21 @@ sub setPackages($) {
push @l, "kapm" if $o->{pcmcia};
$_->{values} = [ map { $_ + 50 } @{$_->{values}} ] foreach grep {$_} map { $o->{packages}{$_} } @l;
- grep { !$o->{packages}{$_} && log::l("missing base package $_") } @{$o->{base}} and die "missing some base packages";
+ grep { !pkgs::packageByName($o->{packages}, $_) && log::l("missing base package $_") } @{$o->{base}} and die "missing some base packages";
} else {
- pkgs::unselect_all($o->{packages});
+ pkgs::unselectAllPackages($o->{packages});
}
#- this will be done if necessary in the selectPackagesToUpgrade,
#- move the selection here ? this will remove the little window.
unless ($o->{isUpgrade}) {
do {
- my $p = $o->{packages}{$_} or log::l("missing base package $_"), next;
- pkgs::select($o->{packages}, $p, 1);
+ my $p = pkgs::packageByName($o->{packages}, $_) or log::l("missing base package $_"), next;
+ pkgs::selectPackage($o->{packages}, $p, 1);
} foreach @{$o->{base}};
do {
- my $p = $o->{packages}{$_} or log::l("missing add-on package $_"), next;
- pkgs::select($o->{packages}, $p);
+ my $p = pkgs::packageByName($o->{packages}, $_) or log::l("missing add-on package $_"), next;
+ pkgs::selectPackage($o->{packages}, $p);
} foreach @{$o->{default_packages}};
}
}
@@ -386,8 +386,7 @@ sub setupFB {
#- install needed packages for frame buffer.
require pkgs;
- pkgs::select($o->{packages}, $o->{packages}{'kernel-fb'});
- pkgs::select($o->{packages}, $o->{packages}{'XFree86-FBDev'});
+ pkgs::selectPackage($o->{packages}, pkgs::packageByName($o->{packages}, $_)) foreach (qw(kernel-fb XFree86-FBDev));
$o->installPackages($o->{packages});
$vga ||= 785; #- assume at least 640x480x16.
@@ -430,7 +429,7 @@ sub g_auto_install(;$) {
my ($f) = @_; $f ||= auto_inst_file;
my $o = {};
- $o->{default_packages} = [ map { $_->{name} } grep { $_->{selected} && !$_->{base} } values %{$::o->{packages}} ];
+ $o->{default_packages} = [ map { pkgs::packageName($_) } grep { pkgs::packageFlagSelected($_) && !pkgs::packageFlagBase($_) } values %{$::o->{packages}[0]} ];
my @fields = qw(mntpoint type size);
$o->{partitions} = [ map { my %l; @l{@fields} = @$_{@fields}; \%l } grep { $_->{mntpoint} } @{$::o->{fstab}} ];
@@ -489,8 +488,9 @@ sub loadO {
sub pkg_install {
my ($o, $name) = @_;
require pkgs;
- pkgs::select($o->{packages}, $o->{packages}{$name} || die "$name rpm not found");
- install_steps::installPackages ($o, $o->{packages});
+ require install_steps;
+ pkgs::selectPackage($o->{packages}, pkgs::packageByName($o->{packages}, $name) || die "$name rpm not found");
+ install_steps::installPackages($o, $o->{packages});
}
sub fsck_option() {
diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm
index 1d277745a..3cd7b5149 100644
--- a/perl-install/install_steps.pm
+++ b/perl-install/install_steps.pm
@@ -208,7 +208,7 @@ sub beforeInstallPackages {
pkgs::init_db($o->{prefix}, $o->{isUpgrade});
}
-sub installPackages($$) {
+sub installPackages($$) { #- complete REWORK, TODO and TOCHECK!
my ($o, $packages) = @_;
if (@{$o->{toRemove} || []}) {
@@ -229,24 +229,14 @@ sub installPackages($$) {
$o->{toSave} = [];
#- hack for compat-glibc to upgrade properly :-(
- if ($packages->{'compat-glibc'}{selected}) {
+ if (pkgs::packageFlagSelected(pkgs::packageByName($packages, 'compat-glibc'))) {
rename "$o->{prefix}/usr/i386-glibc20-linux", "$o->{prefix}/usr/i386-glibc20-linux.mdkgisave";
}
}
- #- hack to ensure proper ordering for installation of packages.
- my @firstToInstall = qw(setup basesystem chkconfig sed ldconfig grep XFree86-libs freetype XFree86-xfs chkfontpath XFree86);
- my %firstInstalled;
- my @toInstall;
- foreach (@firstToInstall) {
- if ($packages->{$_}{selected} && !$packages->{$_}{installed}) {
- push @toInstall, $packages->{$_};
- $firstInstalled{$_} = 1; #- avoid installing twice a package.
- }
- }
- push @toInstall, grep { $_->{base} && $_->{selected} && !$_->{installed} && !$firstInstalled{$_->{name}} } values %$packages;
- push @toInstall, grep { !$_->{base} && $_->{selected} && !$_->{installed} && !$firstInstalled{$_->{name}} } values %$packages;
- pkgs::install($o->{prefix}, $o->{isUpgrade}, \@toInstall);
+ #- small transaction will be built based on this selection and depslist.
+ my @toInstall = grep { pkgs::packageFlagSelected($_) && !pkgs::packageFlagInstalled($_) } values %{$packages->[0]};
+ pkgs::install($o->{prefix}, $o->{isUpgrade}, \@toInstall, $o->{packages}[1]);
}
sub afterInstallPackages($) {
@@ -285,8 +275,8 @@ sub afterInstallPackages($) {
substInFile { s/^cdrom\n//; $_ .= "cdrom\n" if eof } "$msec/group.conf" if -d $msec;
substInFile { s/^xgrp\n//; $_ .= "xgrp\n" if eof } "$msec/group.conf" if -d $msec;
- my $p = $o->{packages}{urpmi};
- if ($p && $p->{selected}) {
+ my $pkg = pkgs::packageByName($o->{packages}, 'urpmi');
+ if ($pkg && pkgs::packageFlagSelected($pkg)) {
install_any::install_urpmi($o->{prefix}, $o->{method});
substInFile { s/^urpmi\n//; $_ .= "urpmi\n" if eof } "$msec/group.conf" if -d $msec;
}
@@ -471,7 +461,7 @@ sub printerConfig {
if ($o->{printer}{complete}) {
require printer;
require pkgs;
- pkgs::select($o->{packages}, $o->{packages}{'rhs-printfilters'});
+ pkgs::selectPackage($o->{packages}, pkgs::packageByName($o->{packages}, 'rhs-printfilters'));
$o->installPackages($o->{packages});
printer::configure_queue($o->{printer});
@@ -596,13 +586,13 @@ sub readBootloaderConfigBeforeInstall {
#- if there is a need to update existing lilo.conf entries by using that
#- hash.
my %ofpkgs = (
- 'vmlinuz' => 'kernel',
- 'vmlinuz-smp' => 'kernel-smp',
+ 'vmlinuz' => pkgs::packageByName($o->{packages}, 'kernel'),
+ 'vmlinuz-smp' => pkgs::packageByName($o->{packages}, 'kernel-smp'),
);
#- change the /boot/vmlinuz or /boot/vmlinuz-smp entries to follow symlink.
foreach $image (keys %ofpkgs) {
- if ($o->{bootloader}{entries}{"/boot/$image"} && $o->{packages}{$ofpkgs{$image}}{selected}) {
+ if ($o->{bootloader}{entries}{"/boot/$image"} && pkgs::packageFlagSelected($ofpkgs{$image})) {
$v = readlink "$o->{prefix}/boot/$image";
if ($v) {
$v = "/boot/$v" if $v !~ m|^/|;
diff --git a/perl-install/install_steps_gtk.pm b/perl-install/install_steps_gtk.pm
index 42b94ac7e..62b2c3762 100644
--- a/perl-install/install_steps_gtk.pm
+++ b/perl-install/install_steps_gtk.pm
@@ -369,12 +369,12 @@ sub choosePackagesTree {
$ignore = 1;
foreach (grep { $_->[0] } values %items) {
$compss->{tree}->unselect_child($_->[0]);
- $compss->{tree}->select_child($_->[0]) if $_->[1]{selected};
+ $compss->{tree}->select_child($_->[0]) if pkgs::packageFlagSelected($_->[1]);
}
$ignore = 0;
- foreach (values %$packages) {
- $size += $_->{size} - ($_->{installedCumulSize} || 0) if $_->{selected}; #- on upgrade, installed packages will be removed.
+ foreach (values %{$packages->[0]}) {
+ $size += pkgs::packageSize($_) - ($_->{installedCumulSize} || 0) if pkgs::packageFlagSelected($_); #- on upgrade, installed packages will be removed.
}
$w_size->set(_("Total size: ") . int (pkgs::correctSize($size / sqr(1024))) . " / $availableSpace " . _("KB") );
@@ -385,9 +385,9 @@ sub choosePackagesTree {
$items{++$itemsNB} = [ $w, $p ];
undef $parent->{packages_item}{$itemsNB} if $parent;
$w->show;
- $w->set_sensitive(!$p->{base} && !$p->{installed});
+ $w->set_sensitive(!pkgs::packageFlagBase($p) && !pkgs::packageFlagInstalled($p));
$w->signal_connect(focus_in_event => sub {
- my $p = eval { pkgs::getHeader($p) };
+ my $p = eval { pkgs::getHeader($p) }; #- TODO
gtktext_insert($info_widget, $@ ? _("Bad package") :
_("Version: %s\n", c::headerGetEntry($p, 'version') . '-' . c::headerGetEntry($p, 'release')) .
_("Size: %d KB\n", c::headerGetEntry($p, 'size') / 1024) .
@@ -405,23 +405,24 @@ sub choosePackagesTree {
#- needs to find @changed first, _then_ change the selected, otherwise
#- we won't be able to find the changed
foreach (values %items) {
- push @changed, $_->[1] if ($_->[1]{selected} xor exists $s{$_->[0]});
+ push @changed, $_->[1] if (pkgs::packageFlagSelected($_->[1]) xor exists $s{$_->[0]});
}
#- works before @changed is (or must be!) one element
foreach (@changed) {
if ($_->{childs}) {
- my $s = invbool \$_->{selected};
+ my $pkg = $_;
+ pkgs::packageSetFlagSelected($pkg, !pkgs::packageFlagSelected($pkg));
my $f; $f = sub {
my ($p) = @_;
$p->{itemNB} or return;
if ($p->{packages}) {
foreach (keys %{$p->{packages_item} || {}}) {
my ($a, $b) = @{$items{$_}};
- $a and pkgs::set($packages, $b, $s);
+ $a and pkgs::setPackageSelection($packages, $b, pkgs::packageFlagSelected($pkg));
}
} else {
foreach (values %{$p->{childs}}) {
- $_->{selected} = $s;
+ pkgs::packageSetFlagSelected($_, pkgs::packageFlagSelected($pkg));
&$f($_);
}
}
@@ -431,7 +432,7 @@ sub choosePackagesTree {
#- } elsif ($_->{installed}) {
#- $o->ask_warn('', _("Sorry, i won't select this package. A more recent version is already installed"));
} else {
- pkgs::toggle($packages, $_);
+ pkgs::togglePackageSelection($packages, $_);
}
}
&$update();
@@ -476,9 +477,9 @@ sub choosePackagesTree {
my %l; $l{$items{$_}[1]} = $_ foreach keys %{$p->{packages_item}};
map {
[ $_->{values}[$ind] >= $level ?
- ($l{$_} ? 1 : &$new_item($_, $_->{name}, $p)) : '', $l{$_}, $_ ];
+ ($l{$_} ? 1 : &$new_item($_, pkgs::packageName($_), $p)) : '', $l{$_}, $_ ];
} sort {
- $a->{name} cmp $b->{name} } @{$p->{packages}};
+ pkgs::packageName($a) cmp pkgs::packageName($b) } @{$p->{packages}};
} else {
map {
my $P = $p->{childs}{$_};
@@ -567,8 +568,8 @@ sub installPackages {
my $name = $_[0];
$msg->set(_("Installing package %s", $name));
$current_total_size += $last_size;
- $last_size = c::headerGetEntry($o->{packages}{$name}{header}, 'size');
- $text->set((split /\n/, c::headerGetEntry($o->{packages}{$name}{header}, 'summary'))[0] || '');
+ $last_size = c::headerGetEntry($o->{packages}[0]{$name}{header}, 'size');
+ $text->set((split /\n/, c::headerGetEntry($o->{packages}[0]{$name}{header}, 'summary'))[0] || '');
$w->flush;
} elsif ($m =~ /^Progressing installing package/) {
$progress->update($_[2] ? $_[1] / $_[2] : 0);
diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm
index e4ecb4b7e..b5575330c 100644
--- a/perl-install/install_steps_interactive.pm
+++ b/perl-install/install_steps_interactive.pm
@@ -254,22 +254,22 @@ sub choosePackages {
unless ($o->{isUpgrade}) {
my $available = pkgs::invCorrectSize(install_any::getAvailableSpace($o) / sqr(1024)) * sqr(1024);
- foreach (values %$packages) {
- delete $_->{skip};
- delete $_->{unskip};
+ foreach (values %{$packages->[0]}) {
+ pkgs::packageSetFlagSkip($_, 0);
+ pkgs::packageSetFlagUnskip($_, 0);
}
- pkgs::unselect_all($packages);
- pkgs::select($o->{packages}, $o->{packages}{$_} || next) foreach @{$o->{default_packages}};
+ pkgs::unselectAllPackages($packages);
+ pkgs::selectPackage($o->{packages}, pkgs::packageByName($o->{packages}, $_) || next) foreach @{$o->{default_packages}};
pkgs::setSelectedFromCompssList($o->{compssListLevels}, $packages, $::expert ? 90 : 80, $available, $o->{installClass});
- my $min_size = pkgs::size_selected($packages);
+ my $min_size = pkgs::selectedSize($packages);
$o->chooseGroups($packages, $compssUsers, $compssUsersSorted);
- my %save_selected; $save_selected{$_->{name}} = $_->{selected} foreach values %$packages;
+ my %save_selected; $save_selected{pkgs::packageName($_)} = pkgs::packageFlagSelected($_) foreach values %{$packages->[0]};
pkgs::setSelectedFromCompssList($o->{compssListLevels}, $packages, 1, 0, $o->{installClass});
- my $max_size = pkgs::size_selected($packages);
- $_->{selected} = $save_selected{$_->{name}} foreach values %$packages;
+ my $max_size = pkgs::selectedSize($packages);
+ pkgs::packageSetFlagSelected($_, $save_selected{$_->{name}}) foreach values %{$packages->[0]};
if (!$::beginner && $max_size > $available) {
$o->ask_okcancel('',
@@ -305,10 +305,10 @@ sub chooseGroups {
unless ($o->{compssUsersChoice}{Miscellaneous}) {
my %l;
$l{@{$compssUsers->{$_}}} = () foreach @$compssUsersSorted;
- exists $l{$_} or $packages->{$_}{skip} = 1 foreach keys %$packages;
+ exists $l{$_} or pkgs::packageSetFlagSkip(pkgs::packageByName($packages, $_), 1) foreach keys %$packages;
}
foreach (@$compssUsersSorted) {
- $o->{compssUsersChoice}{$_} or pkgs::skip_set($packages, @{$compssUsers->{$_}});
+ $o->{compssUsersChoice}{$_} or pkgs::skipSetWithProvides($packages, @{$compssUsers->{$_}});
}
foreach (@$compssUsersSorted) {
$o->{compssUsersChoice}{$_} or next;
@@ -334,7 +334,7 @@ sub installPackages {
} elsif ($m =~ /^Starting installing package/) {
my $name = $_[0];
$w->set(_("Installing package %s\n%d%%", $name, $total && 100 * $current / $total));
- $current += c::headerGetEntry($o->{packages}{$name}{header}, 'size');
+ $current += pkgs::packageSize(pkgs::packageByName($o->{packages}, $name));
} else { unshift @_, $m; goto $old }
};
$o->SUPER::installPackages($packages);
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index 6870905f5..f67d2dfae 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -2,10 +2,12 @@ package pkgs;
use diagnostics;
use strict;
-use vars qw(*LOG);
+use vars qw(*LOG %compssList @skip_list %by_lang @preferred $limitMinTrans $limitMaxTrans $PKGS_SELECTED $PKGS_FORCE $PKGS_INSTALLED $PKGS_BASE $PKGS_SKIP $PKGS_UNSKIP);
use common qw(:common :file :functional);
use install_any;
+use commands;
+use run_program;
use log;
use pkgs;
use fs;
@@ -13,7 +15,7 @@ use lang;
use c;
#- lower bound on the left ( aka 90 means [90-100[ )
-my %compssList = (
+%compssList = (
90 => __("must have"), #- every install have these packages (unless hand de-selected in expert, or not enough room)
80 => __("important"), #- every beginner/custom install have these packages (unless not enough space)
#- has minimum X install (XFree86 + icewm)(normal)
@@ -33,7 +35,7 @@ my %compssList = (
#- HACK: rating += 10 if the group is selected and it is not a kde package (aka name !~ /^k/)
-my @skip_list = qw(
+@skip_list = qw(
XFree86-8514 XFree86-AGX XFree86-Mach32 XFree86-Mach64 XFree86-Mach8 XFree86-Mono
XFree86-P9000 XFree86-S3 XFree86-S3V XFree86-SVGA XFree86-W32 XFree86-I128
XFree86-Sun XFree86-SunMono XFree86-Sun24 XFree86-3DLabs
@@ -44,7 +46,7 @@ hackkernel-pcmcia-cs hackkernel-smp hackkernel-smp-fb
autoirpm autoirpm-icons numlock
);
-my %by_lang = (
+%by_lang = (
ar => [ 'acon' ],
cs => [ 'XFree86-ISO8859-2', 'XFree86-ISO8859-2-75dpi-fonts' ],
hr => [ 'XFree86-ISO8859-2', 'XFree86-ISO8859-2-75dpi-fonts' ],
@@ -62,8 +64,74 @@ my %by_lang = (
'zh_TW.Big5' => [ 'rxvt-CLE', 'fonts-ttf-big5' ],
);
-my @preferred = qw(perl-GTK postfix ghostscript-X);
+@preferred = qw(perl-GTK postfix ghostscript-X);
+
+#- constant for small transaction.
+$limitMinTrans = 8;
+$limitMaxTrans = 24;
+
+#- constant for packing flags, see below.
+$PKGS_SELECTED = 0x00ffffff;
+$PKGS_FORCE = 0x01000000;
+$PKGS_INSTALLED = 0x02000000;
+$PKGS_BASE = 0x04000000;
+$PKGS_SKIP = 0x08000000;
+$PKGS_UNSKIP = 0x10000000;
+
+#- basic methods for extracting informations about packages.
+#- to save memory, (name, version, release) are no more stored, they
+#- are directly generated from (file).
+#- all flags are grouped together into (flags), these includes the
+#- following flags : selected, force, installed, base, skip.
+#- size and deps are grouped to save memory too and make a much
+#- simpler and faster depslist reader, this gets (sizeDeps).
+sub packageFile { my ($pkg) = @_; $pkg->{file} }
+sub packageHeaderFile { my ($pkg) = @_; $pkg->{file} =~ /(.*-[^-]+-[^-]+\.[^.]+)\.rpm/ && $1 or die "invalid file `$pkg->{file}'" }
+sub packageName { my ($pkg) = @_; $pkg->{file} =~ /(.*)-[^-]+-[^-]+\.[^.]+\.rpm/ && $1 or die "invalid file `$pkg->{file}'" }
+sub packageVersion { my ($pkg) = @_; $pkg->{file} =~ /.*-([^-]+)-[^-]+\.[^.]+\.rpm/ && $1 or die "invalid file `$pkg->{file}'" }
+sub packageRelease { my ($pkg) = @_; $pkg->{file} =~ /.*-[^-]+-([^-]+)\.[^.]+\.rpm/ && $1 or die "invalid file `$pkg->{file}'" }
+sub packageArch { my ($pkg) = @_; $pkg->{file} =~ /.*-[^-]+-[^-]+\.([^.]+)\.rpm/ && $1 or die "invalid file `$pkg->{file}'" }
+
+sub packageSize { my ($pkg) = @_; int $pkg->{sizeDeps} }
+sub packageDepsId { my ($pkg) = @_; split ' ', ($pkg->{sizeDeps} =~ /^\d*\s+(.*)/)[0] }
+
+sub packageFlagSelected { my ($pkg) = @_; $pkg->{flags} & $PKGS_SELECTED }
+sub packageFlagForce { my ($pkg) = @_; $pkg->{flags} & $PKGS_FORCE }
+sub packageFlagInstalled { my ($pkg) = @_; $pkg->{flags} & $PKGS_INSTALLED }
+sub packageFlagBase { my ($pkg) = @_; $pkg->{flags} & $PKGS_BASE }
+sub packageFlagSkip { my ($pkg) = @_; $pkg->{flags} & $PKGS_SKIP }
+sub packageFlagUnskip { my ($pkg) = @_; $pkg->{flags} & $PKGS_UNSKIP }
+
+sub packageSetFlagSelected { my ($pkg, $v) = @_; $pkg->{flags} &= ~$PKGS_SELECTED; $pkg->{flags} |= $v & $PKGS_SELECTED; }
+sub packageSetFlagForce { my ($pkg, $v) = @_; $v ? $pkg->{flags} |= $PKGS_FORCE : $pkg->{flags} &= ~$PKGS_FORCE; }
+sub packageSetFlagInstalled { my ($pkg, $v) = @_; $v ? $pkg->{flags} |= $PKGS_INSTALLED : $pkg->{flags} &= ~$PKGS_INSTALLED; }
+sub packageSetFlagBase { my ($pkg, $v) = @_; $v ? $pkg->{flags} |= $PKGS_BASE : $pkg->{flags} &= ~$PKGS_BASE; }
+sub packageSetFlagSkip { my ($pkg, $v) = @_; $v ? $pkg->{flags} |= $PKGS_SKIP : $pkg->{flags} &= ~$PKGS_SKIP; }
+sub packageSetFlagUnskip { my ($pkg, $v) = @_; $v ? $pkg->{flags} |= $PKGS_UNSKIP : $pkg->{flags} &= ~$PKGS_UNSKIP; }
+
+sub packageProvides { my ($pkg) = @_; @{$pkg->{provides} || []} }
+
+#- get all headers from hdlist.cz, remove any older headers in memory.
+sub extractHeaders($@) {
+ my $prefix = shift;
+ my @pkgs = grep { !$_->{header} } @_;
+
+ eval { commands::rm("-rf", "$prefix/tmp/headers") };
+ run_program::run("extract_archive", "$prefix/var/lib/urpmi/hdlist.cz2", "$prefix/tmp/headers",
+ map { packageHeaderFile($_) } @pkgs);
+
+ foreach (@pkgs) {
+ my $f = "$prefix/tmp/headers/". packageHeaderFile($_);
+ local *H;
+ open H, $f or die "unable to open header file $f: $!";
+ $_->{header} = c::headerRead(fileno H, 1) or log::l("unable to read header of package ". packageHeaderFile($_));
+ close H;
+ }
+
+ grep { $_->{header} } @pkgs;
+}
+#- size and correction size functions for packages.
my $A = 20471;
my $B = 16258;
sub correctSize { ($A - $_[0]) * $_[0] / $B } #- size correction in MB.
@@ -71,161 +139,227 @@ sub invCorrectSize { $A / 2 - sqrt(max(0, sqr($A) - 4 * $B * $_[0])) / 2 }
sub selectedSize {
my ($packages) = @_;
- int (sum map { $_->{size} } grep { $_->{selected} } values %$packages) / sqr(1024);
+ int (sum map { packageSize($_) } grep { packageFlagSelected($_) } values %{$packages->[0]});
}
-sub correctedSelectedSize { correctSize(selectedSize($_[0])) }
+sub correctedSelectedSize { correctSize(selectedSize($_[0]) / sqr(1024)) }
+
-sub Package {
+#- searching and grouping methods.
+#- package is a reference to list that contains
+#- a hash to search by name and
+#- a list to search by id.
+sub packageByName {
my ($packages, $name) = @_;
- $packages->{$name} or log::l("unknown package `$name'") && undef;
+ $packages->[0]{$name} or log::l("unknown package `$name'") && undef;
}
-
-sub allpackages {
+sub packageById {
+ my ($packages, $id) = @_;
+ $packages->[1][$id] or log::l("unknown package id $id") && undef;
+}
+sub allPackages {
my ($packages) = @_;
my %skip_list; @skip_list{@skip_list} = ();
- grep { !exists $skip_list{$_->{name}} } values %$packages;
+ grep { !exists $skip_list{packageName($_)} } values %{$packages->[0]};
}
-sub select($$;$) {
- my ($packages, $p, $base) = @_;
+#- selection, unselection of package.
+sub selectPackage($$;$$) {
+ my ($packages, $pkg, $base, $otherOnly) = @_;
my %preferred; @preferred{@preferred} = ();
- my ($n, $v);
-# print "## $p->{name}\n";
- unless ($p->{installed}) { #- if the same or better version is installed, do not select.
- $p->{base} ||= $base;
- $p->{selected} = -1; #- selected by user
- my %l; @l{@{$p->{deps} || die "missing deps file"}} = ();
- while (do { my %l = %l; while (($n, $v) = each %l) { last if $v != 1; } $n }) {
- $l{$n} = 1;
- my $i = $packages->{$n};
- if (!$i && $n =~ /\|/) {
- foreach (split '\|', $n) {
- my $p = Package($packages, $_);
- $i ||= $p;
- $p && $p->{selected} and $i = $p, last;
- $p && exists $preferred{$_} and $i = $p;
- }
- }
- $i->{base} ||= $base;
- $i->{deps} or log::l("missing deps for $n");
- unless ($i->{installed}) {
- unless ($i->{selected}) {
-# print ">> $i->{name}\n";
-# /gnome-games/ and print ">>> $i->{name}\n" foreach @{$i->{deps} || []};
- $l{$_} ||= 0 foreach @{$i->{deps} || []};
+
+ #- check if the same or better version is installed,
+ #- do not select in such case.
+ packageFlagInstalled($pkg) and return;
+
+ #- select package and dependancies, otherOnly may be a reference
+ #- to a hash to indicate package that will strictly be selected
+ #- when value is true, may be selected when value is false (this
+ #- is only used for unselection, not selection)
+ unless (packageFlagSelected($pkg)) {
+ foreach (packageDepsId($pkg)) {
+ if (/\|/) {
+ #- choice deps should be reselected recursively as no
+ #- closure on them is computed, this code is exactly the
+ #- same as pixel's one.
+ my ($choiceDepsPkg, $preferredDepsPkg);
+ foreach (split '\|', $_) {
+ $choiceDepsPkg = packageById($packages, $_);
+ $preferredDepsPkg ||= $choiceDepsPkg;
+ $choiceDepsPkg && packageFlagSelected($choiceDepsPkg) and
+ $preferredDepsPkg = $choiceDepsPkg, last;
+ $choiceDepsPkg && exists $preferred{packageName($choiceDepsPkg)} and
+ $preferredDepsPkg = $choiceDepsPkg;
}
- $i->{selected}++ unless $i->{selected} == -1;
+ $preferredDepsPkg and selectPackage($packages, $preferredDepsPkg, $base, $otherOnly);
+ } else {
+ #- deps have been closed except for choices, so no need to
+ #- recursively apply selection, expand base on it.
+ my $depsPkg = packageById($packages, $_);
+ $base and packageSetFlagBase($depsPkg, 1);
+ $otherOnly and !packageFlagSelected($depsPkg) and $otherOnly->{packageName($depsPkg)} = 1;
+ $otherOnly or packageSetFlagSelected($depsPkg, 1+packageFlagSelected($depsPkg));
}
}
}
+ $base and packageSetFlagBase($pkg, 1);
+ $otherOnly and packageFlagSelected($pkg) and $otherOnly->{packageName($pkg)} = 1;
+ $otherOnly or packageSetFlagSelected($pkg, 1+packageFlagSelected($pkg));
1;
}
-sub unselect($$) {
- my ($packages, $p) = @_;
- $p->{base} and return;
- my $set = set_new($p->{name});
- my $l = $set->{list};
-
- #- get the list of provided packages
- foreach my $q (@$l) {
- my $i = Package($packages, $q);
- $i->{selected} && !$i->{base} or next;
- $i->{selected} = 1; #- that way, its counter will be zero the first time
- set_add($set, @{$i->{provides} || []});
- }
- while (@$l) {
- my $n = shift @$l;
- my $i = Package($packages, $n);
-
- $i->{selected} <= 0 || $i->{base} and next;
- if (--$i->{selected} == 0) {
- push @$l, @{$i->{deps} || []};
+sub unselectPackage($$;$) {
+ my ($packages, $pkg, $otherOnly) = @_;
+
+ #- base package are not unselectable,
+ #- and already unselected package are no more unselectable.
+ packageFlagBase($pkg) and return;
+ packageFlagSelected($pkg) or return;
+
+ #- dependancies may be used to propose package that may be not
+ #- usefull for the user, since their counter is just one and
+ #- they are not used any more by other packages.
+ #- provides are closed and are taken into account to get possible
+ #- unselection of package (value false on otherOnly) or strict
+ #- unselection (value true on otherOnly).
+ foreach my $providedPkg ($pkg, packageProvides($pkg)) {
+ packageFlagBase($providedPkg) and die "a provided package cannot be a base package";
+ $otherOnly or packageSetFlagSelected($providedPkg, 0);
+ $otherOnly and $otherOnly->{packageName{$providedPkg}} = 1;
+ foreach (map { split '\|' } packageDepsId($providedPkg)) {
+ my $depsPkg = packageById($packages, $_);
+ packageFlagBase($depsPkg) and next;
+ packageFlagSelected($depsPkg) or next;
+ for (packageFlagSelected($depsPkg)) {
+ $_ == 1 and do { $otherOnly and $otherOnly->{packageName($depsPkg)} ||= 0; };
+ $_ > 1 and do { $otherOnly or packageSetFlagSelected($depsPkg, $_-1); };
+ last;
+ }
}
}
1;
}
-sub toggle($$) {
- my ($packages, $p) = @_;
- $p->{selected} ? unselect($packages, $p) : &select($packages, $p);
+sub togglePackageSelection($$) {
+ my ($packages, $pkg) = @_;
+ packageFlagSelected($pkg) ? unselectPackage($packages, $pkg) : selectPackage($packages, $pkg);
}
-sub set($$$) {
- my ($packages, $p, $val) = @_;
- $val ? &select($packages, $p) : unselect($packages, $p);
+sub setPackageSelection($$$) {
+ my ($packages, $pkg, $value) = @_;
+ $value ? selectPackage($packages, $pkg) : unselectPackage($packages, $pkg);
}
-sub unselect_all($) {
+sub unselectAllPackages($) {
my ($packages) = @_;
- $_->{selected} = $_->{base} foreach values %$packages;
-}
-
-sub size_selected {
- my ($packages) = @_;
- my $nb = 0; foreach (values %$packages) {
- $nb += $_->{size} if $_->{selected};
- }
- $nb;
+ packageSetFlagSelected($_, packageFlagBase($_) && 1) foreach values %{$packages->[0]};
}
-sub skip_set {
+sub skipSetWithProvides {
my ($packages, @l) = @_;
- $_->{skip} = 1 foreach @l, grep { $_ } map { Package($packages, $_) } map { @{$_->{provides} || []} } @l;
+ packageSetFlagSkip($_, 1) foreach grep { $_ } map { $_, packageProvides($_) } map { packageByName($packages, $_) } @l;
}
-sub psUsingDirectory(;$) {
+sub psUsingDirectory(;$) { #- obseleted...
my $dirname = $_[0] || "/tmp/rhimage/Mandrake/RPMS";
- my %packages;
+ my @packages;
log::l("scanning $dirname for packages");
+ $packages[0] = {};
foreach (all("$dirname")) {
- my ($name, $version, $release) = /(.*)-([^-]+)-([^-]+)\.[^.]+\.rpm/ or log::l("skipping $_"), next;
-
- $packages{$name} = {
- name => $name, version => $version, release => $release,
- file => $_, selected => 0, deps => [],
- };
+ my $pkg = { file => $_, #- filename
+ flags => 0, #- flags
+ };
+ $packages[0]{packageName($pkg)} = $pkg;
}
- \%packages;
-}
-sub psUsingHdlist() {
- my $f = install_any::getFile('hdlist') or die "no hdlist found";
- my %packages;
+ $packages[1] = [];
-#- my ($noSeek, $end) = 0;
-#- $end = sysseek F, 0, 2 or die "seek failed";
-#- sysseek F, 0, 0 or die "seek failed";
+ log::l("psUsingDirectory read " . scalar keys(%{$packages[0]}) . " filenames");
- while (my $header = c::headerRead(fileno $f, 1)) {
-#- or die "error reading header at offset ", sysseek(F, 0, 1);
- my $name = c::headerGetEntry($header, 'name');
+ \@packages;
+}
- $packages{$name} = {
- name => $name, header => $header, selected => 0, deps => [],
- version => c::headerGetEntry($header, 'version'),
- release => c::headerGetEntry($header, 'release'),
- size => c::headerGetEntry($header, 'size'),
- };
+sub psUsingHdlist($) {
+ my ($prefix) = @_;
+ my $f = install_any::getFile('hdlist.cz2') or die "no hdlist.cz2 found";
+ my @packages;
+
+ #- copy hdlist file directly to $prefix/var/lib/urpmi, this will be used
+ #- for getting header of package during installation or after by urpmi.
+ my $newf = "$prefix/var/lib/urpmi/hdlist.cz2";
+ -e $newf and do { unlink $newf or die "cannot remove $newf: $!"; };
+ local *F;
+ open F, ">$newf" or die "cannot create $newf: $!";
+ my ($buf, $sz); while (($sz = sysread($f, $buf, 16384))) { syswrite(F, $buf) }
+ close F;
+
+ #- extract filename from archive, this take advantage of verifying
+ #- the archive too.
+ open F, "extract_archive $newf |" or die "unable to parse $newf";
+ foreach (<F>) {
+ chomp;
+ next unless /^[dlf]\s+/;
+ if (/^f\s+\d+\s+(.*)/) {
+ my $pkg = { file => "$1.rpm", #- rebuild filename according to header one
+ flags => 0, #- flags
+ };
+ $packages[0]{packageName($pkg)} = $pkg;
+ print packageName($pkg), "\n";
+ } else {
+ die "cannot determine how to handle such file in $newf: $_";
+ }
}
- log::l("psUsingHdlist read " . scalar keys(%packages) . " headers");
+ close F;
+
+ $packages[1] = [];
- \%packages;
+ log::l("psUsingHdlist read " . scalar keys(%{$packages[0]}) . " headers");
+
+ \@packages;
}
-sub chop_version($) {
+sub chopVersionRelease($) {
first($_[0] =~ /(.*)-[^-]+-[^-]+/) || $_[0];
}
sub getDeps($) {
my ($packages) = @_;
- my $f = install_any::getFile("depslist") or die "can't find dependencies list";
+ my $f = install_any::getFile("depslist.ordered") or die "can't find dependencies list";
+
+ #- update dependencies list, provides attributes are updated later
+ #- cross reference to be resolved on id (think of loop requires)
+ #- provides should be updated after base flag has been set to save
+ #- memory.
foreach (<$f>) {
- my ($name, $size, @deps) = split;
- ($name, @deps) = map { join '|', map { chop_version($_) } split '\|' } ($name, @deps);
- $packages->{$name} or next;
- $packages->{$name}{size} = $size;
- $packages->{$name}{deps} = \@deps;
- map { push @{$packages->{$_}{provides}}, $name if $packages->{$_} } @deps;
+ my ($name, $version, $release, $sizeDeps) = /^(\S*)-([^-\s]+)-([^-\s]+)\s+(.*)/;
+ my $pkg = $packages->[0]{$name};
+
+ $pkg or log::l("ignoring package $name-$version-$release in depslist is not in hdlist"), next;
+ $version == packageVersion($pkg) and $release == packageRelease($pkg)
+ or log::l("ignoring package $name-$version-$release in depslist mismatch version or release in hdlist"), next;
+ $pkg->{sizeDeps} = $sizeDeps;
+
+ #- package are already sorted in depslist to enable small transaction.
+ push @{$packages->[1]}, $pkg;
+ }
+# map { push @{$packages->{$_}{provides}}, $name if $packages->{$_} } @deps;
+}
+
+sub getProvides($) {
+ my ($packages) = @_;
+
+ foreach (@{$packages->[1]}) {
+ my $pkg = $_;
+
+ #- update provides according to dependencies, here are stored
+ #- reference to package directly and choice are included, this
+ #- assume only 1 of the choice is selected, else on unselection
+ #- the provided package will be deleted where other package still
+ #- need it.
+ #- base package are not updated because they cannot be unselected,
+ #- this save certainly a lot of memory since most of them may be
+ #- needed by a large number of package.
+ map { my $providedPkg = $packages->[1][$_] or die "invalid package index $_";
+ packageFlagBase($providedPkg) or push @{$providedPkg->{provides} ||= []}, $pkg;
+ } map { split '\|' } packageDepsId($pkg);
}
}
@@ -246,7 +380,6 @@ sub readCompss($) {
if (/^(\S+)/) {
my $p = $compss;
my @l = split ':', $1;
-#- Why? pop @l if $l[-1] =~ /^(x11|console)$/;
foreach (@l) {
$p->{childs}{$_} ||= { childs => {} };
$p = $p->{childs}{$_};
@@ -255,7 +388,7 @@ sub readCompss($) {
$compss_->{$1} = $p;
} else {
/(\S+)/ or log::l("bad line in compss: $_"), next;
- push @$ps, $packages->{$1} || do { log::l("unknown package $1 (in compss)"); next };
+ push @$ps, $packages->[0]{$1} || do { log::l("unknown package $1 (in compss)"); next };
}
}
($compss, $compss_);
@@ -272,7 +405,7 @@ sub readCompssList($$$) {
foreach (<$f>) {
/^\s*$/ || /^#/ and next;
- /^packages\s*$/ and do { $e = $packages; next };
+ /^packages\s*$/ and do { $e = $packages->[0]; next };
/^categories\s*$/ and do { $e = $compss_; next };
my ($name, @values) = split;
@@ -284,10 +417,10 @@ sub readCompssList($$$) {
my %done;
foreach (split ':', $ENV{RPM_INSTALL_LANG}) {
- my $p = $packages->{"locales-$_"} || {};
+ my $p = $packages->[0]{"locales-$_"} || {};
foreach ("locales-$_", @{$p->{provides} || []}, @{$by_lang{$_} || []}) {
next if $done{$_}; $done{$_} = 1;
- my $p = $packages->{$_} or next;
+ my $p = $packages->[0]{$_} or next;
$p->{values} = [ map { $_ + 90 } @{$p->{values} || [ (0) x $nb_values ]} ];
}
}
@@ -307,7 +440,7 @@ sub readCompssUsers {
push @sorted, $1;
$compssUsers{$1} = $l = [];
} elsif (/\s+\+(\S+)/) {
- push @$l, $packages->{$1} || do { log::l("unknown package $1 (in compssUsers)"); next };
+ push @$l, $packages->[0]{$1} || do { log::l("unknown package $1 (in compssUsers)"); next };
} elsif (/\s+(\S+)/) {
my $p = $compss;
$p &&= $p->{childs}{$_} foreach split ':', $1;
@@ -329,27 +462,27 @@ sub setSelectedFromCompssList {
my ($compssListLevels, $packages, $min_level, $max_size, $install_class) = @_;
my ($ind);
- my @packages = allpackages($packages);
+ my @packages = allPackages($packages);
my @places = do {
map_index { $ind = $::i if $_ eq $install_class } @$compssListLevels;
defined $ind or log::l("unknown install class $install_class in compssList"), return;
#- special case for /^k/ aka kde stuff
- my @values = map { $_->{values}[$ind] + ($_->{unskip} && $_->{name} !~ /^k/ ? 10 : 0) } @packages;
+ my @values = map { $_->{values}[$ind] + (packageFlagUnskip($_) && packageName($_) !~ /^k/ ? 10 : 0) } @packages;
sort { $values[$b] <=> $values[$a] } 0 .. $#packages;
};
foreach (@places) {
my $p = $packages[$_];
- next if $p->{skip};
+ next if packageFlagSkip($p);
last if $p->{values}[$ind] < $min_level;
- &select($packages, $p);
+ selectPackage($packages, $p);
my $nb = 0; foreach (@packages) {
- $nb += $_->{size} if $_->{selected};
+ $nb += packageSize($_) if packageFlagSelected($_);
}
if ($max_size && $nb > $max_size) {
- unselect($packages, $p);
+ unselectPackage($packages, $p);
$min_level = $p->{values}[$ind];
log::l("setSelectedFromCompssList: up to indice $min_level (reached size $max_size)");
last;
@@ -432,7 +565,7 @@ sub selectPackagesToUpgrade($$$;$$) {
#- the 'installed' property will make a package unable to be selected, look at select.
c::rpmdbTraverse($db, sub {
my ($header) = @_;
- my $p = $packages->{c::headerGetEntry($header, 'name')};
+ my $p = $packages->[0]{c::headerGetEntry($header, 'name')};
my $otherPackage = (c::headerGetEntry($header, 'release') !~ /mdk\w*$/ &&
(c::headerGetEntry($header, 'name'). '-' .
c::headerGetEntry($header, 'version'). '-' .
@@ -481,7 +614,7 @@ sub selectPackagesToUpgrade($$$;$$) {
unless ($skipThis) {
my $cumulSize;
- pkgs::select($packages, $p) unless $p->{selected};
+ selectPackage($packages, $p) unless $p->{selected};
#- 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
@@ -530,7 +663,7 @@ sub selectPackagesToUpgrade($$$;$$) {
map { if (exists $installedFilesForUpgrade{$_}) {
$toSelect ||= ! -d "$prefix/$_" && ! -l "$prefix/$_"; delete $installedFilesForUpgrade{$_} }
} grep { $_ !~ m@^/etc/rc.d/@ } @availFiles;
- pkgs::select($packages, $p) if ($toSelect);
+ selectPackage($packages, $p) if ($toSelect);
}
}
@@ -541,14 +674,14 @@ sub selectPackagesToUpgrade($$$;$$) {
eval { getHeader($p) };
my @obsoletes = $p->{header} ? c::headerGetEntry(getHeader($p), 'obsoletes'): ();
- map { pkgs::select($packages, $p) if c::rpmdbNameTraverse($db, $_) > 0 } @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->{$_} or log::l("missing base package $_"), next;
+ 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.
- pkgs::select($packages, $p, 1) unless $p->{selected}; #- if installed it cannot be selected.
+ selectPackage($packages, $p, 1) unless $p->{selected}; #- if installed it cannot be selected.
}
#- clean false value on toRemove.
@@ -565,7 +698,7 @@ sub selectPackagesToUpgrade($$$;$$) {
c::headerGetEntry($header, 'version'). '-' .
c::headerGetEntry($header, 'release'));
if ($toRemove{$otherPackage}) {
- if ($packages->{c::headerGetEntry($header, 'name')}{base}) {
+ if (packageFlagBase($packages->[0]{c::headerGetEntry($header, 'name')})) {
delete $toRemove{$otherPackage}; #- keep it selected, but force upgrade.
} else {
my @files = c::headerGetEntry($header, 'filenames');
@@ -596,54 +729,37 @@ sub installCallback {
}
sub install($$$;$) {
- my ($prefix, $isUpgrade, $toInstall) = @_;
+ my ($prefix, $isUpgrade, $toInstall, $depOrder) = @_;
my %packages;
-#- foreach (@$toInstall) {
-#- print "$_->{name}\n";
-#- }
-
return if $::g_auto_install;
- log::l("reading /usr/lib/rpm/rpmrc");
- c::rpmReadConfigFiles() or die "can't read rpm config files";
- log::l("\tdone");
-
- my $db = c::rpmdbOpen($prefix) or die "error opening RPM database: ", c::rpmErrorString();
- log::l("opened rpm database for installing new packages");
-
- my $trans = c::rpmtransCreateSet($db, $prefix);
-
+ #- first stage to extract some important informations
+ #- about the packages selected. this is used to select
+ #- one or many transaction.
my ($total, $nb);
-
- foreach my $p (@$toInstall) {
- eval { getHeader($p) }; $@ and next;
- $p->{file} ||= sprintf "%s-%s-%s.%s.rpm",
- $p->{name}, $p->{version}, $p->{release},
- c::headerGetEntry(getHeader($p), 'arch');
- $packages{$p->{name}} = $p;
- c::rpmtransAddPackage($trans, getHeader($p), $p->{name}, $isUpgrade && $p->{name} !~ /kernel/); #- TODO: replace `named kernel' by `provides kernel'
+ foreach my $pkg (@$toInstall) {
+ $packages{packageName($pkg)} = $pkg;
$nb++;
- $total += $p->{size};
+ $total += packageSize($pkg);
}
- c::rpmdepOrder($trans) or
- cdie "error ordering package list: " . c::rpmErrorString(),
- sub {
- c::rpmtransFree($trans);
- c::rpmdbClose($db);
- };
- c::rpmtransSetScriptFd($trans, fileno LOG);
-
eval { fs::mount("/proc", "$prefix/proc", "proc", 0) } unless -e "$prefix/proc/cpuinfo";
+ log::l("reading /usr/lib/rpm/rpmrc");
+ c::rpmReadConfigFiles() or die "can't read rpm config files";
+ log::l("\tdone");
+
+ my $db = c::rpmdbOpen($prefix) or die "error opening RPM database: ", c::rpmErrorString();
+ log::l("opened rpm database for installing ". scalar @$toInstall ." new packages");
+
my $callbackOpen = sub {
- my $f = (my $p = $packages{$_[0]})->{file};
+ my $f = packageFile(my $pkg = delete $packages{$_[0]});
print LOG "$f\n";
my $fd = install_any::getFile($f) or log::l("ERROR: bad file $f");
$fd ? fileno $fd : -1;
};
- my $callbackClose = sub { $packages{$_[0]}{installed} = 1; };
+ my $callbackClose = sub { packageSetFlagInstalled($packages{$_[0]}, 1); };
my $callbackMessage = \&pkgs::installCallback;
#- do not modify/translate the message used with installCallback since
@@ -651,24 +767,55 @@ sub install($$$;$) {
#- place (install_steps_gtk.pm,...).
&$callbackMessage("Starting installation", $nb, $total);
- if (my @probs = c::rpmRunTransactions($trans, $callbackOpen, $callbackClose, $callbackMessage, 0)) {
- my %parts;
- @probs = reverse grep {
- if (s/(installing package) .* (needs (?:.*) on the (.*) filesystem)/$1 $2/) {
- $parts{$3} ? 0 : ($parts{$3} = 1);
- } else { 1; }
- } reverse @probs;
+ my ($i, $min) = (0, 0);
+ do {
+ my @transToInstall;
+ if ($nb <= $limitMaxTrans || !$depOrder) {
+ @transToInstall = values %packages;
+ } else {
+ while ($i < @$depOrder && ($i < $min || scalar @transToInstall < $limitMinTrans)) {
+ my $depsPkg = $packages{packageName($depOrder->[$i++])};
+ if ($depsPkg) {
+ push @transToInstall, $depsPkg;
+ foreach (map { split '\|' } packageDepsId($depsPkg)) {
+ $min < $_ and $min = $_;
+ }
+ }
+ }
+ }
+ $nb -= scalar @transToInstall;
+
+ log::l("starting new transaction of ". scalar @transToInstall ." packages, still $nb after that to do");
+ my $trans = c::rpmtransCreateSet($db, $prefix);
+ foreach (extractHeaders($prefix, @transToInstall)) {
+ my $p = $_;
+ eval { getHeader($p) }; $@ and next;
+ c::rpmtransAddPackage($trans, getHeader($p), packageName($p), $isUpgrade && packageName($p) !~ /kernel/); #- TODO: replace `named kernel' by `provides kernel'
+ }
+ c::rpmdepOrder($trans) or
+ cdie "error ordering package list: " . c::rpmErrorString(),
+ sub {
+ c::rpmtransFree($trans);
+ c::rpmdbClose($db);
+ };
+ c::rpmtransSetScriptFd($trans, fileno LOG);
+
+ if (my @probs = c::rpmRunTransactions($trans, $callbackOpen, $callbackClose, $callbackMessage, 0)) {
+ my %parts;
+ @probs = reverse grep {
+ if (s/(installing package) .* (needs (?:.*) on the (.*) filesystem)/$1 $2/) {
+ $parts{$3} ? 0 : ($parts{$3} = 1);
+ } else { 1; }
+ } reverse @probs;
+
+ c::rpmtransFree($trans);
+ c::rpmdbClose($db);
+ die "installation of rpms failed:\n ", join("\n ", @probs);
+ }
c::rpmtransFree($trans);
- c::rpmdbClose($db);
-# if ($isUpgrade && !$useOnlyUpgrade && %parts) {
-# #- recurse only once to try with only upgrade (including kernel).
-# log::l("trying to upgrade all packages to save space");
-# install($prefix,$isUpgrade,$toInstall,1);
-# }
- die "installation of rpms failed:\n ", join("\n ", @probs);
- }
- c::rpmtransFree($trans);
+ } while ($nb > 0);
+
c::rpmdbClose($db);
log::l("rpm database closed");
generated by cgit v1.2.1 (git 2.21.0) at 2024-11-06 09:04:12 +0000