- perl_checker: add *much* stricter syntax rules

- adapt *.pm's to those rules

7 files changed, 45 insertions, 11 deletions

diff --git a/MDK/Common/DataStructure.pm b/MDK/Common/DataStructure.pm
index 0becc8d..6e6ab12 100644
--- a/MDK/Common/DataStructure.pm
+++ b/MDK/Common/DataStructure.pm
@@ -131,7 +131,7 @@ sub is_empty_hash_ref { my $a = shift; !defined $a || keys(%$a) == 0 }
 
 sub uniq { my %l; $l{$_} = 1 foreach @_; grep { delete $l{$_} } @_ }
 sub difference2 { my %l; @l{@{$_[1]}} = (); grep { !exists $l{$_} } @{$_[0]} }
-sub intersection { my (%l, @m); @l{@{shift @_}} = (); foreach (@_) { @m = grep { exists $l{$_} } @$_; %l = (); @l{@m} = (); } keys %l }
+sub intersection { my (%l, @m); @l{@{shift @_}} = (); foreach (@_) { @m = grep { exists $l{$_} } @$_; %l = (); @l{@m} = () } keys %l }
 
 
 sub next_val_in_array {
diff --git a/MDK/Common/File.pm b/MDK/Common/File.pm
index 3d1238c..2715855 100644
--- a/MDK/Common/File.pm
+++ b/MDK/Common/File.pm
@@ -107,7 +107,7 @@ sub dirname { local $_ = shift; s|[^/]*/*\s*$||; s|(.)/*$|$1|; $_ || '.' }
 sub basename { local $_ = shift; s|/*\s*$||; s|.*/||; $_ }
 sub cat_ { local *F; open F, $_[0] or return; my @l = <F>; wantarray ? @l : join '', @l }
 sub cat__ { my ($f) = @_; my @l = <$f>; wantarray ? @l : join '', @l }
-sub output { my $f = shift; local *F; open F, ">$f" or die "output in file $f failed: $!\n"; print F foreach @_; }
+sub output { my $f = shift; local *F; open F, ">$f" or die "output in file $f failed: $!\n"; print F foreach @_ }
 sub output_p { my $f = shift; mkdir_p(dirname($f)); output($f, @_) }
 sub linkf    { unlink $_[1]; link    $_[0], $_[1] }
 sub symlinkf { unlink $_[1]; symlink $_[0], $_[1] }
diff --git a/MDK/Common/Func.pm b/MDK/Common/Func.pm
index 3e8285d..8cca560 100644
--- a/MDK/Common/Func.pm
+++ b/MDK/Common/Func.pm
@@ -181,7 +181,7 @@ sub smapn {
     my $f = shift;
     my $n = shift;
     my @r = ();
-    for (my $i = 0; $i < $n; $i++) { push @r, &$f(map { $_->[$i] } @_); }
+    for (my $i = 0; $i < $n; $i++) { push @r, &$f(map { $_->[$i] } @_) }
     @r
 }
 sub mapn(&@) {
diff --git a/MDK/Common/Math.pm b/MDK/Common/Math.pm
index 81a12ae..9118449 100644
--- a/MDK/Common/Math.pm
+++ b/MDK/Common/Math.pm
@@ -125,8 +125,8 @@ sub odd  { $_[0] % 2 == 1 }
 sub sqr  { $_[0] * $_[0] }
 sub sign { $_[0] <=> 0 }
 sub round { int ($_[0] + 0.5) }
-sub round_up { my ($i, $r) = @_; $i = int $i; $i += $r - ($i + $r - 1) % $r - 1; }
-sub round_down { my ($i, $r) = @_; $i = int $i; $i -= $i % $r; }
+sub round_up { my ($i, $r) = @_; $i = int $i; $i += $r - ($i + $r - 1) % $r - 1 }
+sub round_down { my ($i, $r) = @_; $i = int $i; $i -= $i % $r }
 sub divide { my $d = int $_[0] / $_[1]; wantarray ? ($d, $_[0] % $_[1]) : $d }
 sub min { my $n = shift; $_ < $n and $n = $_ foreach @_; $n }
 sub max { my $n = shift; $_ > $n and $n = $_ foreach @_; $n }
@@ -143,7 +143,7 @@ sub factorize {
     $n == 1 and return [ 1, 1 ];
     for (my $k = 2; sqr($k) <= $n; $k++) {
 	my $i = 0;
-	for ($i = 0; $n % $k == 0; $i++) { $n /= $k; }
+	for ($i = 0; $n % $k == 0; $i++) { $n /= $k }
 	$i and push @r, [ $k, $i ];
     }
     $n > 1 and push @r, [ $n, 1 ];
diff --git a/MDK/Common/System.pm b/MDK/Common/System.pm
index 6fca4d6..73ba091 100644
--- a/MDK/Common/System.pm
+++ b/MDK/Common/System.pm
@@ -261,8 +261,8 @@ sub df {
 
 sub sync { syscall_('sync') }
 sub psizeof { length pack $_[0] }
-sub availableMemory() { MDK::Common::Math::sum(map { /(\d+)/ } grep { /^(MemTotal|SwapTotal):/ } MDK::Common::File::cat_("/proc/meminfo")); }
-sub availableRamMB() { 4 * MDK::Common::Math::round((-s '/proc/kcore') / 1024 / 1024 / 4); }
+sub availableMemory() { MDK::Common::Math::sum(map { /(\d+)/ } grep { /^(MemTotal|SwapTotal):/ } MDK::Common::File::cat_("/proc/meminfo")) }
+sub availableRamMB() { 4 * MDK::Common::Math::round((-s '/proc/kcore') / 1024 / 1024 / 4) }
 sub gettimeofday { my $t = pack "LL"; syscall_('gettimeofday', $t, 0) or die "gettimeofday failed: $!\n"; unpack("LL", $t) }
 sub unix2dos { local $_ = $_[0]; s/\015$//mg; s/$/\015/mg; $_ }
 
diff --git a/perl-MDK-Common.spec b/perl-MDK-Common.spec
index 8b84776..4389406 100644
--- a/perl-MDK-Common.spec
+++ b/perl-MDK-Common.spec
@@ -2,7 +2,7 @@
 
 # do not change the version here, change in MDK/Common.pm.pl
 %define version THEVERSION
-%define release 8mdk
+%define release 9mdk
 
 Summary: Various simple functions
 Name: perl-MDK-Common
@@ -49,6 +49,10 @@ rm -rf $RPM_BUILD_ROOT
 
 # MODIFY IN THE CVS: cvs.mandrakesoft.com:/cooker soft/perl-MDK-Common
 %changelog
+* Wed Jul 31 2002 Pixel <pixel@mandrakesoft.com> 1.0.3-9mdk
+- perl_checker: add *much* stricter syntax rules
+- adapt *.pm's to those rules
+
 * Sun Jul 28 2002 Pixel <pixel@mandrakesoft.com> 1.0.3-8mdk
 - MDK::Common::DataStructure: add sort_numbers
 
diff --git a/perl_checker b/perl_checker
index 9401956..594fc98 100755
--- a/perl_checker
+++ b/perl_checker
@@ -38,6 +38,8 @@ if (/^# perl_checker: RE-EXPORT-ALL/) {
 /^=head/ .. /^=cut/ and next;
 /^\s*#/ and next;
 
+$explicit_no_warning = /#-#/;
+
 if (/^\s*require\s+([\w:]+);/) {
     add_use($1);
 } elsif (my ($r) = /^\s*require (.*)/) {
@@ -46,6 +48,31 @@ if (/^\s*require\s+([\w:]+);/) {
     next;
 }
 
+
+if (/\(\s+[^#\s({\[]/ && !/qq\(/) {
+    warn_(q(spurious space after opening parenthesis), info());
+}
+
+if (/[^#\s)}\]]\s+\)/) {
+    warn_(q(spurious space before closing parenthesis), info());
+}
+
+if (/;([^\s\\].{0,10})/ && !/^sub/ && !/;-\)/ && !/=~/ && !/^\s+;;$/) {
+    warn_(qq(missing space after ";$1"), info());
+}
+
+if (/;\s*\}/) {
+    warn_(q(spurious ";" before closing block), info());
+}
+
+if (/(.*\s\{)[^\s{}]/ && !/\{[\d,]+\}/ && !/Usage:/) { #- eg of Usage: cmd {foo|bar}
+    warn_(qq(missing space after "$1"), info());
+}
+
+if (/\{\s[^{}]*[^\s{}]\}/) {
+    warn_(qq(missing space before "}$'"), info());
+}
+
 if (/%_\W/ || /[^@]\$_{/) {
     err(q(do not use %_), info());
 }
@@ -64,7 +91,8 @@ if (/[}>]{(['"])([a-z][a-z0-9_]*)\1}/i) {
       # special case for {'y'} otherwise the emacs mode goes wild
       # special case for {'x'} to have the same as {'y'} (since they usually go together)
 }
-if (/%$\w+(->|\{)/ || /%{([^{}]|{[^{}]*})*}(->|\{)/) {
+if (/%\$\w+(->|\{)/ || /%\{([^{}]|\{[^{}]*\})*\}(->|\{)/ ||
+    /@\$\w+->/      || /@\{([^{}]|\{[^{}]*\})*\}->/) {
     err(q(bad expression, tell pixel@mandrakesoft.com), info());
 }
 
@@ -93,7 +121,7 @@ if ((my ($op) = /([<>]{2})/) && (/[+-]\s*[\w\$]+\s*[<>]{2}/ || /[<>]{2}\s*[\w\$]
     err(qq(parentheses needed around operator $op), info());
 }
 if (/=.*:\s*\$\w+\s*=/) {
-    err(q(do not use ``cond ? $v1 = XX1 : $v2 = XX2'' which is parted as ``(cond ? $v1 = XX1 : $v2) = XX2''), info());
+    err(q(do not use ``cond ? $v1 = XX1 : $v2 = XX2'' which is parsed as ``(cond ? $v1 = XX1 : $v2) = XX2''), info());
 }
 
 if (/^\s*package ([\w:]+)/) {
@@ -216,6 +244,8 @@ sub err {
 sub warn_ {
     my ($m, $i) = @_;
 
+    return if $explicit_no_warning;
+
     if ($i) {
 	 print STDERR "$i->{file}:$i->{line}: $m\n";
     } else {