diff options
author | Thierry Vignaud <tv@mageia.org> | 2012-03-15 08:08:43 +0000 |
---|---|---|
committer | Thierry Vignaud <tv@mageia.org> | 2012-03-15 08:08:43 +0000 |
commit | 9569d831bcd68615a4a7dc34d9033d4137dbd745 (patch) | |
tree | ed7571b1c96358f9755f21530ae143ecf97e33b1 /pm | |
parent | 70fe9970af9d20360a4cecafd122151e8928d1b7 (diff) | |
download | mgatools-9569d831bcd68615a4a7dc34d9033d4137dbd745.tar mgatools-9569d831bcd68615a4a7dc34d9033d4137dbd745.tar.gz mgatools-9569d831bcd68615a4a7dc34d9033d4137dbd745.tar.bz2 mgatools-9569d831bcd68615a4a7dc34d9033d4137dbd745.tar.xz mgatools-9569d831bcd68615a4a7dc34d9033d4137dbd745.zip |
perl_checker cleanups
Diffstat (limited to 'pm')
-rw-r--r-- | pm/MGATools/rpmsrate.pm | 63 |
1 files changed, 33 insertions, 30 deletions
diff --git a/pm/MGATools/rpmsrate.pm b/pm/MGATools/rpmsrate.pm index d92ecd8..97d5eaa 100644 --- a/pm/MGATools/rpmsrate.pm +++ b/pm/MGATools/rpmsrate.pm @@ -5,7 +5,7 @@ use MDK::Common qw(any member); require Exporter; use URPM; -our @ISA = qw(Exporter);; +our @ISA = qw(Exporter); our @EXPORT = qw(cleanrpmsrate); =head1 NAME @@ -49,6 +49,7 @@ sub cleanrpmsrate { 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 + local $_; while (<$A>) { chomp; s/#.*//; @@ -56,25 +57,25 @@ sub cleanrpmsrate { /^(\s*)$/ and push @rpmsrate, [ '', 0, '', [] ] and next; if (/^(\S+)(.*)$/) { push @rpmsrate, [ 0, 0, $1, [], $2 ]; - next + next; } if (/^(\s*)([1-5])?(\s?[0-9A-Z_]+)$/) { push @rpmsrate, [ $1, $2, $3, [] ]; - next + 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 } @$_ : @$_ ] + $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 (%locale, %localized_pkg); 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])(.*)"; @@ -89,7 +90,7 @@ sub cleanrpmsrate { 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" ]} + 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 ] } @@ -104,26 +105,26 @@ sub cleanrpmsrate { } if (!$pkg) { print "ERROR cleanrpmsrate: parse_rpm $dir/$rpm ($key) failed\n"; - next + 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 + $localized_pkg{"$pg-$loc"} = 1; } } } } } - my (%done, @flags, $prev, @tree_rate, $prev_level); + my (%done, @flags, @tree_rate, $prev_level); foreach (@rpmsrate) { if (!$_->[0]) { $text .= "$_->[2]$_->[4]\n"; if ($_->[2]) { - @flags = $_->[2] + @flags = $_->[2]; } - next + next; } my ($indent, $r, $flags, $data, $postfix) = @$_; my $level = (length $indent)/2 - 1; @@ -131,18 +132,18 @@ sub cleanrpmsrate { if ($r) { #print "tree_rate[$level] = $r\n"; $rate = $r; - $tree_rate[$level] = $r + $tree_rate[$level] = $r; } else { if (@$data) { if ($level > $prev_level) { - $level-- + $level--; } else { # fix a syntax error in rpmsrate such as # A # 1 toto # B tata <--- # 4 titi - @$data = () + @$data = (); } } $rate = $tree_rate[$level]; @@ -160,54 +161,56 @@ sub cleanrpmsrate { 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 + !/^[^ ]+ (.*)/ || $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'))) { + 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 + $do = 1; } elsif ((!member($flags[0], @plain_flags) && /^$rpmsrate_dkms_like$/ && $rpms{"$1$2"})) { - $e = "$1-" . $rpms{"$1$2"}[0] . "$2"; - $do = 1 + $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 (!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-$_"}}; + next if member($flat_path, @{$done{"$d-$_"}}); push @{$done{"$d-$_"}}, $flat_path; - push @k , "$d-$_" + push @k , "$d-$_"; } - next + next; } push @k, $c; - push @{$done{$c}}, $flat_path + 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 + push @{$section{$path}}, @k; } } if (%rpms || $output || %locale) { if (%$reprpms || $output) { $output ||= $rpmsrate; - if (open A, ">$output") { - print A $text; - close A + if (open my $A, ">$output") { + print $A $text; } else { print $LOG "ERROR cleanrpmsrate: cannot open $rpmsrate for writing\n"; - print $text + print $text; } } } - [\%rate, \%section, \%keyword] + [\%rate, \%section, \%keyword]; } 1 |