ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/kgsueme/doc/doc2messages.xsl
(Generate patch)

Comparing kgsueme/doc/doc2messages.xsl (file contents):
Revision 1.1 by pcg, Wed Jun 4 19:12:51 2003 UTC vs.
Revision 1.7 by pcg, Fri Jun 13 22:11:50 2003 UTC

1<!DOCTYPE xsl:stylesheet> 1<!DOCTYPE xsl:stylesheet>
2<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform"> 2<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
3 3
4<xsl:output method="text" media-type="text/plain" encoding="utf-8"/> 4<xsl:output method="text" media-type="text/plain" encoding="utf-8"/>
5 5
6<xsl:template match="/"> 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
7package KGS::Messages; 15package KGS::Messages;
8 16
17use KGS::Constants; # REPLACE by parsed file, too
18
19use strict;
20
21our %type;
22our %send;
23our %recv;
24
9{ 25{
10<xsl:apply-templates/> 26
27my $data; # stores currently processed decoding/encoding packet
28
29# primitive enc/decoders
30
31#############################################################################
32
33sub dec_U8 {
34 (my ($r), $data) = unpack "C a*", $data; $r;
35}
36
37sub dec_U16 {
38 (my ($r), $data) = unpack "v a*", $data; $r;
39}
40
41sub dec_U32 {
42 (my ($r), $data) = unpack "V a*", $data; $r;
43}
44
45sub dec_U64 {
46 my ($lo, $hi) = (dec_U32, dec_U32);
47 $lo + $hi * 2**32;
48}
49
50sub dec_I8 {
51 (my ($r), $data) = unpack "c a*", $data;
52 $r;
53}
54
55sub dec_I16 {
56 (my ($r), $data) = unpack "v a*", $data;
57 unpack "s", pack "S", $r;
58}
59
60sub dec_I32 {
61 (my ($r), $data) = unpack "V a*", $data;
62 unpack "i", pack "I", $r;
63}
64
65sub dec_DATA {
66 (my ($r), $data) = ($data, ""); $r;
67}
68
69sub dec_STRING {
70 $data =~ s/^((?:..)*?)(?:\x00\x00|\Z)//s;
71 # use Encode...
72 join "", map chr, unpack "v*", $1;
73}
74
75sub dec_CONSTANT {
76 $_[0];
77}
78
79sub dec_HEX { # for debugging
80 "HEX: " . unpack "H*", $data;#d#
81}
82
83sub enc_HEX {
84 die "enc_HEX not defined for good";
85}
86
87#############################################################################
88
89sub enc_U8 {
90 $data .= pack "C", $_[0];
91}
92
93sub enc_U16 {
94 $data .= pack "v", $_[0];
95}
96
97sub enc_U32 {
98 $data .= pack "V", $_[0];
99}
100
101sub enc_U64 {
102 enc_U32 $_[0] & 0xffffffff;
103 enc_U32 +($_[0] >> 32) & 0xffffffff;
104}
105
106sub enc_I16 {
107 enc_U16 unpack "S", pack "s", $_[0];
108}
109
110sub enc_I32 {
111 enc_U32 unpack "I", pack "i", $_[0];
112}
113
114sub enc_DATA {
115 # a dream!
116 $data .= $_[0];
117}
118
119sub enc_STRING {
120 # should use encode for speed and clarity ;)
121 $data .= pack "v*", map ord, split //, $_[0];
122}
123
124sub enc_password {
125 require Math::BigInt; # I insist on 32-bit-perl.. should use C
126 # $hash must be 64 bit
127 my $hash = new Math::BigInt;
128 $hash = $hash * 1055 + ord for split //, $_[0];
129 enc_U64 $hash;
130}
131
132]]>
133
134#############################################################################
135# types
136<xsl:apply-templates select="descendant::type"/>
137
138#############################################################################
139# structures
140<xsl:apply-templates select="descendant::struct"/>
141
142#############################################################################
143# "less" primitive types<![CDATA[
144
145my %marker_code = (
146 triangle => 1,
147 square => 2,
148 circle => 3,
149 small_b => 4,
150 small_w => 5,
151 gray => 6,
152 move => 7,
153 addstone => 8,
154 );
155
156my %code_marker = reverse %marker_code;
157
158# this was the most horrible thing to decode. still not everything is decoded correctly(?)
159sub dec_TREE {
160 my @r;
161 while (length $data) {
162 my $type = dec_U8;
163
164 if ($type == 255) {
165 push @r, [add_child => dec_I32];
166
167 } elsif ($type == 254) {
168 push @r, ["done"];
169
170 } elsif ($type == 253) {
171 push @r, ["type253"];
172 # ????
173
174 } elsif ($type == 252) { # even less clear
175 push @r, ["more"];
176
177 } elsif ($type == 10) {
178 # as usual, wms finds yet another way to duplicate code... oh well, what a mess.
179 # (no wonder he is so keen on keeping it secret...)
180
181 push @r, [rules => dec_rules];
182
183 } elsif ($type == 9 || $type == 22 || $type == 25 || $type == 31 || $type == 32) {
184 push @r, [({
185 9 => "comment",
186 22 => "unknown_comment22",
187 25 => "copyright", #?
188 31 => "date",
189 32 => "unknown_comment32",
190 })->{$type} => dec_STRING];
191
192 } elsif ($type == 11 || $type == 12) {
193 push @r, [player => $type - 11, dec_STRING];
194
195 } elsif ($type == 13 || $type == 14) {
196 push @r, [rank => $type - 13, dec_U32];
197
198 } elsif ($type == 15 || $type == 16) {
199 push @r, [set_timer => $type - 15, dec_time, dec_U16];
200
201 } elsif ($type == 17 || $type == 18) {
202 push @r, [score => $type - 17, dec_score16];
203
204 } elsif ($type == 19) {
205 push @r, [result => dec_result]; # not certain
206
207 } elsif ($type == 30) {
208 push @r, [active_player => dec_U8];
209
210 } elsif ($type == 0) { # label(?)
211 my $label;
212 my $c = dec_U16; $label .= chr $c if $c;
213 my $c = dec_U16; $label .= chr $c if $c;
214 my $c = dec_U16; $label .= chr $c if $c;
215
216 # empty label == remove label
217 push @r, [label => $label, dec_U8, dec_U8];
218
219 } elsif ($type > 0 && $type < 9) {
220 # 1 marker type triangle
221 # 2 marker type square
222 # 3 marker type circle
223 # 4 small stone b
224 # 5 small stone w
225 # 6 grayed out
226 # 7 move
227 # 8 also move(?) or preset?
228 #
229 # $a1 is probably player again (2 == remove)
230 # x is from left 0 to right boardsize-1
231 # y is from top 0 to bottom boardsize-1
232 push @r, [$code_marker{$type} => dec_U8, dec_U8, dec_U8];
233
234 } else {
235 push @r, [unknown => $type];
236 }
237 }
238 \@r;
239}
240
241sub enc_TREE {
242 for (@{$_[0]}) {
243 my ($type, @arg) = @$_;
244
245 if ($type eq "add_child") {
246 enc_U8 255;
247 enc_I32 $arg[0];
248
249 } elsif ($type eq "done") {
250 enc_U8 254;
251
252 } elsif ($type eq "more") {
253 enc_U8 253;
254
255 } elsif ($type eq "comment") {
256 # handle other string params, too
257 enc_U8 9;
258 enc_STRING $arg[0];
259
260 } elsif ($type eq "label") {
261 enc_U8 0;
262 enc_U16 ord substr "$arg[0]\x00\x00", 0, 1;
263 enc_U16 ord substr "$arg[0]\x00\x00", 1, 1;
264 enc_U16 ord substr "$arg[0]\x00\x00", 2, 1;
265 enc_U8 $arg[1];
266 enc_U8 $arg[2];
267
268 } elsif ($marker_code{$type}) {
269 enc_U8 $marker_code{$type};
270 enc_U8 $arg[0];
271 enc_U8 $arg[1];
272 enc_U8 $arg[2];
273
274 } else {
275 warn "unable to encode tree node type $type\n";
276 }
277 }
278}
279]]>
280
281#############################################################################
282# messages
283<xsl:apply-templates select="descendant::message"/>
11} 284}
12 285
131; 2861;
14</xsl:template> 287</xsl:template>
15 288
289<xsl:template match="type[@type = 'S']">
290sub dec_<xsl:value-of select="@name"/> {
291 my @r = unpack "v<xsl:value-of select="@length"/> a*", $data;
292 $data = pop @r;
293 join ":", map chr, @r;
294}
295
296sub enc_<xsl:value-of select="@name"/> {
297 $data .= pack "v<xsl:value-of select="@length"/>", map ord, split //, $_[0];
298}
299</xsl:template>
300
301<xsl:template match="type[@type = 'A']">
302sub dec_<xsl:value-of select="@name"/> {
303 (my ($r), $data) = unpack "Z<xsl:value-of select="@length"/> a*", $data; $r;
304}
305
306sub enc_<xsl:value-of select="@name"/> {
307 $data .= pack "Z<xsl:value-of select="@length"/>", $_[0];
308}
309</xsl:template>
310
311<xsl:template match="type[@multiplier]">
312sub dec_<xsl:value-of select="@name"/> {
313 (1 / <xsl:value-of select="@multiplier"/>) * dec_<xsl:value-of select="@type"/>;
314}
315
316sub enc_<xsl:value-of select="@name"/> {
317 enc_<xsl:value-of select="@type"/> $_[0] * <xsl:value-of select="@multiplier"/>;
318}
319</xsl:template>
320
321<xsl:template match="member[@array = 'yes']" mode="dec">
322 $r->{<xsl:value-of select="@name"/>} = (my $array = []);
323 while (length $data) {
324 push @$array, dec_<xsl:value-of select="@type"/>
325 <xsl:text> </xsl:text>
326 <xsl:value-of select="@default"/>;
327 }
328</xsl:template>
329
330<xsl:template match="member" mode="dec">
331 $r->{<xsl:value-of select="@name"/>} = dec_<xsl:value-of select="@type"/>
332 <xsl:text> </xsl:text>
333 <xsl:value-of select="@default"/>
334 <xsl:if test="@guard-cond">
335 if ($r->{<xsl:value-of select="@guard-member"/>} <xsl:value-of select="@guard-cond"/>)</xsl:if>
336 <xsl:text>;</xsl:text>
337</xsl:template>
338
339<xsl:template match="member" mode="enc">
340 <!-- #d#, remove when kgs is repaired --><xsl:if test="@type = 'username'">
341 $_[0]{<xsl:value-of select="@name"/>} =~ /^[A-Za-z][A-Za-z0-9]{0,11}$/
342 or Carp::confess "FATAL: tried to send illegal username '$_[0]{<xsl:value-of select="@name"/>}'";
343 </xsl:if><!--#d#-->
344 <!-- #d#, remove when kgs is repaired --><xsl:if test="@name = 'channel'">
345 $_[0]{<xsl:value-of select="@name"/>} > 0
346 or Carp::confess "FATAL: tried to send a zero channel id";
347 </xsl:if><!--#d#-->
348 enc_<xsl:value-of select="@type"/> defined $_[0]{<xsl:value-of select="@name"/>} ? $_[0]{<xsl:value-of select="@name"/>
349 <xsl:text>} : (</xsl:text>
350 <xsl:value-of select="@default"/>
351 <xsl:text>);</xsl:text>
352</xsl:template>
353
16<xsl:template match="macro"> 354<xsl:template match="struct">
17$macro{<xsl:value-of select="@name"/>} = [<xsl:apply-templates/> 355sub dec_<xsl:value-of select="@name"/> {
18]; 356 my $r = {};
357 <xsl:apply-templates select="member" mode="dec"/>
358 <xsl:if test="@class">
359 bless $r, <xsl:value-of select="@class"/>::;
360 </xsl:if>
361 $r;
362}
363
364sub enc_<xsl:value-of select="@name"/> {
365 <xsl:apply-templates select="member" mode="enc"/>
366}
19</xsl:template> 367</xsl:template>
20 368
21<xsl:template match="message"> 369<xsl:template match="message">
22# <xsl:value-of select="@name"/> 370# <xsl:value-of select="@name"/>
23my $msg = [<xsl:apply-templates/>
24];<xsl:if test="@send='yes'"> 371<xsl:if test="@recv='yes'">
25$send{<xsl:value-of select="@name"/>} = [ 0x<xsl:value-of select="@type"/>, $msg ]; 372$recv{0x<xsl:value-of select="@type"/>} = sub {
373 $data = $_[0];
374 my $r;
375 $r->{type} = "<xsl:value-of select="@name"/>";
376 <xsl:apply-templates select="member" mode="dec"/>
377 $r;
378};
26</xsl:if> 379</xsl:if>
27<xsl:if test="@recv='yes'"> 380<xsl:if test="@send='yes'">
28$recv{0x<xsl:value-of select="@type"/>} = [ <xsl:value-of select="@name"/> => $msg ]; 381$send{<xsl:value-of select="@name"/>} = sub {
382 $data = "";
383 enc_U16 0x<xsl:value-of select="@type"/>;
384 <xsl:apply-templates select="member" mode="enc"/>
385 $data;
386};
29</xsl:if> 387</xsl:if>
30</xsl:template> 388</xsl:template>
31 389
32<xsl:template match="member"> 390<xsl:template match="member">
33 [<xsl:value-of select="@name"/> => "<xsl:value-of select="@type"/>", "<xsl:value-of select="@default"/>", "<xsl:value-of select="@guard"/>"],<!-- 391 [<xsl:value-of select="@name"/>
392 <xsl:text>=> "</xsl:text>
393 <xsl:value-of select="@type"/>
394 <xsl:text>", "</xsl:text>
395 <xsl:value-of select="@default"/>
396 <xsl:text>", "</xsl:text>
397 <xsl:value-of select="@guard"/>
398 <xsl:text>;"],</xsl:text>
34--></xsl:template> 399</xsl:template>
35 400
36<xsl:template match="text()"> 401<xsl:template match="text()">
37</xsl:template> 402</xsl:template>
38 403
39</xsl:stylesheet> 404</xsl:stylesheet>

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines