diff options
Diffstat (limited to 'perl-install/share/po')
| -rwxr-xr-x | perl-install/share/po/validate.pl | 100 |
1 files changed, 85 insertions, 15 deletions
diff --git a/perl-install/share/po/validate.pl b/perl-install/share/po/validate.pl index e2383ba9e..b724abc7b 100755 --- a/perl-install/share/po/validate.pl +++ b/perl-install/share/po/validate.pl @@ -15,6 +15,10 @@ # Tool to avoid common grammar errors in po files. +use MDK::Common; + +my $col = $ENV{GREP_COLOR} || "01"; +sub colorize { "[1;$col;40m@_[0m" } sub get_file($) { @@ -36,35 +40,98 @@ sub get_file($) } -my $line_number = 0; +sub check +{ + my ($category, $condition, $msg, @exceptions) = @_; + my $line = $_; + my $rest = ''; + #- kinda hard to make multiple match and still can highlight the right one.. + my $adv = sub { $rest .= substr $line, 0, 1; $line =~ s/^.// }; + while (length($line) > 1) { + $line =~ /$condition/ or return; + my ($rest_, $before, $match, $after) = ($rest, $`, $&, $'); + $adv->() foreach 1 .. length($before); + $_->($before, $match, $after) and goto next_char foreach @exceptions; + printf "$category: %-30s ", $msg; print $rest_, $before, colorize($match), $after; + next_char: + $adv->() foreach 1 .. length($match); + } +} + + +my @names = qw(XFree MHz GHz KBabel XFdrake IPv4 MTools iBook DrakX MacOS MacOSX G3 G4 DVD + Drakbackup Inc Gnome Mandrake IceWM MySQL PostgreSQL Enlightenment Window WindowMaker Fvwm + SunOS ReiserFS iMac + CD OF LPRng ext2FS PowerBook OSs CUPS NIS KDE GNOME BootX TVout + WebDAV IP SMB Boston MA MtoolsFM PCI USB ISA PnP XawTV PSC LaserJet Sony LPT\d + Frank Thomas Sergey XSane M ClusterNFS 3Com drakTermServ RAMdisk LOCAL); -# --- Problems potentially common to multiple languages +sub match { + my ($e) = @_; sub { + my ($before, $match, $after) = @_; + $match =~ /^$e/ + } +} +sub match_after { + my ($e) = @_; sub { + my ($before, $match, $after) = @_; + "$match$after" =~ /^$e/ + } +} +sub match_full { + my ($e) = @_; sub { + my ($before, $match, $after) = @_; + "$match$after" =~ /^$e/ + } +} sub mixed_case($) { - (/[\^ ][A-Z][A-Z][a-z]/ && !/XFree/ || /[\^ ][a-z][A-Z]/) and print("**.po possible-mixed-case $_"); + check('**', '\b\w[A-Z]\w*[a-z]\b', 'mixed-case', + sub { my ($b, $m, $a) = @_; $b =~ /\\$/ && $m =~ /^t/ }, + sub { my ($b, $m, $a) = @_; $b =~ /\\$/ && $m =~ /^fI/ }, + match('_[A-Z][a-z]+\b'), + map { match_after($_.'\b') } @names); + check('**', '\b\w[a-z]\w*[A-Z]\b', 'mixed-case', + map { match_after($_.'\b') } @names); } sub uppercase_after_comma($) { - /, [A-Z]/ and print("**.po uppercase-after-comma $_"); + check('**', ', [A-Z]', 'uppercase-after-comma', + map { match_after(", $_".'\b') } @names); } sub lowercase_after_dot($) { - /\. [a-z]/ and print("**.po lowercase-after-dot $_"); + check('**', '\. [a-z]', 'lowercase-after-dot', + sub { my ($b, $m, $a) = @_; any { $b =~ /$_$/ } qw(id ex) }, + sub { my ($b, $m, $a) = @_; any { $b =~ /\Q$_\E$/ } qw (S.A N.B) }, + map { match_after('\. '.$_) } @names); } -sub no_space_after_simple_ponct($) +sub no_space_after_ponct($) { - /[a-zA-Z\.]+@[a-zA-Z]/ and return; - /[,\.][a-zA-Z]/ and print("**.po no-space-after-simple-ponct $_"); + check('**', '[,\.:;]\w', 'no-space-after-ponct', + sub { my ($b, $m, $a) = @_; any { my ($beg, $end) = /^(.)(..)/; $b =~ /$beg$/ && $m eq $end } qw(S.A N.B M.N L.P) }, + sub { my ($b, $m, $a) = @_; any { my ($beg, $end) = /^(...)(..)/; $b =~ /\Q$beg\E$/ && $m eq $end } qw(M.N.F L.P.I) }, + sub { my ($b, $m, $a) = @_; any { "$m$a" =~ /\S*\.$_\b/ } + qw(com fr h d htm o org php php3 cf conf img deny pfm afm cfg tftpd allow bin uk lzrom nbi net old dir scale tbxi) }, + match_after('\.ex\.'), #- p.ex. + match(':[a-fA-F]'), #- ipv6 + map { match_after(".$_") } qw(cmode mclk vmode LTR rpmnew backupignore root_squash all_squash), 0..9 ); +} + +sub doubly_ponct($) +{ + check('**', '([\.,:;])\1', 'doubly-ponct', + match_after(quotemeta('...'))); } sub space_before_simple_ponct($) { - / \.\./ and return; - / [,\.]/ and print("**.po space-before-simple-ponct $_"); + check('**', '\s[,\.]', 'space-before-simple-ponct', + map { match_after('\s\.'.$_) } qw(rpmnew backupignore afm pfm)); } @@ -73,14 +140,17 @@ sub space_before_simple_ponct($) foreach (get_file("fr.po")) { + #- line oriented verifications /\s*#/ and next; - /ez [^ ]+ez/ and print("fr.po infinitive-form-with-ez $_"); - /è[ \.,;:]/ and print("fr.po grave-accent-at-end-of-word $_"); - (/[éêè][éêè]/ && !/créé/) and print("fr.po strange-accents-succession $_"); - /G[nN][uU]\/[lL]inux/ and print("fr.po GNU-slash-Linux-found $_"); + + check('fr', 'ez\s+\S+ez', 'infinitive-form-with-ez'); + check('fr', 'è[ \.,;:]', 'grave-accent-at-end-of-word'); + check('fr', '\b\w*[éêè][éêè]\w*\b', 'strange-accents-succession', + map { match($_) } qw(créé réécrire)); mixed_case($_); uppercase_after_comma($_); lowercase_after_dot($_); - no_space_after_simple_ponct($_); + no_space_after_ponct($_); + doubly_ponct($_); space_before_simple_ponct($_); } |