ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Net-Knuddels/util/dic2bin
Revision: 1.4
Committed: Thu Jan 13 01:38:44 2005 UTC (21 years, 8 months ago) by root
Branch: MAIN
Changes since 1.3: +3 -0 lines
Log Message:
*** empty log message ***

File Contents

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