3 # $Id: ucmlint,v 2.2 2008/03/12 09:51:11 dankogai Exp $
7 our $VERSION = do { my @r = (q$Revision: 2.2 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
11 getopts("Dehfv", \%Opt);
14 eval{ require Encode; };
15 $@ and die "can't load Encode : $@";
23 $0 -[Dehfv] [ucm files ...]
25 -e test with Encode module also (requires perl 5.7.3 or higher)
27 -f forces roundtrip check even for |[123]
33 my (%Hdr, %U2E, %E2U, %Fallback);
39 my ($msg, $level) = @_;
44 $lstr = 'warning'; $nwarning++;
46 $lstr = 'error'; $nerror++;
48 print "$ARGV:$lstr in line $.: $msg\n";
52 open UCM, $ARGV or die "$ARGV:$!";
53 %Hdr = %U2E = %E2U = %Fallback = ();
54 $in_charmap = $nerror = $nwarning = 0;
58 s/\s*#.*$//o; /^$/ and next;
61 for my $must (qw/code_set_name mb_cur_min mb_cur_max/){
62 exists $Hdr{$must} or nit "<$must> nonexistent";
64 $Hdr{mb_cur_min} > $Hdr{mb_cur_max}
65 and nit sprintf("mb_cur_min(%d) > mb_cur_max(%d)",
66 $Hdr{mb_cur_min},$Hdr{mb_cur_max});
71 my($hkey, $hvalue) = /^<(\S+)>\s+[\"\']?([^\"\']+)/o or next;
72 $Opt{D} and warn "$hkey => $hvalue";
73 if ($hkey eq "code_set_name"){ # name check
74 exists $Hdr{code_set_name}
75 and nit "Duplicate <code_set_name>: $hkey";
77 if ($hkey eq "code_set_alias"){ # alias check
78 $hvalue eq $Hdr{code_set_name}
79 and nit qq(alias "$hvalue" is already in <code_set_name>);
81 $Hdr{$hkey} = $hvalue;
83 my $name = $Hdr{code_set_name};
84 my($unistr, $encstr, $fb) = /^(\S+)\s+(\S+)\s(\S+)/o or next;
85 $Opt{v} and nit $_, 2;
86 my $uni = uniparse($unistr);
87 my $enc = encparse($encstr);
88 $fb =~ /^\|([0123])$/ or nit "malformed fallback: $fb";
91 unless ($fb == 3){ # check uni -> enc
92 if (exists $U2E{$uni}){
93 nit "dupe encode map: U$uni => $U2E{$uni} and $enc", 1;
96 $Fallback{$uni}{$enc} = 1 if $fb == 1;
98 my $e = hex2enc($enc);
99 my $u = hex2uni($uni);
100 my $eu = Encode::encode($name, $u);
102 or nit qq(encode('$name', $uni) != $enc);
106 unless ($fb == 1){ # check enc -> uni
107 if (exists $E2U{$enc}){
108 nit "dupe decode map: $enc => U$E2U{$enc} and U$uni", 1;
111 $Fallback{$enc}{$uni} = 1 if $fb == 3;
113 my $e = hex2enc($enc);
114 my $u = hex2uni($uni);
115 $Opt{D} and warn "$uni, $enc";
116 my $de = Encode::decode($name, $e);
118 or nit qq(decode('$name', $enc) != $uni);
122 # warn "$uni, $enc, $fb";
125 $in_charmap or nit "Where is CHARMAP?";
127 printf ("$ARGV: %s error%s found\n",
128 ($nerror == 0 ? 'no' : $nerror),
129 ($nerror > 1 ? 's' : ''));
135 pack("C*", map {hex($_)} split(",", shift));
138 join("", map { chr(hex($_)) } split(",", shift));
142 for my $uni (keys %E2U){
143 my $enc = $U2E{$uni} or next; # okay
144 $E2U{$U2E{$uni}} eq $uni or $Fallback{$uni}{$enc} or
145 nit "RT failure: U$uni => $enc =>U$E2U{$U2E{$uni}}";
147 for my $enc (keys %E2U){
148 my $uni = $E2U{$enc} or next; # okay
149 $U2E{$E2U{$enc}} eq $enc or $Fallback{$enc}{$uni} or
150 nit "RT failure: $enc => U$uni => $U2E{$E2U{$enc}}";
158 push @u, $1 while($str =~ /\G<U(.*?)>/ig);
160 $u =~ /^([0-9A-Za-z]+)$/o
161 or nit "malformed Unicode character: $u";
163 return join(',', @u);
169 for my $e (split /\\x/io, $str){
170 $e or next; # first \x
171 $e =~ /^([0-9A-Za-z]{1,2})$/io
172 or nit "Hex $e in $str is bogus";
175 return join(',', @e);
182 A UCM file looks like this.
187 <code_set_name> "US-ascii" # Required
188 <code_set_alias> "ascii" # Optional
189 <mb_cur_min> 1 # Required; usually 1
190 <mb_cur_max> 1 # Max. # of bytes/char
191 <subchar> \x3F # Substitution char
194 <U0000> \x00 |0 # <control>
195 <U0001> \x01 |0 # <control>
196 <U0002> \x02 |0 # <control>
198 <U007C> \x7C |0 # VERTICAL LINE
199 <U007D> \x7D |0 # RIGHT CURLY BRACKET
200 <U007E> \x7E |0 # TILDE
201 <U007F> \x7F |0 # <control>