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.pm207
1 files changed, 72 insertions, 135 deletions
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index 40dba3cf3..7df6cf8ab 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -2,7 +2,7 @@ package pkgs; # $Id$
use diagnostics;
use strict;
-use vars qw(*LOG %compssListDesc @skip_list %by_lang @preferred $limitMinTrans);
+use vars qw(*LOG @preferred $limitMinTrans %compssListDesc);
use common qw(:common :file :functional :system);
use install_any;
@@ -15,80 +15,19 @@ use loopback;
use lang;
use c;
-#- lower bound on the left ( aka 90 means [90-100[ )
-%compssListDesc = (
- 100 => __("mandatory"), #- do not use it, it's for base packages
- 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)
- 70 => __("very nice"), #- KDE(normal)
- 60 => __("nice"), #- gnome(normal)
- 50 => __("interesting"),
- 40 => __("interesting"),
- 30 => __("maybe"),
- 20 => __("maybe"),
- 10 => __("maybe"),#__("useless"),
- 0 => __("maybe"),#__("garbage"),
-#- if the package requires locales-LANG and LANG is chosen, rating += 90
-#- if the package is in %by_lang and the corresponding LANG is chosen, rating += 90 (see %by_lang below)
- -10 => __("i18n (important)"), #- every install in the corresponding lang have these packages
- -20 => __("i18n (very nice)"), #- every beginner/custom install in the corresponding lang have theses packages
- -30 => __("i18n (nice)"),
-);
-#- HACK: rating += 50 for some packages (like kapm, cf install_any::setPackages)
-
-%by_lang = (
- 'ar' => [ 'acon' ],
-#'be_BE.CP1251' => [ 'fonts-ttf-cyrillic' ],
-#'bg_BG' => [ 'fonts-ttf-cyrillic' ],
- 'cs' => [ 'XFree86-ISO8859-2', 'XFree86-ISO8859-2-75dpi-fonts' ],
-# 'cy' => iso8859-14 fonts
-# 'el' => greek fonts
-# 'eo' => iso8859-3 fonts
- 'fa' => [ 'acon' ],
- 'he' => [ 'acon' ],
- 'hr' => [ 'XFree86-ISO8859-2', 'XFree86-ISO8859-2-75dpi-fonts' ],
- 'hu' => [ 'XFree86-ISO8859-2', 'XFree86-ISO8859-2-75dpi-fonts' ],
- 'hy' => [ 'fonts-ttf-armenian' ],
- 'ja' => [ 'rxvt-CLE', 'fonts-ttf-japanese', 'kterm' ],
-# 'ka' => georgian fonts
- 'ko' => [ 'rxvt-CLE', 'fonts-ttf-korean' ],
- 'lt' => [ 'fonts-type1-baltic' ],
- 'lv' => [ 'fonts-type1-baltic' ],
- 'mi' => [ 'fonts-type1-baltic' ],
-# 'mk' => [ 'fonts-ttf-cyrillic' ],
- 'pl' => [ 'XFree86-ISO8859-2', 'XFree86-ISO8859-2-75dpi-fonts' ],
- 'ro' => [ 'XFree86-ISO8859-2', 'XFree86-ISO8859-2-75dpi-fonts' ],
-# 'ru' => [ 'XFree86-cyrillic-fonts', 'fonts-ttf-cyrillic' ],
- 'ru' => [ 'XFree86-cyrillic-fonts' ],
- 'ru_RU.KOI8-R' => [ 'XFree86-cyrillic-fonts' ],
- 'sk' => [ 'XFree86-ISO8859-2', 'XFree86-ISO8859-2-75dpi-fonts' ],
- 'sl' => [ 'XFree86-ISO8859-2', 'XFree86-ISO8859-2-75dpi-fonts' ],
-# 'sp' => [ 'fonts-ttf-cyrillic' ],
- 'sr' => [ 'XFree86-ISO8859-2', 'XFree86-ISO8859-2-75dpi-fonts' ],
-# 'th' => thai fonts
- 'tr' => [ 'XFree86-ISO8859-9', 'XFree86-ISO8859-9-75dpi-fonts' ],
-#'uk_UA' => [ 'fonts-ttf-cyrillic' ],
-# 'vi' => vietnamese fonts
- 'yi' => [ 'acon' ],
- 'zh' => [ 'rxvt-CLE', 'taipeifonts', 'fonts-ttf-big5', 'fonts-ttf-gb2312' ],
- 'zh_CN.GB2312' => [ 'rxvt-CLE', 'fonts-ttf-gb2312' ],
- 'zh_TW.Big5' => [ 'rxvt-CLE', 'taipeifonts', 'fonts-ttf-big5' ],
-);
-@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
-MySQL MySQL_GPL mod_php3 midgard postfix metroess metrotmpl
-kernel-linus kernel-secure kernel-BOOT
-hackkernel hackkernel-BOOT hackkernel-headers
-hackkernel-pcmcia-cs hackkernel-smp hackkernel-smp-fb
-autoirpm autoirpm-icons numlock
-);
@preferred = qw(perl-GTK postfix wu-ftpd ghostscript-X vim-minimal kernel ispell-en);
+#- lower bound on the left ( aka 90 means [90-100[ )
+%compssListDesc = (
+ 5 => __("must have"),
+ 4 => __("important"),
+ 3 => __("very nice"),
+ 2 => __("nice"),
+ 1 => __("maybe"),
+);
+
#- constant for small transaction.
$limitMinTrans = 8;
@@ -107,7 +46,6 @@ my $PKGS_SELECTED = 0x00ffffff;
my $PKGS_FORCE = 0x01000000;
my $PKGS_INSTALLED = 0x02000000;
my $PKGS_BASE = 0x04000000;
-my $PKGS_SKIP = 0x08000000;
my $PKGS_UPGRADE = 0x20000000;
#- package to ignore, typically in Application CD.
@@ -140,7 +78,6 @@ sub packageFlagSelected { $_[0]->[$FLAGS] & $PKGS_SELECTED }
sub packageFlagForce { $_[0]->[$FLAGS] & $PKGS_FORCE }
sub packageFlagInstalled { $_[0]->[$FLAGS] & $PKGS_INSTALLED }
sub packageFlagBase { $_[0]->[$FLAGS] & $PKGS_BASE }
-sub packageFlagSkip { $_[0]->[$FLAGS] & $PKGS_SKIP }
sub packageFlagUpgrade { $_[0]->[$FLAGS] & $PKGS_UPGRADE }
sub packageSetFlagSelected { $_[0]->[$FLAGS] &= ~$PKGS_SELECTED; $_[0]->[$FLAGS] |= $_[1] & $PKGS_SELECTED; }
@@ -148,15 +85,13 @@ sub packageSetFlagSelected { $_[0]->[$FLAGS] &= ~$PKGS_SELECTED; $_[0]->[$FLAGS
sub packageSetFlagForce { $_[1] ? ($_[0]->[$FLAGS] |= $PKGS_FORCE) : ($_[0]->[$FLAGS] &= ~$PKGS_FORCE); }
sub packageSetFlagInstalled { $_[1] ? ($_[0]->[$FLAGS] |= $PKGS_INSTALLED) : ($_[0]->[$FLAGS] &= ~$PKGS_INSTALLED); }
sub packageSetFlagBase { $_[1] ? ($_[0]->[$FLAGS] |= $PKGS_BASE) : ($_[0]->[$FLAGS] &= ~$PKGS_BASE); }
-sub packageSetFlagSkip { $_[1] ? ($_[0]->[$FLAGS] |= $PKGS_SKIP) : ($_[0]->[$FLAGS] &= ~$PKGS_SKIP); }
sub packageSetFlagUpgrade { $_[1] ? ($_[0]->[$FLAGS] |= $PKGS_UPGRADE) : ($_[0]->[$FLAGS] &= ~$PKGS_UPGRADE); }
sub packageMedium { $_[0]->[$MEDIUM] }
sub packageProvides { map { $_[0]->{depslist}[$_] || die "unkown package id $_" } unpack "s*", $_[1]->[$PROVIDES] }
-sub packageValues { [ unpack "s*", $_[0]->[$VALUES] ] }
-sub packageSetValues { $_[0]->[$VALUES] = pack "s*", @{$_[1]} }
+sub packageRate { substr($_[0]->[$VALUES], 0, 1) }
sub packageHeader { $_[0]->[$HEADER] }
sub packageFreeHeader { c::headerFree(delete $_[0]->[$HEADER]) }
@@ -245,11 +180,6 @@ sub packageById {
my ($packages, $id) = @_;
$packages->{depslist}[$id] or log::l("unknown package id $id") && undef;
}
-sub allPackages {
- my ($packages) = @_;
- my %skip_list; @skip_list{@skip_list} = ();
- grep { !exists $skip_list{packageName($_)} } values %{$packages->{names}};
-}
sub packagesOfMedium {
my ($packages, $mediumName) = @_;
my $medium = $packages->{mediums}{$mediumName};
@@ -396,11 +326,6 @@ sub unselectAllPackagesIncludingUpgradable($) {
}
}
-sub skipSetWithProvides {
- my ($packages, @l) = @_;
- packageSetFlagSkip($_, 1) foreach grep { $_ } map { $_, packageProvides($packages, $_) } @l;
-}
-
sub psUpdateHdlistsDeps {
my ($prefix, $method) = @_;
my $listf = install_any::getFile('Mandrake/base/hdlists') or die "no hdlists found";
@@ -670,43 +595,66 @@ sub readCompss {
\@compss;
}
-sub readCompssList {
- my ($packages, $langs) = @_;
- my $f = install_any::getFile('Mandrake/base/compssList') or die "can't find compssList";
- my @levels = split ' ', <$f>;
-
- local $_;
+sub read_rpmsrate {
+ my ($packages, $f) = @_;
+ my $line_nb = 0;
+ my (@l);
while (<$f>) {
- /^\s*$/ || /^#/ and next;
- my ($name, @values) = split;
- my $p = packageByName($packages, $name) or log::l("unknown entry $name (in compssList)"), next;
- $p->[$VALUES] = pack "s*", @values;
- }
-
- my %done;
- foreach (@$langs) {
- my $p = packageByName($packages, "locales-$_") or next;
- foreach ($p, packageProvides($packages, $p), map { packageByName($packages, $_) } @{$by_lang{$_} || []}) {
- next if !$_ || $done{$_}; $done{$_} = 1;
- $_->[$VALUES] = pack "s*", map { $_ + 90 } ($_->[$VALUES] ? (unpack "s*", $_->[$VALUES]) : ((0) x @levels));
+ $line_nb++;
+ /\t/ and die "tabulations not allowed at line $line_nb\n";
+ s/#.*//; # comments
+
+ my ($indent, $data) = /(\s*)(.*)/;
+ next if !$data; # skip empty lines
+
+ @l = grep { $_->[0] < length $indent } @l;
+
+ my @m = @l ? @{$l[$#l][1]} : ();
+ my ($t, $flag, @l2);
+ while ($data =~
+ /^((
+ [1-5]
+ |
+ (?: (?: !\s*)? [0-9A-Z_]+(?:".*?")?)
+ (?: \s*\|\|\s* (?: !\s*)? [0-9A-Z_]+(?:".*?")?)*
+ )
+ (?:\s+|$)
+ )(.*)/x) {
+ ($t, $flag, $data) = ($1,$2,$3);
+ while ($flag =~ s,^\s*(("[^"]*"|[^"\s]*)*)\s+,$1,) {}
+ my $ok = 0;
+ $flag = join('||', grep {
+ if (my ($inv, $p) = /^(!)?PCI"(.*)"/) {
+ ($inv xor detect_devices::matching_desc($p)) and $ok = 1;
+ 0;
+ } else {
+ 1;
+ }
+ } split '\|\|', $flag);
+ push @m, $ok ? 'TRUE' : $flag || 'FALSE';
+ push @l2, [ length $indent, [ @m ] ];
+ $indent .= $t;
+ }
+ if ($data) {
+ # has packages on same line
+ my ($rate) = grep { /^\d$/ } @m or die sprintf qq(missing rate for "%s" at line %d (flags are %s)\n), $data, $line_nb, join('&&', @m);
+ foreach (split ' ', $data) {
+ #-log::l("rpmsrate: $_ = ", join(" && ", @m));
+ my $p = packageByName($packages, $_) or log::l("unknown package $_"), next;
+ $p->[$VALUES] = join("\t", $rate, grep { !/^\d$/ } @m);
+ }
+ push @l, @l2;
+ } else {
+ push @l, [ $l2[0][0], $l2[$#l2][1] ];
}
}
- my $l = { map_index { $_ => $::i } @levels };
}
sub readCompssUsers {
- my ($packages, $compss, $meta_class) = @_;
+ my ($packages, $meta_class) = @_;
my (%compssUsers, %compssUsersIcons, , %compssUsersDescr, @sorted, $l);
my (%compss);
- foreach (@$compss) {
- local ($_, $a) = m|(.*)/(.*)|;
- do { push @{$compss{$_}}, $a } while s|/[^/]+||;
- }
- my $map = sub {
- $l or return;
- $_ = $packages->{names}{$_} or log::l("unknown package $_ (in compssUsers)") foreach @$l;
- };
my $file = 'Mandrake/base/compssUsers';
my $f = $meta_class && install_any::getFile("$file.$meta_class") || install_any::getFile($file) or die "can't find $file";
local $_;
@@ -715,7 +663,6 @@ sub readCompssUsers {
s/#.*//;
if (/^(\S.*)/) {
- &$map;
my ($icon, $descr);
/^(.*?)\s*\[icon=(.*?)\](.*)/ and $_ = "$1$3", $icon = $2;
/^(.*?)\s*\[descr=(.*?)\](.*)/ and $_ = "$1$3", $descr = $2;
@@ -723,30 +670,20 @@ sub readCompssUsers {
$compssUsersDescr{$_} = $descr;
push @sorted, $_;
$compssUsers{$_} = $l = [];
- } elsif (/\s+\+(\S+)/) {
- push @$l, $1;
} elsif (/^\s+(.*?)\s*$/) {
- push @$l, @{$compss{$1} || log::l("unknown category $1 (in compssUsers)") && []};
+ push @$l, $1;
}
}
- &$map;
\%compssUsers, \@sorted, \%compssUsersIcons, \%compssUsersDescr;
}
sub setSelectedFromCompssList {
- my ($compssListLevels, $packages, $min_level, $max_size, $install_class) = @_;
- my $ind = $compssListLevels->{$install_class}; defined $ind or log::l("unknown install class $install_class in compssList"), return;
+ my ($packages, $compssUsersChoice, $min_level, $max_size, $install_class) = @_;
+ $compssUsersChoice->{TRUE} = 1; #- ensure TRUE is set
my $nb = selectedSize($packages);
- my @packages = allPackages($packages);
- my @places = do {
- #- special case for /^k/ aka kde stuff
- my @values = map { my @v = unpack "s*", $_->[$VALUES]; $v[$ind] } @packages;
- sort { $values[$b] <=> $values[$a] } 0 .. $#packages;
- };
- foreach (@places) {
- my $p = $packages[$_];
- next if packageFlagSkip($p);
- last if (unpack "s*", $p->[$VALUES])[$ind] < $min_level;
+ foreach my $p (sort { substr($a,0,1) <=> substr($b,0,1) } values %{$packages->{names}}) {
+ my ($rate, @flags) = split "\t", $p->[$VALUES];
+ next if !$rate || $rate < $min_level || grep { !grep { /^!(.*)/ ? !$compssUsersChoice->{$1} : $compssUsersChoice->{$_} } split('\|\|') } @flags;
#- determine the packages that will be selected when
#- selecting $p. the packages are not selected.
@@ -760,7 +697,7 @@ sub setSelectedFromCompssList {
}
if ($max_size && $nb > $max_size) {
$nb = $old_nb;
- $min_level = (unpack "s*", $p->[$VALUES])[$ind];
+ $min_level = packageRate($p);
last;
}
@@ -768,7 +705,7 @@ sub setSelectedFromCompssList {
selectPackage($packages, $p);
}
log::l("setSelectedFromCompssList: reached size $nb, up to indice $min_level (less than $max_size)");
- $ind, $min_level;
+ $min_level;
}
#- usefull to know the size it would take for a given min_level/max_size
@@ -1119,8 +1056,8 @@ sub selectPackagesToUpgrade($$$;$$) {
close OUTPUT;
open STDIN, "<&INPUT_CHILD";
open STDOUT, ">&OUTPUT_CHILD";
- exec "parsehdlist", "--interactive", map { "/tmp/$_->{hdlist}" } values %{$packages->{mediums}};
- c::_exit(1);
+ exec "parsehdlist", "--interactive", map { "/tmp/$_->{hdlist}" } values %{$packages->{mediums}}
+ or c::_exit(1);
}
#- let the parent known about what we found here!
generated by cgit v1.2.1 (git 2.21.0) at 2024-11-02 15:29:13 +0000