summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
authorGuillaume Cottenceau <gc@mandriva.com>2003-03-03 13:15:21 +0000
committerGuillaume Cottenceau <gc@mandriva.com>2003-03-03 13:15:21 +0000
commit25c3267f928ae231494dd4b14402cbb0710aa455 (patch)
treede0a153302827ecc22366cbbbb276d828a5a3f84 /perl-install
parent2eefecf3e842f2cd814c4971263f643b344e2d59 (diff)
downloaddrakx-25c3267f928ae231494dd4b14402cbb0710aa455.tar
drakx-25c3267f928ae231494dd4b14402cbb0710aa455.tar.gz
drakx-25c3267f928ae231494dd4b14402cbb0710aa455.tar.bz2
drakx-25c3267f928ae231494dd4b14402cbb0710aa455.tar.xz
drakx-25c3267f928ae231494dd4b14402cbb0710aa455.zip
make it useful
- print problems with GREP_COLOR - have enough exceptions to get usable errors
Diffstat (limited to 'perl-install')
-rwxr-xr-xperl-install/share/po/validate.pl100
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@_" }
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($_);
}