xref: /openbsd-src/gnu/usr.bin/perl/cpan/Encode/bin/ucm2table (revision b39c515898423c8d899e35282f4b395f7cad3298)
1*b39c5158Smillert#!/usr/bin/perl
2*b39c5158Smillert# $Id: ucm2table,v 2.1 2006/05/03 18:24:10 dankogai Exp $
3*b39c5158Smillert#
4*b39c5158Smillert
5*b39c5158Smillertuse 5.006;
6*b39c5158Smillertuse strict;
7*b39c5158Smillertuse Getopt::Std;
8*b39c5158Smillertmy %Opt;
9*b39c5158Smillertgetopts("aeu", \%Opt);
10*b39c5158Smillertmy %Chartab;
11*b39c5158Smillert
12*b39c5158Smillertmy $Hex = '[0-9A-Fa-f]';
13*b39c5158Smillertwhile(<>){
14*b39c5158Smillert    chomp;
15*b39c5158Smillert    my ($uni, $enc, $fb) =
16*b39c5158Smillert        /^<U($Hex+)>\s+(\S+)\s+\|(\d)/o or next;
17*b39c5158Smillert    $fb eq '0' or next;
18*b39c5158Smillert    my @byte = ();
19*b39c5158Smillert    my $ord = 0;
20*b39c5158Smillert    while($enc =~ /\G\\x($Hex+)/iog){
21*b39c5158Smillert        my $byte = hex($1);
22*b39c5158Smillert        push @byte, $byte;
23*b39c5158Smillert        $ord <<= 8; $ord += $byte;
24*b39c5158Smillert    };
25*b39c5158Smillert    # print join('', @byte), " => $ord \n";
26*b39c5158Smillert    if ($Opt{u}){
27*b39c5158Smillert        $Chartab{$ord} = pack("U", hex($uni));
28*b39c5158Smillert    }else{
29*b39c5158Smillert        $Chartab{$ord} = pack("C*", @byte);
30*b39c5158Smillert    }
31*b39c5158Smillert}
32*b39c5158Smillert
33*b39c5158Smillertmy $start = $Opt{a} ? 0x20 : 0xa0;
34*b39c5158Smillert
35*b39c5158Smillertfor (my $x = $start; $x <= 0xffff; $x += 32) {
36*b39c5158Smillert    my $line =  '';
37*b39c5158Smillert    for my $i (0..31){
38*b39c5158Smillert    my $num = $x+$i; $num eq 0x7f and next; # skip delete
39*b39c5158Smillert    my $char = $Chartab{$num};
40*b39c5158Smillert    $line .= !$char ? " " :
41*b39c5158Smillert        ($num < 0x7f ) ? " $char" : $char ;
42*b39c5158Smillert    }
43*b39c5158Smillert    $line =~ /^\s+$/o and next;
44*b39c5158Smillert    printf "0x%04x: $line\n", $x;
45*b39c5158Smillert}
46