/[suikacvs]/perl/lib/Encode/Table/tool/typo2tbl.pl
Suika

Contents of /perl/lib/Encode/Table/tool/typo2tbl.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (show annotations) (download)
Thu Dec 12 07:45:49 2002 UTC (23 years, 7 months ago) by wakaba
Branch: MAIN
CVS Tags: HEAD
File MIME type: text/plain
*** empty log message ***

1 #!/usr/bin/perl
2
3 =head1 NAME
4
5 typo2tbl --- Mapping table converter, Microsoft typography's table
6 to our tbl format
7
8 =head1 USAGE
9
10 $ perl typo2tbl.pl 932.txt > ms932.tbl
11
12 =cut
13
14 use v5.8.0;
15 use strict;
16 my %add_hdr = (
17 932 => q(# ucm:code_set_alias Windows-31J Windows31J csWindows31J SJIS-CP932 MS932 X-MS-CP932 mscode X-SJIS-CP932 sjis-ms),
18 );
19
20 my %U2C;
21 my %C2U;
22 my @hdr;
23 my $u = 0;
24 my $Umode = 0;
25 while (<>) {
26 if ($Umode) {
27 if (/0x(\S+) 0x(\S+)/) {
28 $U2C{ hex $1 } = hex $2;
29 }
30 } elsif (/0x\S+ 0x\S+ ;Lead Byte Range/) {
31 } elsif (/0x(\S+) 0x(\S+)/) {
32 $C2U{ $u + hex $1 } = hex $2;
33 } elsif (/DBCSTABLE.+?;LeadByte = 0x(\S+)/) {
34 $u = 0x100 * hex $1;
35 } elsif (/WCTABLE/) {
36 $Umode = 1;
37 } elsif (/^CODEPAGE (\d+)/) {
38 push @hdr, qq(# name ms$1);
39 push @hdr, $add_hdr{$1};
40 } elsif (/^CPINFO (\d) (0x\S+) (0x\S+)/) {
41 push @hdr, qq(# ucm:mb_cur_max $1);
42 push @hdr, qq(# <-ucs-substition $2);
43 push @hdr, qq(# ->ucs-substition $3);
44 }
45 }
46
47 {
48 my @name = split /\n/, require 'unicore/Name.pl';
49 my %name;
50 for (@name) {
51 if (/^(....) ([^\t]+)/) {
52 $name{hex $1} = $2;
53 }
54 }
55 sub NAME ($) {
56 $_[0] < 0x0020 ? '<control>' :
57 $_[0] < 0x007F ? $name{$_[0]} :
58 $_[0] < 0x00A0 ? '<control>' :
59 $name{$_[0]} ? $name{$_[0]} :
60 $_[0] < 0x00A0 ? '<control>' :
61 $_[0] < 0x3400 ? '' :
62 $_[0] < 0xA000 ? '<cjk>' :
63 $_[0] < 0xE000 ? '<hangul>' :
64 $_[0] < 0xF900 ? '<private>' :
65 '';
66 }
67 }
68
69 my @t;
70 for my $U (keys %U2C) {
71 if ($C2U{$U2C{$U}} == $U) {
72 push @t, sprintf '0x%04X U+%04X # %s',
73 $U2C{$U}, $U, NAME ($U);
74 delete $C2U{ $U2C{$U} };
75 } else {
76 push @t, sprintf '0x%04X U+%04X <- # %s',
77 $U2C{$U}, $U, NAME ($U);
78 }
79 }
80 for my $C (keys %C2U) {
81 push @t, sprintf '0x%04X U+%04X -> # %s',
82 $C, $C2U{$C}, NAME ($C2U{$C});
83 }
84
85 for (@t) {
86 s/^0x00(..)/0x$1/;
87 }
88
89 print "#; This file is auto-generated (at @{[ sprintf '%04d-%02d-%02dT%02d:%02d:%02dZ', (gmtime)[5]+1900, (gmtime)[4]+1, (gmtime)[3,2,1,0] ]}).\n#; Do not edit by hand!\n";
90 print join "\n", @hdr, sort @t;
91 print "\n";
92
93 =head1 SEE ALSO
94
95 Character sets and codepages (Microsoft typography)
96 <http://www.microsoft.com/typography/unicode/cscp.htm>
97
98 =head1 AUTHOR
99
100 Nanashi-san (SuikaWiki:WindowsCodePage
101 <http://suika.fam.cx/~wakaba/-temp/wiki/wiki?WindowsCodePage>)
102
103 =head1 LICENSE
104
105 Public Domain.
106
107 =cut
108
109 # $Date: 2002/11/02 12:10:45 $

[email protected]
ViewVC Help
Powered by ViewVC 1.1.24