view release on metacpan or  search on metacpan

make__DATA__/make__DATA__.pl  view on Meta::CPAN

);

# Shift_JIS (JIS X 0208, two octets) to JIS X 0208 GL (kuten) hex
sub JISGL_by_SJIS {
    my($sjis) = @_;
    return q{} if length($sjis) != 4;
    my($c1,$c2) = map { hex($_) } $sjis =~ /^(..)(..)$/;
    my($j1,$j2);
    if ($c2 >= 0x9F) {
        $j1 = ((($c1 < 0xA0) ? ($c1 - 0x81) : ($c1 - 0xC1)) * 2) + 0x22;
        $j2 = $c2 - 0x7E;
    }
    else {
        $j1 = ((($c1 < 0xA0) ? ($c1 - 0x81) : ($c1 - 0xC1)) * 2) + 0x21;
        $j2 = $c2 - (($c2 > 0x7E) ? 0x20 : 0x1F);
    }
    return sprintf("%02X%02X", $j1, $j2);
}

# JIS X 0208 GL (kuten) hex to Shift_JIS (two octets), inverse of JISGL_by_SJIS
sub SJIS_by_JISGL {
    my($jis) = @_;
    my($j1,$j2) = map { hex($_) } $jis =~ /^(..)(..)$/;
    my($x,$hi);
    if ((($j1 - 0x21) % 2) == 0) { $x = ($j1 - 0x21) / 2; $hi = 0; }
    else                         { $x = ($j1 - 0x22) / 2; $hi = 1; }
    my $c1 = ($x <= 0x1E) ? ($x + 0x81) : ($x + 0xC1);
    my $c2;
    if ($hi) { $c2 = $j2 + 0x7E; }
    else     { $c2 = $j2 + (($j2 > 0x5F) ? 0x20 : 0x1F); }
    return sprintf("%02X%02X", $c1, $c2);
}

# "sjis" of JIS X 0208-1983 by "sjis" of JIS X 0208-1990
sub SJIS1983_by_SJIS1990 {
    my($sjis1990) = @_;
    if (($sjis1990 eq q{}) or $SJIS_appended_by_1990{$sjis1990}) {
        return q{};
    }
    return $sjis1990;
}

# "sjis" of JIS C 6226-1978 by "sjis" of JIS X 0208-1983
sub SJIS1978_by_SJIS1983 {
    my($sjis1983) = @_;
    if ($sjis1983 eq q{}) {
        return q{};
    }
    if (length($sjis1983) != 4) {   # JIS X 0201 single octet is unchanged
        return $sjis1983;
    }
    my $jis83gl = JISGL_by_SJIS($sjis1983);
    my $jis78gl = JIS78GL_by_JIS83GL($jis83gl);
    if (not defined $jis78gl) {      # unchanged between 1978 and 1983
        return $sjis1983;
    }
    if ($jis78gl eq q{}) {           # not in JIS C 6226-1978 (Category 1)
        return q{};
    }

    # A relocation is applied only when it is a two-way exchange (the
    # JIS C 6226-1978 "simplified and traditional exchanged" pairs of
    # Category 3, which are bidirectional in %JIS78GL_by_JIS83GL). A
    # one-way relocation (Category 2, where JIS X 0208-1983 gave the
    # unsimplified form a new code while the simplified form kept the
    # original code) would collide with the simplified form that keeps
    # that code, so the unsimplified form is treated as not in JIS C
    # 6226-1978.

    my $back = JIS78GL_by_JIS83GL($jis78gl);
    if ((not defined $back) or ($back ne $jis83gl)) {
        return q{};
    }
    return SJIS_by_JISGL($jis78gl);  # relocated (exchanged) in JIS C 6226-1978
}

# "sjis" of JIS X 0213:2000 by "sjis" of JIS X 0213:2004
sub SJIS2000_by_SJIS2004 {
    my($sjis2004) = @_;
    if (($sjis2004 eq q{}) or $SJIS_appended_by_2004{$sjis2004}) {
        return q{};
    }
    return $sjis2004;
}

binmode(STDOUT);

print STDOUT <<'COMMENT';
__DATA__
#####################################################################################################################################
# Jacode4e table
#####################################################################################################################################
#+++++++-------------------------------------------------------------------------------------------------------------------------- CP932X, Extended CP932 to JIS X 0213 using 0x9C5A as single shift
#|        ++++-------------------------------------------------------------------------------------------------------------------- Microsoft CP932, IANA Windows-31J
#|        |    ++++--------------------------------------------------------------------------------------------------------------- IBM CP932
#|        |    |    ++++---------------------------------------------------------------------------------------------------------- NEC CP932
#|        |    |    |    ++++----------------------------------------------------------------------------------------------------- JISC Shift_JIS of JIS C 6226-1978  (JIS X 0201, JIS X 0208)
#|        |    |    |    |    ++++------------------------------------------------------------------------------------------------ JISC Shift_JIS of JIS X 0208-1983  (JIS X 0201, JIS X 0208)
#|        |    |    |    |    |    ++++------------------------------------------------------------------------------------------- JISC Shift_JIS of JIS X 0208-1990  (JIS X 0201, JIS X 0208)
#|        |    |    |    |    |    |    ++++-------------------------------------------------------------------------------------- JISC Shift_JIS-2004 of JIS X 0213:2000
#|        |    |    |    |    |    |    |    ++++--------------------------------------------------------------------------------- JISC Shift_JIS-2004 of JIS X 0213:2004
#|        |    |    |    |    |    |    |    |    ++++---------------------------------------------------------------------------- IBM CP00930(CP00290+CP00300), CCSID 5026 katakana
#|        |    |    |    |    |    |    |    |    |    ++++----------------------------------------------------------------------- HITACHI KEIS78
#|        |    |    |    |    |    |    |    |    |    |    ++++------------------------------------------------------------------ HITACHI KEIS83
#|        |    |    |    |    |    |    |    |    |    |    |    ++++------------------------------------------------------------- HITACHI KEIS90
#|        |    |    |    |    |    |    |    |    |    |    |    |    ++++-------------------------------------------------------- FUJITSU JEF
#|        |    |    |    |    |    |    |    |    |    |    |    |    |    ++++--------------------------------------------------- NEC JIPS(J)
#|        |    |    |    |    |    |    |    |    |    |    |    |    |    |    ++++---------------------------------------------- NEC JIPS(E)
#|        |    |    |    |    |    |    |    |    |    |    |    |    |    |    |    ++++----------------------------------------- UNISYS LetsJ
#|        |    |    |    |    |    |    |    |    |    |    |    |    |    |    |    |    +++++++++------------------------------- Unicode
#|        |    |    |    |    |    |    |    |    |    |    |    |    |    |    |    |    |         ++++++++++++------------------ UTF-8.0 (aka UTF-8)
#|        |    |    |    |    |    |    |    |    |    |    |    |    |    |    |    |    |         |            ++++++++++++----- UTF-8.1
#|        |    |    |    |    |    |    |    |    |    |    |    |    |    |    |    |    |         |            |            ++++++++- UTF-8-SPUA-JP, JIS X 0213 on SPUA ordered by JIS level, plane, row, cell
#1234567 1234 1234 1234 1234 1234 1234 1234 1234 1234 1234 1234 1234 1234 1234 1234 1234 123456789 123456789012 123456789012 12345678
#VVVVVVV VVVV VVVV VVVV VVVV VVVV VVVV VVVV VVVV VVVV VVVV VVVV VVVV VVVV VVVV VVVV VVVV VVVVVVVVV VVVVVVVVVVVV VVVVVVVVVVVV VVVVVVVV
COMMENT

my $spua_jp = 0xF0000;
for my $jis8 (qw(
    00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F
    10 11 12 13 14 15 16 17 18 19 1A 1B 1C 1D 1E 1F
    20 21 22 23 24 25 26 27 28 29 2A 2B 2C 2D 2E 2F
    30 31 32 33 34 35 36 37 38 39 3A 3B 3C 3D 3E 3F
    40 41 42 43 44 45 46 47 48 49 4A 4B 4C 4D 4E 4F
    50 51 52 53 54 55 56 57 58 59 5A 5B 5C 5D 5E 5F
    60 61 62 63 64 65 66 67 68 69 6A 6B 6C 6D 6E 6F
    70 71 72 73 74 75 76 77 78 79 7A 7B 7C 7D 7E 7F
    80 81 82 83 84 85 86 87 88 89 8A 8B 8C 8D 8E 8F
    90 91 92 93 94 95 96 97 98 99 9A 9B 9C 9D 9E 9F
    A0 A1 A2 A3 A4 A5 A6 A7 A8 A9 AA AB AC AD AE AF
    B0 B1 B2 B3 B4 B5 B6 B7 B8 B9 BA BB BC BD BE BF
    C0 C1 C2 C3 C4 C5 C6 C7 C8 C9 CA CB CC CD CE CF
    D0 D1 D2 D3 D4 D5 D6 D7 D8 D9 DA DB DC DD DE DF
    E0 E1 E2 E3 E4 E5 E6 E7 E8 E9 EA EB EC ED EE EF