ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/kgsueme/doc/doc2perl.xsl
Revision: 1.2
Committed: Fri Jul 25 22:35:50 2003 UTC (20 years, 10 months ago) by pcg
Content type: application/xml
Branch: MAIN
Changes since 1.1: +0 -4 lines
Log Message:
*** empty log message ***

File Contents

# Content
1 <!DOCTYPE xsl:stylesheet>
2 <xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
3
4 <xsl:output method="text" media-type="text/plain" encoding="utf-8"/>
5
6 <xsl:template match="/"><![CDATA[
7 # This is an automatically generated file.
8 # This is an automatically generated file.
9 # This is an automatically generated file.
10 # This is an automatically generated file.
11 # This is an automatically generated file.
12
13 # See doc/protocol.xml and doc/doc2messages.xsl
14
15 package KGS::Messages;
16
17 use KGS::Constants; # REPLACE by parsed file, too
18
19 use strict;
20
21 our %type;
22
23 our %dec_client; # decode messages send to server
24 our %enc_client; # encode messages send to server
25 our %dec_server; # decode messages received from server
26 our %enc_server; # encode messages received from server
27
28 {
29
30 my $data; # stores currently processed decoding/encoding packet
31
32 # primitive enc/decoders
33
34 #############################################################################
35
36 sub dec_U8 {
37 (my ($r), $data) = unpack "C a*", $data; $r;
38 }
39
40 sub dec_U16 {
41 (my ($r), $data) = unpack "v a*", $data; $r;
42 }
43
44 sub dec_U32 {
45 (my ($r), $data) = unpack "V a*", $data; $r;
46 }
47
48 sub dec_U64 {
49 my ($lo, $hi) = (dec_U32, dec_U32);
50 $lo + $hi * 2**32;
51 }
52
53 sub dec_I8 {
54 (my ($r), $data) = unpack "c a*", $data;
55 $r;
56 }
57
58 sub dec_I16 {
59 (my ($r), $data) = unpack "v a*", $data;
60 unpack "s", pack "S", $r;
61 }
62
63 sub dec_I32 {
64 (my ($r), $data) = unpack "V a*", $data;
65 unpack "i", pack "I", $r;
66 }
67
68 sub dec_DATA {
69 (my ($r), $data) = ($data, ""); $r;
70 }
71
72 sub dec_STRING {
73 $data =~ s/^((?:..)*?)(?:\x00\x00|\Z)//s;
74 # use Encode...
75 join "", map chr, unpack "v*", $1;
76 }
77
78 sub dec_CONSTANT {
79 $_[0];
80 }
81
82 sub dec_password {
83 dec_U64;
84 }
85
86 sub dec_HEX { # for debugging
87 "HEX: " . unpack "H*", $data;#d#
88 }
89
90 #############################################################################
91
92 sub enc_U8 {
93 $data .= pack "C", $_[0];
94 }
95
96 sub enc_U16 {
97 $data .= pack "v", $_[0];
98 }
99
100 sub enc_U32 {
101 $data .= pack "V", $_[0];
102 }
103
104 sub enc_U64 {
105 enc_U32 $_[0] & 0xffffffff;
106 enc_U32 +($_[0] >> 32) & 0xffffffff;
107 }
108
109 sub enc_I8 {
110 $data .= pack "c", $_[0];
111 }
112
113 sub enc_I16 {
114 enc_U16 unpack "S", pack "s", $_[0];
115 }
116
117 sub enc_I32 {
118 enc_U32 unpack "I", pack "i", $_[0];
119 }
120
121 sub enc_DATA {
122 # a dream!
123 $data .= $_[0];
124 }
125
126 sub enc_STRING {
127 # should use encode for speed and clarity ;)
128 $data .= pack "v*", map ord, split //, $_[0];
129 }
130
131 sub enc_CONSTANT {
132 # nop
133 }
134
135 sub enc_password {
136 require Math::BigInt; # I insist on 32-bit-perl.. should use C
137 # $hash must be 64 bit
138 my $hash = new Math::BigInt;
139 $hash = $hash * 1055 + ord for split //, $_[0];
140 enc_U64 $hash;
141 }
142
143 sub enc_HEX {
144 die "enc_HEX not defined for good";
145 }
146
147 ]]>
148
149 #############################################################################
150 # types
151 <xsl:apply-templates select="descendant::type"/>
152
153 #############################################################################
154 # structures
155 <xsl:apply-templates select="descendant::struct"/>
156
157 #############################################################################
158 # "less" primitive types<![CDATA[
159
160 # this was the most horrible thing to decode. still not everything is decoded correctly(?)
161 sub dec_TREE {
162 my @r;
163 while (length $data) {
164 my $type = dec_U8;
165 my $add = $type < 128;
166
167 $type &= 127;
168
169 if ($type == 127) {
170 dec_U8; # unused?? *sigh*
171 push @r, [add_node => dec_I32];
172
173 } elsif ($type == 126) {
174 push @r, [set_node => dec_I32];
175
176 } elsif ($type == 125) {
177 push @r, [set_current => dec_I32];
178
179 } elsif ($type == 34) {
180 push @r, [score => dec_U8, dec_score1000];
181
182 } elsif ($type == 29) {
183 push @r, [type_29 => dec_STRING];
184 warn "TYPE 29 $r[-1][1]\007 PLEASE REPORT";#d#
185 die;
186
187 } elsif ($type == 28) {
188 # move number, only in variations it seems. oh my.
189 push @r, [movenum => dec_STRING];
190
191 } elsif ($type == 25) {
192 push @r, [result => dec_result];
193
194 } elsif ($type == 23) {
195 push @r, [mark => $add, MARK_GRAYED, dec_U8, dec_U8];
196
197 } elsif ($type == 22) {
198 push @r, [mark => $add, (&dec_U8 ? MARK_SMALL_W : MARK_SMALL_B), dec_U8, dec_U8];
199
200 } elsif ($type == 21) {
201 push @r, [mark => $add, MARK_CIRCLE, dec_U8, dec_U8];
202
203 } elsif ($type == 20) {
204 push @r, [mark => $add, MARK_SQUARE, dec_U8, dec_U8];
205
206 } elsif ($type == 19) {
207 push @r, [mark => $add, MARK_TRIANGLE, dec_U8, dec_U8];
208
209 } elsif ($type == 18) {
210 push @r, [mark => $add, MARK_LABEL, dec_U8, dec_U8, dec_STRING];
211
212 } elsif ($type == 17) {
213 push @r, [set_timer => (dec_U8, dec_U32, dec_time)[0,2,1]];
214
215 } elsif ($type == 16) {
216 push @r, [set_stone => $add, dec_U8, dec_U8, dec_U8];
217
218 } elsif ($type == 14) {
219 push @r, [move => $add, dec_U8, dec_U8, dec_U8];
220
221 } elsif (($type >= 4 && $type <= 9)
222 || ($type >= 11 && $type <= 13)
223 || $type == 24) {
224
225 push @r, [({
226 4 => "date",
227 5 => "unknown_comment5",
228 6 => "unknown_comment6",
229 7 => "unknown_comment7",
230 8 => "unknown_comment8",
231 9 => "copyright", #?
232 11 => "unknown_comment11",
233 12 => "unknown_comment12",
234 13 => "unknown_comment13",
235 24 => "comment",
236 })->{$type} => dec_STRING];
237
238 } elsif ($type == 3) {
239 push @r, [rank => dec_U8, dec_U32];
240
241 } elsif ($type == 2) {
242 push @r, [player => dec_U8, dec_STRING];
243
244 } elsif ($type == 0) {
245 # as usual, wms finds yet another way to duplicate code... oh well, what a mess.
246 # (no wonder he is so keen on keeping it a secret...)
247
248 push @r, [rules => dec_rules];
249
250 # OLD
251
252 } else {
253 print STDERR KGS::Listener::Debug::dumpval(\@r);
254 open XTYPE, "|xtype"; print XTYPE $data; close XTYPE;
255 die "unknown tree type $type, PLEASE REPORT and include the game you wanted to watch. thx.";
256
257 }
258 }
259 \@r;
260 }
261
262 sub enc_TREE {
263 for (@{$_[0]}) {
264 my ($type, @arg) = @$_;
265
266 if ($type eq "add_node") {
267 enc_U8 127;
268 enc_U8 0; # unused?
269 enc_I32 $arg[0];
270
271 } elsif ($type eq "set_node") {
272 enc_U8 126;
273 enc_I32 $arg[0];
274
275 } elsif ($type eq "set_current") {
276 enc_U8 125;
277 enc_I32 $arg[0];
278
279 } elsif ($type eq "movenum") {
280 enc_U8 28;
281 enc_STRING $arg[0];
282
283 } elsif ($type eq "set_stone") {
284 enc_U8 16 + ($arg[0] && 128);
285 enc_U8 $arg[1];
286 enc_U8 $arg[2];
287 enc_U8 $arg[3];
288
289 } elsif ($type eq "move") {
290 enc_U8 14 + ($arg[0] && 128);
291 enc_U8 $arg[1];
292 enc_U8 $arg[2];
293 enc_U8 $arg[3];
294
295 } elsif ($type eq "comment") {
296 enc_U8 24;
297 enc_STRING $arg[0];
298
299 } else {
300 warn "unable to encode tree node type $type\n";
301 }
302 }
303 }
304 ]]>
305
306 #############################################################################
307 # messages
308 <xsl:apply-templates select="descendant::message"/>
309 }
310
311 1;
312 </xsl:template>
313
314 <xsl:template match="type[@type = 'S']">
315 sub dec_<xsl:value-of select="@name"/> {
316 my $res = "";
317 my @r = unpack "v<xsl:value-of select="@length"/> a*", $data;
318 $data = pop @r;
319 for (@r) {
320 last unless $_;
321 $res .= chr $_;
322 }
323 # dump extra data to file for later analysis
324 #my $x = pack "v*", @r; $x =~ s/^(..)*?\x00\x00//s; open DUMP, ">>/tmp/dump"; print DUMP $x; close DUMP;#d#
325 $res;
326 }
327
328 sub enc_<xsl:value-of select="@name"/> {
329 $data .= pack "v<xsl:value-of select="@length"/>", map ord, split //, $_[0];
330 }
331 </xsl:template>
332
333 <xsl:template match="type[@type = 'A']">
334 sub dec_<xsl:value-of select="@name"/> {
335 (my ($r), $data) = unpack "Z<xsl:value-of select="@length"/> a*", $data; $r;
336 }
337
338 sub enc_<xsl:value-of select="@name"/> {
339 $data .= pack "Z<xsl:value-of select="@length"/>", $_[0];
340 }
341 </xsl:template>
342
343 <xsl:template match="type[@multiplier]">
344 sub dec_<xsl:value-of select="@name"/> {
345 (1 / <xsl:value-of select="@multiplier"/>) * dec_<xsl:value-of select="@type"/>;
346 }
347
348 sub enc_<xsl:value-of select="@name"/> {
349 enc_<xsl:value-of select="@type"/> $_[0] * <xsl:value-of select="@multiplier"/>;
350 }
351 </xsl:template>
352
353 <xsl:template match="member[@array = 'yes']" mode="dec">
354 $r->{<xsl:value-of select="@name"/>} = (my $array = []);
355 while (length $data) {
356 push @$array, dec_<xsl:value-of select="@type"/>
357 <xsl:text> </xsl:text>
358 <xsl:value-of select="@default"/>;
359 }
360 </xsl:template>
361
362 <xsl:template match="member" mode="dec">
363 $r->{<xsl:value-of select="@name"/>} = dec_<xsl:value-of select="@type"/>
364 <xsl:text> </xsl:text>
365 <xsl:value-of select="@default"/>
366 <xsl:if test="@guard-cond">
367 if ($r->{<xsl:value-of select="@guard-member"/>} <xsl:value-of select="@guard-cond"/>)</xsl:if>
368 <xsl:text>;</xsl:text>
369 </xsl:template>
370
371 <xsl:template match="member" mode="enc">
372 enc_<xsl:value-of select="@type"/> defined $_[0]{<xsl:value-of select="@name"/>} ? $_[0]{<xsl:value-of select="@name"/>
373 <xsl:text>} : (</xsl:text>
374 <xsl:value-of select="@default"/>
375 <xsl:text>);</xsl:text>
376 </xsl:template>
377
378 <xsl:template match="struct">
379 sub dec_<xsl:value-of select="@name"/> {
380 my $r = {};
381 <xsl:apply-templates select="member" mode="dec"/>
382 <xsl:if test="@class">
383 bless $r, <xsl:value-of select="@class"/>::;
384 </xsl:if>
385 $r;
386 }
387
388 sub enc_<xsl:value-of select="@name"/> {
389 <xsl:apply-templates select="member" mode="enc"/>
390 }
391 </xsl:template>
392
393 <xsl:template match="message">
394 # <xsl:value-of select="@name"/>
395 $dec_<xsl:value-of select="@src"/>{0x<xsl:value-of select="@type"/>} = sub {
396 $data = $_[0];
397 my $r;
398 $r->{type} = "<xsl:value-of select="@name"/>";
399 <xsl:apply-templates select="member" mode="dec"/>
400 $r;
401 };
402 $enc_<xsl:value-of select="@src"/>{<xsl:value-of select="@name"/>} = sub {
403 $data = "";
404 enc_U16 0x<xsl:value-of select="@type"/>;
405 <xsl:apply-templates select="member" mode="enc"/>
406 $data;
407 };
408 </xsl:template>
409
410 <xsl:template match="member">
411 [<xsl:value-of select="@name"/>
412 <xsl:text>=> "</xsl:text>
413 <xsl:value-of select="@type"/>
414 <xsl:text>", "</xsl:text>
415 <xsl:value-of select="@default"/>
416 <xsl:text>", "</xsl:text>
417 <xsl:value-of select="@guard"/>
418 <xsl:text>;"],</xsl:text>
419 </xsl:template>
420
421 <xsl:template match="text()">
422 </xsl:template>
423
424 </xsl:stylesheet>
425