summaryrefslogtreecommitdiffstats
path: root/perl-install/pkgs.pm
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install/pkgs.pm')
-rw-r--r--perl-install/pkgs.pm133
1 files changed, 88 insertions, 45 deletions
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index 8a028b53a..d30d0e408 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -2,7 +2,7 @@ package pkgs;
use diagnostics;
use strict;
-use vars qw(*LOG %compssListDesc @skip_list %by_lang @preferred $limitMinTrans $limitMaxTrans $PKGS_SELECTED $PKGS_FORCE $PKGS_INSTALLED $PKGS_BASE $PKGS_SKIP $PKGS_UNSKIP);
+use vars qw(*LOG %compssListDesc @skip_list %by_lang @preferred $limitMinTrans $PKGS_SELECTED $PKGS_FORCE $PKGS_INSTALLED $PKGS_BASE $PKGS_SKIP $PKGS_UNSKIP);
use common qw(:common :file :functional);
use install_any;
@@ -69,7 +69,6 @@ autoirpm autoirpm-icons numlock
#- constant for small transaction.
$limitMinTrans = 8;
-$limitMaxTrans = 24;
#- constant for packing flags, see below.
$PKGS_SELECTED = 0x00ffffff;
@@ -118,14 +117,14 @@ sub packageFile {
}
-#- get all headers from hdlist.cz
-sub extractHeaders {
- my ($prefix, $pkgs) = @_;
+#- get all headers from an hdlist file.
+sub extractHeaders($$$) {
+ my ($prefix, $pkgs, $medium) = @_;
commands::rm("-rf", "$prefix/tmp/headers") if -e "$prefix/tmp/headers";
- run_program::run("extract_archive",
- "$prefix/var/lib/urpmi/hdlist.cz2",
+ run_program::run("extract_archive",
+ "$prefix/var/lib/urpmi/$medium->{hdlist}",
"$prefix/tmp/headers",
map { packageHeaderFile($_) } @$pkgs);
@@ -266,40 +265,64 @@ sub skipSetWithProvides {
packageSetFlagSkip($_, 1) foreach grep { $_ } map { $_, packageProvides($_) } map { packageByName($packages, $_) } @l;
}
-sub psUsingHdlist($) {
+sub psUsingHdlists($) {
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>) {
+ my $listf = install_any::getFile('hdlists') or die "no hdlists found";
+ my @packages = ({}, [], {});
+ my @hdlists;
+
+ #- parse hdlist.list file.
+ foreach (<$listf>) {
chomp;
- next unless /^[dlf]\s+/;
- if (/^f\s+\d+\s+(.*)/) {
- my $pkg = { file => $1, #- rebuild filename according to header one
- flags => 0, #- flags
- };
- $packages[0]{packageName($pkg)} = $pkg;
- } else {
- die "cannot determine how to handle such file in $newf: $_";
- }
+ s/\s*#.*$//;
+ /^\s*$/ and next;
+ m/^hdlist(.*)\.cz.*$/ or die "invalid hdlist filename $_";
+ push @hdlists, [ $_, $1 ];
}
- close F;
- $packages[1] = [];
+ foreach (@hdlists) {
+ my ($hdlist, $medium) = @$_;
+ my $f = install_any::getFile($hdlist) or die "no $hdlist found";
+
+ $packages[2]{$medium} = { hdlist => $hdlist,
+ medium => $medium, #- default medium is ''.
+ min => scalar keys %{$packages[0]},
+ max => -1, #- will be updated after reading current hdlist.
+ };
+
+ #- 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";
+ -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;
+ /^[dlf]\s+/ or next;
+ if (/^f\s+\d+\s+(.*)/) {
+ my $pkg = { file => $1, #- rebuild filename according to header one
+ flags => 0, #- flags
+ medium => $packages[2]{$medium},
+ };
+ $packages[0]{packageName($pkg)} = $pkg;
+ } else {
+ die "cannot determine how to handle such file in $newf: $_";
+ }
+ }
+ close F;
+
+ #- update maximal index.
+ $packages[2]{$medium}{max} = scalar(keys %{$packages[0]}) - 1;
+ $packages[2]{$medium}{max} >= $packages[2]{$medium}{min} or die "nothing found while parsing $newf";
+ }
- log::l("psUsingHdlist read " . scalar keys(%{$packages[0]}) . " headers");
+ log::l("psUsingHdlists read " . scalar keys(%{$packages[0]}) . " headers on " . scalar keys(%{$packages[2]}) . " hdlists");
\@packages;
}
@@ -322,15 +345,24 @@ sub getDeps($) {
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.
+ #- check position of package in depslist according to precomputed
+ #- limit by hdlist, very strict :-)
+ #- above warning have chance to raise an exception here, but may help
+ #- for debugging.
+ my $i = scalar @{$packages->[1]};
+ $i >= $pkg->{medium}{min} && $i <= $pkg->{medium}{max} or die "depslist.ordered mismatch against hdlist files";
+
+ #- package are already sorted in depslist to enable small transaction and multiple medium.
push @{$packages->[1]}, $pkg;
}
-# map { push @{$packages->{$_}{provides}}, $name if $packages->{$_} } @deps;
+
+ #- check for same number of package in depslist and hdlists.
+ scalar(keys %{$packages->[0]}) == scalar(@{$packages->[1]}) or die "depslist.ordered has not same package as hdlist files";
}
sub getProvides($) {
my ($packages) = @_;
-
+
#- 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
@@ -682,8 +714,8 @@ sub installCallback {
log::l($msg .": ". join(',', @_));
}
-sub install($$$;$) {
- my ($prefix, $isUpgrade, $toInstall, $depOrder) = @_;
+sub install($$$;$$) {
+ my ($prefix, $isUpgrade, $toInstall, $depOrder, $media) = @_;
my %packages;
return if $::g_auto_install;
@@ -720,13 +752,24 @@ sub install($$$;$) {
#- place (install_steps_gtk.pm,...).
installCallback("Starting installation", $nb, $total);
- my ($i, $min) = (0, 0);
+ my ($i, $min, $medium) = (0, 0, install_any::medium());
do {
my @transToInstall;
- if ($nb <= $limitMaxTrans || !$depOrder) {
+
+ if (!$depOrder || !$media) {
@transToInstall = values %packages;
} else {
- while ($i < @$depOrder && ($i < $min || scalar @transToInstall < $limitMinTrans)) {
+ #- change current media if needed.
+ if ($i > $media->{$medium}{max}) {
+ #- search for media that contains the desired package to install.
+ foreach (keys %$media) {
+ $i >= $media->{$_}{min} && $i <= $media->{$_}{max} and $medium = $_, last;
+ }
+ }
+ $i >= $media->{$medium}{min} && $i <= $media->{$medium}{max} or die "unable to find right medium";
+ install_any::useMedium($medium);
+
+ while ($i <= $media->{$medium}{max} && ($i < $min || scalar @transToInstall < $limitMinTrans)) {
my $dep = $packages{packageName($depOrder->[$i++])} or next;
push @transToInstall, $dep;
foreach (map { split '\|' } packageDepsId($dep)) {
@@ -739,7 +782,7 @@ sub install($$$;$) {
log::l("starting new transaction of ". scalar @transToInstall ." packages, still $nb after that to do");
my $trans = c::rpmtransCreateSet($db, $prefix);
- extractHeaders($prefix, \@transToInstall);
+ extractHeaders($prefix, \@transToInstall, $media->{$medium});
c::rpmtransAddPackage($trans, $_->{header}, packageName($_), $isUpgrade && packageName($_) !~ /kernel/) #- TODO: replace `named kernel' by `provides kernel'
foreach @transToInstall;
generated by cgit v1.2.1 (git 2.21.0) at 2024-11-02 01:47:14 +0000