File: gen-zh2

package info (click to toggle)
libunicode-collate-perl 1.31-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 5,492 kB
  • sloc: perl: 28,296; makefile: 3
file content (654 lines) | stat: -rw-r--r-- 11,447 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
#!perl
# gen-zh2 : auxiliary script for Chinese
#
# input files
#
#   zh.txt   (generated by gen-zh)
#   loc_zh.t (generated by gen-zh)
#   ../Collate/CJK/Big5.pm
#   ../Collate/CJK/GB2312.pm
#   ../Collate/CJK/Pinyin.pm
#   ../Collate/CJK/Stroke.pm
#   ../Collate/CJK/Zhuyin.pm
#
# output files
#
#   zh_big5.txt (equal to data/zh_big5.txt)
#   zh_gb.txt   (equal to data/zh_gb.txt)
#   zh_pin.txt  (equal to data/zh_pin.txt)
#   zh_strk.txt (equal to data/zh_strk.txt)
#   zh_zhu.txt  (equal to data/zh_zhu.txt)
#   loc_cjk.t   (equal to t/loc_cjk.t)
#   loc_zhb5.t  (equal to t/loc_zhb5.t)
#   loc_zhgb.t  (equal to t/loc_zhgb.t)
#   loc_zhpy.t  (equal to t/loc_zhpy.t)
#   loc_zhst.t  (equal to t/loc_zhst.t)
#   loc_zhzy.t  (equal to t/loc_zhzy.t)
#
use strict;
use warnings;
use File::Spec;

require './gen-head'; # for testcount(), testhead(), testnew() and testprim()
require './dumpstr';  # for string()
chomp(my @cjkdata = <DATA>); # compatibility decomposable characters

my $pkg  = 'Unicode::Collate::CJK';
my @init = qw(B          G            P         S         Z       );
my %file = qw(B Big5     G GB2312     P Pinyin  S Stroke  Z Zhuyin);
my %type = qw(B big5han  G gb2312han  P pinyin  S stroke  Z zhuyin);
my %txt  = qw(B big5     G gb         P pin     S strk    Z zhu   );
my %cjk  = qw(B no       G no         P yes     S yes     Z yes   );
my %t    = qw(B b5       G gb         P py      S st      Z zy    );
my %ver  = qw(B 0        G 0          P 0       S 0       Z 0     );

my %test = (
    B => [qw(A000 5159 515B 515E 515D 5161 5163 55E7 74E9 7CCE 4E00 4E59
             4E01 4E03 4E43 4E5D 4E86 7069 706A 9EA4 9F7E 9F49 9F98)],
    G => [qw(A000 554A 963F 57C3 6328 54CE 5509 54C0 7691 764C 853C 77EE
             4E00 9F2F 9F39 9F37 9F3D 9F3E 9F44)],
    P => [qw(A000 963F 5730 7ACB 4EBA 65E5 4E0A 5929 4E0B 65BC 4E2D 7AFA
             5750)],
    S => [qw(A000 4E00 4E59 4E01 4E03 4E43 4E5D 4E86 4E8C 4EBA 513F 5165
             9E1D 7069 706A 7C72 7229 9EA4 9F7E 9F49 9F98)],
    Z => [qw(A000 516B 628A 5DF4 767D 5317 9F3B 4E0D 547D 6BCD 6253 7530
             52AA 529B 5375 5149 5915 4E09 4E00 7528)],
);

my $toneZ = << 'TONE';
02C9;[.0.0199.2.02C9]
02CA;[.019A.20.2.02CA]
02C7;[.019B.20.2.02C7]
02CB;[.019C.20.2.02CB]
02D9;[.019D.20.2.02D9]
02EA;[.019E.20.2.02EA]
02EB;[.019F.20.2.02EB]
TONE

open my $zh, "zh.txt" or die "zh.txt";
my $zhtxt = join '', <$zh>;
close $zh;

open my $zt, "loc_zh.t" or die "loc_zh.t";
my $zhtest = join '', <$zt>;
close $zt;
my $zhtest_ok = ($zhtest =~ /"1..(\d+)\\n"/) ? $1 : undef;

sub checkdata {
    my $init   = shift;
    my $file   = $file{$init};
    my $cjk    = $cjk {$init};
    my $v      = $ver {$init};
    my $count  = shift;

    my $d = File::Spec->updir();
    my $f = File::Spec->catfile($d, 'Collate', 'CJK', "$file.pm");
    open my $fh, "<$f" or die $f;

    my @out;
    my $wt = 0x8000;
    my $isdata;
    while (<$fh>) {
	if (!$isdata) {
	   $isdata = 1 if /^__DATA__/;
	   next;
	}
	last if /^__END__/;
	my @c = split;
	for my $c (@c) {
	    next if !$c;
	    my $h = sprintf('%X', $wt);
	    if ($c =~ tr/-/ /) {
		my @c = split ' ', $c;
		push @out, [$c, $h, $c[0]];
	    } else {
		my $u = hex $c;
		push @out, [$c, $h, $c] unless
			(0x4E00 <= $u && $u <= 0x9FA5 ||
			 0x3400 <= $u && $u <= 0x4DB5 ||
			0x20000 <= $u && $u <= 0x2A6D6);
		# FA1F in DUCET is not overridable.
	    }
	    $wt++;
	}
    }
    close $fh;

    ### WRITE DATA ###
    my $textf = "zh_$txt{$init}.txt";
    open my $dh, ">$textf" or die $textf;
    binmode $dh;
    my $mod  = join('::', $pkg, $file);
    my $func = join('::', $pkg, $file, "weight$file");
    print $dh "use $mod\n";
    print $dh "locale_version $v\n" if $v;
    print $dh "overrideCJK $func\n";
    print $dh $toneZ if $init eq 'Z';
    print $dh $zhtxt;
    print $dh "$_->[0];[.$_->[1].20.2.$_->[2]]\n" for @out;
    if ($cjk eq 'yes') {
	for my $d (@cjkdata) {
	    my($a,$b) = split /;/, $d;
	    print $dh "$a;<$b>+++?\n";
	}
    } else {
	die "wrong '$cjk' for $file" if $cjk ne 'no';
    }
    close $dh;

    ### WRITE TEST ###
    my $testf = "loc_zh$t{$init}.t";
    my $ok = $zhtest_ok;

    my $test = "$zhtest\n";
    my $tadd = "\$objZh->change(level => 1);\n\n";
    $tadd .= testprim('Zh', $test{$init});
    $test .= testcount(\$ok, $tadd);

    if ($init eq 'Z') {
	my $t1 = "\$objZh->change(variable => 'non-ignorable');\n\n";
	$t1 .= testprim('Zh', [qw(300 2C9 2CA 2C7 2CB 2D9 2EA 2EB 20)]);
	$t1 =~ s/->lt/->eq/; # the first only
	$test .= testcount(\$ok, $t1);

	my $t2 = "\$objZh->change(level => 2);\n\n";
	$t2 .= testprim('Zh', [qw(300 2C9)]);
	$test .= testcount(\$ok, $t2);
    }
    chomp $test;
    open my $th, ">$testf" or die $testf;
    binmode $th;
    $test =~ s/('[Zz][Hh])(')/$1__$type{$init}$2/g;
    $test =~ s/(objZh)/$1$init/g;
    $test =~ s/("1..)\d+(\\n")/$1$ok$2/;
    print $th $test;
    close $th;
}

checkdata($_) for @init;

### WRITE loc_cjk.t ###
{
    my @obj = qw($objDefault $objZhP $objZhS $objZhZ);
    my @lev = (2, 3);
    my $ok = 1 + @obj;
    my $listobj = join ', ', @obj;
    my $listlev = join ', ', @lev;

    my $test = <<"TEST";
for my \$obj ($listobj) {
    for my \$lev ($listlev) {
	\$obj->change(level => \$lev);
	my \$r = \$lev == $lev[0] ? 0 : 1;
TEST
    for my $d (@cjkdata) {
	my($a,$b) = split /;/, $d;
	my $sa = string(pack 'U', hex $a);
	my $sb = string(pack 'U*', map hex $_, split ' ', $b);
	$test .= qq|\tok(\$obj->cmp($sa, $sb), \$r);\n|;
    }
    $test .= "    }\n}\n";

    testcount(\$ok, $test, @obj * @lev);
    # discard the return value

    my $testf = "loc_cjk.t";
    open my $th, ">$testf" or die $testf;
    binmode $th;
    print $th testhead('default', $ok);
    print $th testnew('ZhP', 'ZH__pinyin');
    print $th testnew('ZhS', 'ZH__stroke');
    print $th testnew('ZhZ', 'ZH__zhuyin');
    print $th $test;
    close $th;
}

__DATA__
3220;0028 4E00 0029
3226;0028 4E03 0029
3222;0028 4E09 0029
3228;0028 4E5D 0029
3221;0028 4E8C 0029
3224;0028 4E94 0029
3239;0028 4EE3 0029
323D;0028 4F01 0029
3241;0028 4F11 0029
3227;0028 516B 0029
3225;0028 516D 0029
3238;0028 52B4 0029
3229;0028 5341 0029
323F;0028 5354 0029
3234;0028 540D 0029
323A;0028 547C 0029
3223;0028 56DB 0029
322F;0028 571F 0029
323B;0028 5B66 0029
3230;0028 65E5 0029
322A;0028 6708 0029
3232;0028 6709 0029
322D;0028 6728 0029
3231;0028 682A 0029
322C;0028 6C34 0029
322B;0028 706B 0029
3235;0028 7279 0029
323C;0028 76E3 0029
3233;0028 793E 0029
3237;0028 795D 0029
3240;0028 796D 0029
3242;0028 81EA 0029
3243;0028 81F3 0029
3236;0028 8CA1 0029
323E;0028 8CC7 0029
322E;0028 91D1 0029
3358;0030 70B9
33E9;0031 0030 65E5
32C9;0031 0030 6708
3362;0031 0030 70B9
33EA;0031 0031 65E5
32CA;0031 0031 6708
3363;0031 0031 70B9
33EB;0031 0032 65E5
32CB;0031 0032 6708
3364;0031 0032 70B9
33EC;0031 0033 65E5
3365;0031 0033 70B9
33ED;0031 0034 65E5
3366;0031 0034 70B9
33EE;0031 0035 65E5
3367;0031 0035 70B9
33EF;0031 0036 65E5
3368;0031 0036 70B9
33F0;0031 0037 65E5
3369;0031 0037 70B9
33F1;0031 0038 65E5
336A;0031 0038 70B9
33F2;0031 0039 65E5
336B;0031 0039 70B9
33E0;0031 65E5
32C0;0031 6708
3359;0031 70B9
33F3;0032 0030 65E5
336C;0032 0030 70B9
33F4;0032 0031 65E5
336D;0032 0031 70B9
33F5;0032 0032 65E5
336E;0032 0032 70B9
33F6;0032 0033 65E5
336F;0032 0033 70B9
33F7;0032 0034 65E5
3370;0032 0034 70B9
33F8;0032 0035 65E5
33F9;0032 0036 65E5
33FA;0032 0037 65E5
33FB;0032 0038 65E5
33FC;0032 0039 65E5
33E1;0032 65E5
32C1;0032 6708
335A;0032 70B9
33FD;0033 0030 65E5
33FE;0033 0031 65E5
33E2;0033 65E5
32C2;0033 6708
335B;0033 70B9
33E3;0034 65E5
32C3;0034 6708
335C;0034 70B9
33E4;0035 65E5
32C4;0035 6708
335D;0035 70B9
33E5;0036 65E5
32C5;0036 6708
335E;0036 70B9
33E6;0037 65E5
32C6;0037 6708
335F;0037 70B9
33E7;0038 65E5
32C7;0038 6708
3360;0038 70B9
33E8;0039 65E5
32C8;0039 6708
3361;0039 70B9
1F241;3014 4E09 3015
1F242;3014 4E8C 3015
1F247;3014 52DD 3015
1F243;3014 5B89 3015
1F245;3014 6253 3015
1F248;3014 6557 3015
1F240;3014 672C 3015
1F244;3014 70B9 3015
1F246;3014 76D7 3015
2F00;4E00
3192;4E00
3280;4E00
1F229;4E00
319C;4E01
3286;4E03
3194;4E09
3282;4E09
1F22A;4E09
3196;4E0A
32A4;4E0A
3198;4E0B
32A6;4E0B
319B;4E19
2F01;4E28
3197;4E2D
32A5;4E2D
1F22D;4E2D
2F02;4E36
2F03;4E3F
2F04;4E59
319A;4E59
3288;4E5D
2F05;4E85
2F06;4E8C
3193;4E8C
3281;4E8C
1F214;4E8C
3284;4E94
2F07;4EA0
1F218;4EA4
2F08;4EBA
319F;4EBA
32AD;4F01
32A1;4F11
329D;512A
2F09;513F
2F0A;5165
2F0B;516B
3287;516B
3285;516D
2F0C;5182
1F21E;518D
2F0D;5196
32A2;5199
2F0E;51AB
2F0F;51E0
2F10;51F5
2F11;5200
1F220;521D
1F21C;524D
1F239;5272
2F12;529B
3298;52B4
2F13;52F9
2F14;5315
2F15;531A
2F16;5338
32A9;533B
2F17;5341
3038;5341
3289;5341
3039;5344
303A;5345
32AF;5354
2F18;535C
2F19;5369
329E;5370
2F1A;5382
2F1B;53B6
2F1C;53C8
1F212;53CC
2F1D;53E3
1F251;53EF
32A8;53F3
1F22E;53F3
1F234;5408
3294;540D
1F225;5439
3244;554F
1F23A;55B6
2F1E;56D7
3195;56DB
3283;56DB
2F1F;571F
328F;571F
319E;5730
2F20;58EB
1F224;58F0
2F21;5902
2F22;590A
2F23;5915
1F215;591A
32B0;591C
2F24;5927
337D;5927 6B63
319D;5929
1F217;5929
2F25;5973
329B;5973
2F26;5B50
1F211;5B57
32AB;5B66
2F27;5B80
32AA;5B97
2F28;5BF8
2F29;5C0F
2F2A;5C22
2F2B;5C38
2F2C;5C6E
2F2D;5C71
2F2E;5DDB
2F2F;5DE5
32A7;5DE6
1F22C;5DE6
2F30;5DF1
2F31;5DFE
2F32;5E72
337B;5E73 6210
2F33;5E7A
3245;5E7C
2F34;5E7F
2F35;5EF4
2F36;5EFE
2F37;5F0B
2F38;5F13
2F39;5F50
2F3A;5F61
2F3B;5F73
1F21D;5F8C
1F250;5F97
2F3C;5FC3
2F3D;6208
2F3E;6236
2F3F;624B
1F210;624B
1F231;6253
1F227;6295
1F22F;6307
1F228;6355
2F40;652F
2F41;6534
2F42;6587
3246;6587
2F43;6597
1F21B;6599
2F44;65A4
1F21F;65B0
2F45;65B9
2F46;65E0
2F47;65E5
3290;65E5
337E;660E 6CBB
1F219;6620
337C;662D 548C
2F48;66F0
2F49;6708
328A;6708
1F237;6708
3292;6709
1F236;6709
2F4A;6728
328D;6728
3291;682A
337F;682A 5F0F 4F1A 793E
2F4B;6B20
2F4C;6B62
32A3;6B63
2F4D;6B79
2F4E;6BB3
2F4F;6BCB
2E9F;6BCD
2F50;6BD4
2F51;6BDB
2F52;6C0F
2F53;6C14
2F54;6C34
328C;6C34
329F;6CE8
1F235;6E80
1F226;6F14
2F55;706B
328B;706B
1F21A;7121
2F56;722A
2F57;7236
2F58;723B
2F59;723F
2F5A;7247
2F5B;7259
2F5C;725B
3295;7279
2F5D;72AC
2F5E;7384
2F5F;7389
2F60;74DC
2F61;74E6
2F62;7518
2F63;751F
1F222;751F
2F64;7528
2F65;7530
3199;7532
1F238;7533
329A;7537
2F66;758B
2F67;7592
2F68;7676
2F69;767D
2F6A;76AE
2F6B;76BF
32AC;76E3
2F6C;76EE
2F6D;77DB
2F6E;77E2
2F6F;77F3
2F70;793A
3293;793E
3297;795D
1F232;7981
2F71;79B8
2F72;79BE
3299;79D8
2F73;7A74
1F233;7A7A
2F74;7ACB
2F75;7AF9
3247;7B8F
2F76;7C73
2F77;7CF8
1F221;7D42
2F78;7F36
2F79;7F51
2F7A;7F8A
2F7B;7FBD
2F7C;8001
2F7D;800C
2F7E;8012
2F7F;8033
2F80;807F
2F81;8089
2F82;81E3
2F83;81EA
2F84;81F3
2F85;81FC
2F86;820C
2F87;821B
2F88;821F
2F89;826E
2F8A;8272
2F8B;8278
2F8C;864D
2F8D;866B
2F8E;8840
2F8F;884C
2F90;8863
2F91;897E
2F92;898B
2F93;89D2
1F216;89E3
2F94;8A00
2F95;8C37
2F96;8C46
2F97;8C55
2F98;8C78
2F99;8C9D
3296;8CA1
1F223;8CA9
32AE;8CC7
2F9A;8D64
2F9B;8D70
1F230;8D70
2F9C;8DB3
2F9D;8EAB
2F9E;8ECA
2F9F;8F9B
2FA0;8FB0
2FA1;8FB5
1F22B;904A
329C;9069
2FA2;9091
2FA3;9149
2FA4;91C6
2FA5;91CC
2FA6;91D1
328E;91D1
2FA7;9577
2FA8;9580
2FA9;961C
2FAA;96B6
2FAB;96B9
2FAC;96E8
2FAD;9751
2FAE;975E
2FAF;9762
2FB0;9769
2FB1;97CB
2FB2;97ED
2FB3;97F3
2FB4;9801
32A0;9805
2FB5;98A8
2FB6;98DB
2FB7;98DF
2FB8;9996
2FB9;9999
2FBA;99AC
2FBB;9AA8
2FBC;9AD8
2FBD;9ADF
2FBE;9B25
2FBF;9B2F
2FC0;9B32
2FC1;9B3C
2FC2;9B5A
2FC3;9CE5
2FC4;9E75
2FC5;9E7F
2FC6;9EA5
2FC7;9EBB
2FC8;9EC3
2FC9;9ECD
2FCA;9ED1
2FCB;9EF9
2FCC;9EFD
2FCD;9F0E
2FCE;9F13
2FCF;9F20
2FD0;9F3B
2FD1;9F4A
2FD2;9F52
2FD3;9F8D
2FD4;9F9C
2EF3;9F9F
2FD5;9FA0