/[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 - (hide 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 wakaba 1.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