ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Net-Knuddels/util/dic2bin
Revision: 1.1
Committed: Sun Jan 9 23:31:49 2005 UTC (21 years, 9 months ago) by root
Branch: MAIN
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.1 #!/opt/bin/perl
2    
3     # use jcf-dump GroupChat.java and extract the longest constant string sans '"'
4    
5     use Encode;
6     use Data::Dumper;
7    
8     local $/;
9    
10     binmode STDIN;
11     binmode STDOUT, ":utf-8";
12    
13     my $dictionary = <>;
14    
15     $dictionary =~ s%
16     \\
17     (?: \\
18     | 0([0-9a-f]{2})
19     | u([0-9a-f]{4})
20     | ([rnt\x27\x22])
21     | (.)
22     )
23     %
24     if ($1 || $2) {
25     chr hex "$1$2";
26     } elsif ($3 eq "r") { "\015"
27     } elsif ($3 eq "n") { "\012"
28     } elsif ($3 eq "t") { "\011"
29     } elsif ($3 eq "'") { "'"
30     } elsif ($3 eq '"') { '"'
31     } elsif ($4) {
32     die "<<<$4>>>\n";
33     } else {
34     "\\";
35     }
36     %sgex;
37    
38     my ($idx, $bit) = (0, -32);
39    
40     while (length $dictionary) {
41     my $prefix = ord substr $dictionary, 0, 1, "";
42     $prefix = unpack "n", Encode::encode "iso-8859-1", substr $dictionary, 0, 2, "" if $prefix == 255;
43    
44     my ($len, $width) = (int $prefix / 21, $prefix % 21);
45     my $string = substr $dictionary, 0, $len + 1, "";
46    
47     # carry
48     while ($idx & 1) {
49     $idx >>= 1;
50     $bit--;
51     }
52    
53     $idx |= 1;
54     # widen
55     while ($bit < $width) {
56     $idx &= 0x7fffffff;
57     $idx <<= 1;
58     $bit++;
59     }
60    
61     my $code = reverse unpack "b$width", pack "V", $idx;
62     #$string =~ s/([^\x20-\x7e])/sprintf "\\x{%x}", ord $1/ge;
63    
64     $code{$code} = $string;
65     }
66    
67     print Data::Dumper->new([\%code])->Terse(1)->Useqq(1)->Quotekeys(1)->Sortkeys(1)->Dump;
68