Show
Ignore:
Timestamp:
01/17/08 23:48:55 (10 months ago)
Author:
tokuhirom
Message:

lang/perl/Encode-JP-Mobile: rewrote

Files:
1 modified

Legend:

Unmodified
Added
Removed

  • lang/perl/Encode-JP-Mobile/trunk/tools/make-utf8-ucm.pl

    r4789 r4817  
    44use Encode; 
    55use Encode::JP::Mobile; 
     6use autobox; 
     7use autobox::Core; 
     8use autobox::Encode; 
     9use FindBin; 
     10use File::Spec; 
     11use Path::Class; 
    612 
    7 my $map = YAML::LoadFile 'dat/convert-map-utf8.yaml'; 
     13my $map = YAML::LoadFile file($FindBin::Bin, '..', 'dat', 'convert-map-utf8.yaml'); 
     14my $cp932_ucm = file($FindBin::Bin, '..', 'ucm', 'cp932.ucm'); 
    815 
    916my %alias = qw( 
    … …  
    1926}; 
    2027 
    21 my $cp932_ucm = shift @ARGV or die "Usage: $0 cp932.ucm\n"; 
     28sub SCALAR::to_hex($) { sprintf '%X', $_[0] } 
    2229 
    23 for my $to (qw( docomo kddi softbank )) { 
    24     open my $fh, '>', "ucm/x-utf8-$to.ucm" or die $!; 
    25     print {$fh} <<HEAD 
     30&main;exit; 
     31 
     32sub main { 
     33    for my $to (qw( docomo kddi softbank )) { 
     34        my $fh = file('ucm', "x-utf8-$to.ucm")->openw or die $!; 
     35 
     36        print {$fh} <<HEAD 
    2637<code_set_name> "x-utf8-$to" 
    2738<code_set_alias> "x-utf8-$alias{$to}" 
    … …  
    3142CHARMAP 
    3243HEAD 
    33     ; 
     44        ; 
    3445 
    35     # basic map 
    36     print {$fh} unicode_ucm($cp932_ucm); 
     46        # basic map 
     47        print {$fh} unicode_ucm($cp932_ucm); 
    3748 
    38     # convert map 
    39     for my $from (qw( docomo kddi softbank )) { 
    40         next if $from eq $to; 
     49        # convert map 
     50        for my $from (qw( docomo kddi softbank )) { 
     51            next if $from eq $to; 
    4152 
    42         print {$fh} "\n\n# pictogram convert map ($from => $to)\n"; 
     53            print {$fh} "\n\n# pictogram convert map ($from => $to)\n"; 
    4354 
    44         for my $srcuni (sort keys %{$map->{$from}}) { 
    45             my $dstuni = $map->{$from}{$srcuni}{$to} or next; 
    46             printf {$fh} "<U%s> %s |1 # %s\n", $srcuni, unihex2utf8hex($dstuni), comment_for($from); 
     55            for my $srcuni (sort keys %{$map->{$from}}) { 
     56                my $dstuni = $map->{$from}{$srcuni}{$to} or next; 
     57                printf {$fh} "<U%s> %s |1 # %s\n", $srcuni, unihex2utf8hex($dstuni), comment_for($from); 
     58            } 
    4759        } 
     60 
     61        # original 
     62        if ($to eq 'kddi') { 
     63            # ura-kddi 
     64            range_each($to, sub { 
     65                my $unicode = shift; 
     66                my $unihex = 'U*'->unpack($unicode->chr->encode('x-sjis-kddi')->decode('x-sjis-kddi-auto'))->to_hex; 
     67                print {$fh} sprintf "<U%s> %s |0 # %s\n", $unihex, unihex2utf8hex($unihex), "UraKDDI pictogram"; 
     68            }); 
     69        } else { 
     70            range_each($to, sub { 
     71                my $unicode = shift; 
     72                my $unihex = $unicode->to_hex; 
     73                print {$fh} sprintf "<U%s> %s |0 # %s\n", $unihex, unihex2utf8hex($unihex), "$to pictogram"; 
     74            }); 
     75        } 
     76 
     77        print {$fh} "END CHARMAP\n"; 
    4878    } 
    49  
    50     # original 
    51     if ($to eq 'kddi') { 
    52         # ura-kddi 
    53         range_each($to, sub { 
    54             my $unicode = shift; 
    55             my $sjiscode = hex unpack "H*", encode('x-sjis-kddi', chr $unicode); 
    56             my $unihex = sprintf '%X', $sjiscode - 0x0700; 
    57             print {$fh} sprintf "<U%s> %s |0 # %s\n", $unihex, unihex2utf8hex($unihex), "UraKDDI pictogram"; 
    58         }); 
    59     } else { 
    60         range_each($to, sub { 
    61             my $unicode = shift; 
    62             my $unihex = sprintf '%X', $unicode; 
    63             print {$fh} sprintf "<U%s> %s |0 # %s\n", $unihex, unihex2utf8hex($unihex), "$to pictogram"; 
    64         }); 
    65     } 
    66  
    67     print {$fh} "END CHARMAP\n"; 
    6879} 
    6980 
    … …  
    7889sub unihex2utf8hex { 
    7990    my $uni = shift; 
    80     $uni = chr hex $uni; 
    81     $uni = encode 'utf-8', $uni; 
    82     $uni = unpack "H*", $uni; 
     91    $uni = 'H*'->unpack($uni->hex->chr->encode('utf-8')); 
    8392    $uni =~ s/(..)/\\x$1/g; 
    8493    $uni; 
    … …  
    8897    my $cp932_ucm = shift; 
    8998    my $res = ''; 
    90     open my $fh, '<', $cp932_ucm or die "$!: $cp932_ucm"; 
     99    my $fh = $cp932_ucm->openr or die $!; 
    91100    while (my $line = <$fh>) { 
    92101        if ($line =~ /^<U(.{4})> \S+ \|0 # (.+)$/) { 
    … …  
    99108        } 
    100109    } 
     110    $fh->close; 
    101111    $res; 
    102112}