summaryrefslogtreecommitdiffstats
path: root/perl-install/pkgs.pm
diff options
context:
space:
mode:
authorPascal Rigaux <pixel@mandriva.com>2004-12-22 14:30:01 +0000
committerPascal Rigaux <pixel@mandriva.com>2004-12-22 14:30:01 +0000
commit42f58e5dfdec95e2d9348744168f7e75076baa65 (patch)
tree3d6ccc1c076113e2380008785f4744a939bb5b09 /perl-install/pkgs.pm
parentb35e21e0bf648fbc576bbb0fe17e5f1ff0b5d58f (diff)
downloaddrakx-backup-do-not-use-42f58e5dfdec95e2d9348744168f7e75076baa65.tar
drakx-backup-do-not-use-42f58e5dfdec95e2d9348744168f7e75076baa65.tar.gz
drakx-backup-do-not-use-42f58e5dfdec95e2d9348744168f7e75076baa65.tar.bz2
drakx-backup-do-not-use-42f58e5dfdec95e2d9348744168f7e75076baa65.tar.xz
drakx-backup-do-not-use-42f58e5dfdec95e2d9348744168f7e75076baa65.zip
create read_rpmsrate_raw() out of read_rpmsrate(), this new function can be easily used outside install
Diffstat (limited to 'perl-install/pkgs.pm')
-rw-r--r--perl-install/pkgs.pm107
1 files changed, 62 insertions, 45 deletions
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index f4f2a22f7..e51d4f9bf 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -530,10 +530,11 @@ sub psUsingHdlist {
$m;
}
-sub read_rpmsrate {
- my ($packages, $f) = @_;
+sub read_rpmsrate_raw {
+ my ($f) = @_;
my $line_nb = 0;
my $fatal_error;
+ my (%flags, %rates, @need_to_copy);
my (@l);
local $_;
while (<$f>) {
@@ -559,57 +560,38 @@ sub read_rpmsrate {
)(.*)/x) { #@")) {
($t, $flag, $data) = ($1,$2,$3);
while ($flag =~ s,^\s*(("[^"]*"|[^"\s]*)*)\s+,$1,) {}
- my $ok = 0;
- my ($inv, $p);
- $flag = join('||', grep {
- if (($inv, $p) = /^(!)?HW"(.*)"/) {
- ($inv xor detect_devices::matching_desc__regexp($p)) and $ok = 1;
- 0;
- } elsif (($inv, $p) = /^(!)?DRIVER"(.*)"/) {
- ($inv xor detect_devices::matching_driver__regexp($p)) and $ok = 1;
- 0;
- } elsif (($inv, $p) = /^(!)?TYPE"(.*)"/) {
- ($inv xor detect_devices::matching_type($p)) and $ok = 1;
- 0;
- } else {
- 1;
- }
- } split '\|\|', $flag);
- push @m, $ok ? 'TRUE' : $flag || 'FALSE';
+ push @m, $flag;
push @l2, [ length $indent, [ @m ] ];
$indent .= $t;
}
if ($data) {
# has packages on same line
- my $rate = find { /^\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) {
- if ($packages) {
- my $p = packageByName($packages, $_) or next;
- my @m2 = map { if_(/locales-(.*)/, qq(LOCALES"$1")) } $p->requires_nosense;
- my @m3 = ((grep { !/^\d$/ } @m), @m2);
- if (member('INSTALL', @m3)) {
- member('NOCOPY', @m3) or push @{$packages->{needToCopy} ||= []}, $_;
- next; #- do not need to put INSTALL flag for a package.
- }
- if (member('PRINTER', @m3)) {
- push @{$packages->{needToCopy} ||= []}, $_;
- }
- if ($p->rate) {
- my @m4 = $p->rflags;
- if ((@m3 > 1 || @m4 > 1) && "@m3[1..$#m3]" ne "@m4[1..$#m4]") {
- log::l("can not handle complicate flags for packages appearing twice ($_)");
- $fatal_error++;
- }
- log::l("package $_ appearing twice with different rates ($rate != " . $p->rate . ")") if $rate != $p->rate;
- $p->set_rate($rate);
- $p->set_rflags("$m3[0]||$m4[0]");
+ my ($rates, $flags) = partition { /^\d$/ } @m;
+ my ($rate) = @$rates or die sprintf qq(missing rate for "%s" at line %d (flags are %s)\n), $data, $line_nb, join('&&', @m);
+ foreach my $name (split ' ', $data) {
+ if (member('INSTALL', @$flags)) {
+ push @need_to_copy, $name if !member('NOCOPY', @$flags);
+ next; #- do not need to put INSTALL flag for a package.
+ }
+ if (member('PRINTER', @$flags)) {
+ push @need_to_copy, $name;
+ }
+ if (my $previous = $flags{$name}) {
+ my @common = intersection($flags, $previous);
+ my @diff1 = difference2($flags, \@common);
+ my @diff2 = difference2($previous, \@common);
+ if (!@diff1 || !@diff2) {
+ @$flags = @common;
+ } elsif (@diff1 == 1 && @diff2 == 1) {
+ @$flags = (@common, join('||', $diff1[0], $diff2[0]));
} else {
- $p->set_rate($rate);
- $p->set_rflags(@m3);
+ log::l("can not handle complicate flags for packages appearing twice ($name)");
+ $fatal_error++;
}
- } else {
- print "$_ = ", join(" && ", @m), "\n";
+ log::l("package $name appearing twice with different rates ($rate != " . $rates{$name} . ")") if $rate != $rates{$name};
}
+ $rates{$name} = $rate;
+ $flags{$name} = $flags;
}
push @l, @l2;
} else {
@@ -617,6 +599,41 @@ sub read_rpmsrate {
}
}
$fatal_error and die "$fatal_error fatal errors in rpmsrate";
+ \%rates, \%flags, \@need_to_copy;
+}
+
+sub read_rpmsrate {
+ my ($packages, $f) = @_;
+
+ my ($rates, $flags, $need_to_copy) = read_rpmsrate_raw($f);
+
+ foreach (keys %$flags) {
+ my $p = packageByName($packages, $_) or next;
+ my @more_flags = map { if_(/locales-(.*)/, qq(LOCALES"$1")) } $p->requires_nosense;
+
+ my @flags = map {
+ my $ok = 0;
+ my $flag = join('||', grep {
+ if (my ($inv, $p) = /^(!)?HW"(.*)"/) {
+ ($inv xor detect_devices::matching_desc__regexp($p)) and $ok = 1;
+ 0;
+ } elsif (($inv, $p) = /^(!)?DRIVER"(.*)"/) {
+ ($inv xor detect_devices::matching_driver__regexp($p)) and $ok = 1;
+ 0;
+ } elsif (($inv, $p) = /^(!)?TYPE"(.*)"/) {
+ ($inv xor detect_devices::matching_type($p)) and $ok = 1;
+ 0;
+ } else {
+ 1;
+ }
+ } split '\|\|', $_);
+ $ok ? 'TRUE' : $flag || 'FALSE';
+ } @{$flags->{$_}};
+
+ $p->set_rate($rates->{$_});
+ $p->set_rflags(@flags, @more_flags);
+ }
+ $packages->{needToCopy} = $need_to_copy;
}
sub readCompssUsers {