diff options
Diffstat (limited to 'pm/MGATools')
| -rw-r--r-- | pm/MGATools/rpmsrate.pm | 214 |
1 files changed, 214 insertions, 0 deletions
diff --git a/pm/MGATools/rpmsrate.pm b/pm/MGATools/rpmsrate.pm new file mode 100644 index 0000000..d92ecd8 --- /dev/null +++ b/pm/MGATools/rpmsrate.pm @@ -0,0 +1,214 @@ +package MGATools::rpmsrate; + +use strict; +use MDK::Common qw(any member); + +require Exporter; +use URPM; +our @ISA = qw(Exporter);; +our @EXPORT = qw(cleanrpmsrate); + +=head1 NAME + +Mageia rpmsrate tools + +=head1 SYNOPSYS + + require MGATools::rpmsrate; + +=head1 DESCRIPTION + +<MGATools::rpmsrate> includes Mageia rpmsrate tools. + +=head1 COPYRIGHT + +Copyright (C) 2000,2001,2002,2003,2004 Mandriva <warly@mandriva.com> + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +=cut + +# function copied from Mkcd::Tools +sub cleanrpmsrate { + my ($rpmsrate, $output, $norpmsrate, $reprpms, $urpm) = @_; + $norpmsrate ||= []; + my $LOG; open $LOG, ">&STDERR"; + open my $A, $rpmsrate or print $LOG "ERROR: cannot open $rpmsrate\n"; + my (@rpmsrate, %potloc); + # must preread to get locale guessed packages + # postfix is just used not to break the diff when checking if the result is correct + while (<$A>) { + chomp; + s/#.*//; + #s/\s*$//; + /^(\s*)$/ and push @rpmsrate, [ '', 0, '', [] ] and next; + if (/^(\S+)(.*)$/) { + push @rpmsrate, [ 0, 0, $1, [], $2 ]; + next + } + if (/^(\s*)([1-5])?(\s?[0-9A-Z_]+)$/) { + push @rpmsrate, [ $1, $2, $3, [] ]; + next + } + my ($indent, $r, $flags, $data) = /^(\s*)([1-5])?(\s*(?:(?:(?:!\s*)?[0-9A-Z_]+(?:"[^"]*")?(?:\s+(?:\|\|\s+)?)*)+\s+)|\s*)(.*)$/; + my ($postfix) = $data =~ /(\s*)$/; + my @data; + my $i; + foreach ([$data =~ /(?:^|\s)(\S+)-(?:\S+)\s+\1-(?:\S+)(?:\s|$)/g], [split ' ', $data]) { + $data[$i++] = [ @$norpmsrate ? any { my $r = $_; $r if !any { $r =~ /$_/ } @$norpmsrate } @$_ : @$_ ] + } + $potloc{$_} = [] foreach @{$data[0]}; + push @rpmsrate, [ $indent,$r, $flags, $data[1], $postfix ]; + } + my (%rpms, $text); + my (%rate, %section, %keyword); + my (%locale, %localized_pkg, %kernel_version); + my @plain_flags = qw(INSTALL LIVE); + my $kernel_like = "((?:(?:NVIDIA_)?kernel|NVIDIA_nforce|cm2020).*)"; + my $dkms_like = "(.*)([-_])kernel-([0-9]+(?:\.[0-9]+){2,3}-[0-9]+(?:.[^.]+){0,2}md[vk])(.*)"; + my $rpmsrate_dkms_like = "(.*[-_]kernel)(.*)"; + my $urpm2 = new URPM; + foreach my $dir (keys %$reprpms) { + foreach (@{$reprpms->{$dir}}) { + my $rpm = "$_.rpm"; + my $key = $_; + s/-[^-]+-[^-]+\.[^.]+$// or next; + any { $rpm =~ /$_/ } @$norpmsrate and next; + if (/(.*?)([_-]*[\d._]+)(-.*)?-devel$/ || /^$kernel_like(-[^.]+(?:\.[^.]+){3,6}md[vk])$/) { + if (!$rpms{"$1$3"}) { $rpms{"$1$3"} = [ $2, $1, $3 ] } + elsif (URPM::ranges_overlap("== $2", "> $rpms{'$1$3'}")) { $rpms{"$1$3"} = [ $2, $1, $3 ] } + if (/^$kernel_like-(\d+\.\d+)(.*)/) { $rpms{"$1-$2"} = [ $3, "$1-$2" ]} + } elsif (/^$dkms_like$/) { + my $vname = "$1$2kernel$4"; + if (!$rpms{$vname}) { $rpms{$vname} = [ $3, $vname ] } + elsif (URPM::ranges_overlap("== $3", "> $rpms{$vname}[0]")) { $rpms{$vname} = [ $3, $vname ] } + } elsif (my ($pg, $loc) = /^(.*)-([^-+]+)$/) { + if ($potloc{$pg}) { + my $pkg; + $pkg = $urpm->{rpm}{$urpm->{rpmkey}{key}{$key}} if ref $urpm; + if (!$pkg) { + my $id = $urpm2->parse_rpm("$dir/$rpm"); + $pkg = $urpm2->{depslist}[$id]; + } + if (!$pkg) { + print "ERROR cleanrpmsrate: parse_rpm $dir/$rpm ($key) failed\n"; + next + } + # some i18n packages does not require the same locale, e.g. kde-i18n-nb and nn requires locales-no + # if (grep { s/locales-// && $loc =~ /^$_(_|$)/ } @{$header{REQUIRENAME}}) { + if (any { /^locales-...?$/ } $pkg->requires) { + push @{$locale{$pg}}, $loc; + $localized_pkg{"$pg-$loc"} = 1 + } + } + } + } + } + my (%done, @flags, $prev, @tree_rate, $prev_level); + foreach (@rpmsrate) { + if (!$_->[0]) { + $text .= "$_->[2]$_->[4]\n"; + if ($_->[2]) { + @flags = $_->[2] + } + next + } + my ($indent, $r, $flags, $data, $postfix) = @$_; + my $level = (length $indent)/2 - 1; + my $rate; + if ($r) { + #print "tree_rate[$level] = $r\n"; + $rate = $r; + $tree_rate[$level] = $r + } else { + if (@$data) { + if ($level > $prev_level) { + $level-- + } else { + # fix a syntax error in rpmsrate such as + # A + # 1 toto + # B tata <--- + # 4 titi + @$data = () + } + } + $rate = $tree_rate[$level]; + } + $prev_level = $level; + @flags = @flags[0 .. $level]; + push @flags, split(' ', $flags); + #push @flags, grep { s/\s//; !/(\|\||[A-Z_]+"[^"]+")/ } split(' ', $flags); + my $flat_path = join ' ', @flags; + if (!@$data) { $text .= "$indent$r$flags$postfix\n"; next } + my @k; + foreach (@$data) { + my $c = $_; + next if ref $done{$_} && any { $flat_path eq $_ } @{$done{$_}}; + die "FATAL: too complicated flags for duplicate entry $c ($flat_path and " . join ',', @{$done{$_}} + if !member($flags[0], @plain_flags) && @flags > 1 && any { + my ($f) = $flat_path =~ /^[^ ]+ (.*)/; + !/^[^ ]+ (.*)/ || $1 ne $f + } @{$done{$_}}; + my ($d) = /(.*)-[^-]+/; + my ($a, $b, $e); + my $do; + if ((!member($flags[0], @plain_flags) && s/(-devel)// ? ($b = "-devel") : /^$kernel_like/) && (($rpms{$_}) || (defined $rpms{"lib$_"} and $a = "lib") || (defined $rpms{"lib64$_"} and $a = "lib64") || ($_ =~ s/^lib(.*?)[_-]*[\d._]*(-.*)?$/$1$2/g && defined $rpms{"lib64$_"} and $a = 'lib64'))) { + $e = $rpms{"$a$_"}[1] . $rpms{"$a$_"}[0] . $rpms{"$a$_"}[2] . $b; + $do = 1 + } elsif ((!member($flags[0], @plain_flags) && /^$rpmsrate_dkms_like$/ && $rpms{"$1$2"})) { + $e = "$1-" . $rpms{"$1$2"}[0] . "$2"; + $do = 1 + } + if ($do) { + $keyword{$c} = $e; + if (! ref $done{$e} || member($flags[0], @plain_flags) && ! (any { $flat_path eq $_ } @{$done{$e}}) || $flat_path =~ /DRIVER|HW/ ) { push @{$done{$e}}, $flat_path; push @k, $e } + } + if ($locale{$d} && $localized_pkg{$c}) { + foreach (sort @{$locale{$d}}) { + next if any { $_ eq $flat_path } @{$done{"$d-$_"}}; + push @{$done{"$d-$_"}}, $flat_path; + push @k , "$d-$_" + } + next + } + push @k, $c; + push @{$done{$c}}, $flat_path + } + if (@k) { $text .= "$indent$r$flags@k$postfix\n" } + @rate{@k} = ($rate) x @k; + my $path; + foreach (@flags) { + $path .= $path ? "/$_" : $_; + push @{$section{$path}}, @k + } + } + if (%rpms || $output || %locale) { + if (%$reprpms || $output) { + $output ||= $rpmsrate; + if (open A, ">$output") { + print A $text; + close A + } else { + print $LOG "ERROR cleanrpmsrate: cannot open $rpmsrate for writing\n"; + print $text + } + } + } + [\%rate, \%section, \%keyword] +} + +1 + |