ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/kgsueme/doc/doc2messages.xsl
Revision: 1.7
Committed: Fri Jun 13 22:11:50 2003 UTC (20 years, 11 months ago) by pcg
Content type: application/xml
Branch: MAIN
Changes since 1.6: +9 -0 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 pcg 1.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 pcg 1.2 <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 pcg 1.1 package KGS::Messages;
16    
17 pcg 1.5 use KGS::Constants; # REPLACE by parsed file, too
18    
19 pcg 1.2 use strict;
20    
21     our %type;
22     our %send;
23     our %recv;
24    
25 pcg 1.1 {
26 pcg 1.2
27     my $data; # stores currently processed decoding/encoding packet
28    
29     # primitive enc/decoders
30    
31     #############################################################################
32    
33     sub dec_U8 {
34     (my ($r), $data) = unpack "C a*", $data; $r;
35     }
36    
37     sub dec_U16 {
38     (my ($r), $data) = unpack "v a*", $data; $r;
39     }
40    
41     sub dec_U32 {
42     (my ($r), $data) = unpack "V a*", $data; $r;
43     }
44    
45     sub dec_U64 {
46     my ($lo, $hi) = (dec_U32, dec_U32);
47     $lo + $hi * 2**32;
48     }
49    
50     sub dec_I8 {
51     (my ($r), $data) = unpack "c a*", $data;
52     $r;
53     }
54    
55     sub dec_I16 {
56     (my ($r), $data) = unpack "v a*", $data;
57     unpack "s", pack "S", $r;
58     }
59    
60     sub dec_I32 {
61     (my ($r), $data) = unpack "V a*", $data;
62     unpack "i", pack "I", $r;
63     }
64    
65     sub dec_DATA {
66     (my ($r), $data) = ($data, ""); $r;
67     }
68    
69     sub dec_STRING {
70     $data =~ s/^((?:..)*?)(?:\x00\x00|\Z)//s;
71     # use Encode...
72     join "", map chr, unpack "v*", $1;
73     }
74    
75     sub dec_CONSTANT {
76     $_[0];
77     }
78    
79     sub dec_HEX { # for debugging
80     "HEX: " . unpack "H*", $data;#d#
81     }
82    
83     sub enc_HEX {
84     die "enc_HEX not defined for good";
85     }
86    
87     #############################################################################
88    
89     sub enc_U8 {
90     $data .= pack "C", $_[0];
91     }
92    
93     sub enc_U16 {
94     $data .= pack "v", $_[0];
95     }
96    
97     sub enc_U32 {
98     $data .= pack "V", $_[0];
99     }
100    
101     sub enc_U64 {
102     enc_U32 $_[0] & 0xffffffff;
103     enc_U32 +($_[0] >> 32) & 0xffffffff;
104     }
105    
106 pcg 1.6 sub enc_I16 {
107     enc_U16 unpack "S", pack "s", $_[0];
108     }
109    
110 pcg 1.2 sub enc_I32 {
111     enc_U32 unpack "I", pack "i", $_[0];
112     }
113    
114     sub enc_DATA {
115     # a dream!
116     $data .= $_[0];
117     }
118    
119     sub enc_STRING {
120     # should use encode for speed and clarity ;)
121     $data .= pack "v*", map ord, split //, $_[0];
122     }
123 pcg 1.7
124     sub 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 pcg 1.2 ]]>
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    
145     my %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    
156     my %code_marker = reverse %marker_code;
157    
158     # this was the most horrible thing to decode. still not everything is decoded correctly(?)
159     sub dec_TREE {
160     my @r;
161     while (length $data) {
162     my $type = dec_U8;
163    
164     if ($type == 255) {
165 pcg 1.3 push @r, [add_child => dec_I32];
166 pcg 1.2
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 pcg 1.4 push @r, [score => $type - 17, dec_score16];
203 pcg 1.2
204     } elsif ($type == 19) {
205 pcg 1.6 push @r, [result => dec_result]; # not certain
206 pcg 1.2
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    
241     sub enc_TREE {
242     for (@{$_[0]}) {
243     my ($type, @arg) = @$_;
244    
245     if ($type eq "add_child") {
246     enc_U8 255;
247 pcg 1.3 enc_I32 $arg[0];
248 pcg 1.2
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"/>
284 pcg 1.1 }
285    
286     1;
287     </xsl:template>
288    
289 pcg 1.2 <xsl:template match="type[@type = 'S']">
290     sub 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    
296     sub 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']">
302     sub dec_<xsl:value-of select="@name"/> {
303     (my ($r), $data) = unpack "Z<xsl:value-of select="@length"/> a*", $data; $r;
304     }
305    
306     sub 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]">
312     sub dec_<xsl:value-of select="@name"/> {
313     (1 / <xsl:value-of select="@multiplier"/>) * dec_<xsl:value-of select="@type"/>;
314     }
315    
316     sub 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    
354     <xsl:template match="struct">
355     sub dec_<xsl:value-of select="@name"/> {
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    
364     sub enc_<xsl:value-of select="@name"/> {
365     <xsl:apply-templates select="member" mode="enc"/>
366     }
367 pcg 1.1 </xsl:template>
368    
369     <xsl:template match="message">
370     # <xsl:value-of select="@name"/>
371 pcg 1.2 <xsl:if test="@recv='yes'">
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     };
379 pcg 1.1 </xsl:if>
380 pcg 1.2 <xsl:if test="@send='yes'">
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     };
387 pcg 1.1 </xsl:if>
388     </xsl:template>
389    
390     <xsl:template match="member">
391 pcg 1.2 [<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>
399     </xsl:template>
400 pcg 1.1
401     <xsl:template match="text()">
402     </xsl:template>
403    
404     </xsl:stylesheet>
405