ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Games-Go-SGF-Grove/Grove.pm
(Generate patch)

Comparing Games-Go-SGF-Grove/Grove.pm (file contents):
Revision 1.2 by root, Sun Jul 20 19:39:48 2008 UTC vs.
Revision 1.3 by root, Sun Jul 20 19:54:00 2008 UTC

… …
60 60
61=cut 61=cut
62 62
63sub decode_sgf($) { 63sub decode_sgf($) {
64 my ($sgf_data) = @_; 64 my ($sgf_data) = @_;
65
66 Games::Go::SGF::Grove::Parser::->new->parse ($sgf_data)
65} 67}
66 68
67sub encode_sgf($) { 69sub encode_sgf($) {
68 my ($game) = @_; 70 my ($game) = @_;
69} 71}
… …
73 75
74 open my $fh, "<:perlio", $path 76 open my $fh, "<:perlio", $path
75 or die "$path: $!"; 77 or die "$path: $!";
76 78
77 local $/; 79 local $/;
78 decode_sgf <$path> 80 decode_sgf <$fh>
79} 81}
80 82
81sub save_sgf($$) { 83sub save_sgf($$) {
82 my ($path, $game) = @_; 84 my ($path, $game) = @_;
83 85
… …
92=head2 The Game Data structure 94=head2 The Game Data structure
93 95
94The SGF game is represented by a linked Perl data structure consisting of 96The SGF game is represented by a linked Perl data structure consisting of
95unblessed hashes and arrays. 97unblessed hashes and arrays.
96 98
97The game itself is a hash reference 99The game itself is a hash reference #TODO#
98 100
99=cut 101=cut
100 102
101 103
102package Games::Go::SGF::Grove::Parser; 104package Games::Go::SGF::Grove::Parser;
103 105
104no warnings; 106no warnings;
105use strict; 107use strict;
106
107use Carp qw(croak);
108 108
109my $ws = qr{[\x00-\x20]*}s; 109my $ws = qr{[\x00-\x20]*}s;
110my $property; # property => propertyinfo 110my $property; # property => propertyinfo
111 111
112sub new { 112sub new {
… …
191 push @{$node->{$name}}, @val 191 push @{$node->{$name}}, @val
192 } else { 192 } else {
193 $node->{$name} = $val[0]; 193 $node->{$name} = $val[0];
194 } 194 }
195 } else { 195 } else {
196 warn "unknown property '$name', will be saved unchanged."; 196 #warn "unknown property '$name', will be saved unchanged.";#d#
197 $node->{$name} = $value; 197 $node->{$name} = $value;
198 } 198 }
199 } 199 }
200 } 200 }
201 } 201 }
… …
224 224
225=cut 225=cut
226 226
227 227
228{ 228{
229 use Encode ();
230
229 my ($group, $name, $value, $prop); 231 my ($group, $name, $value, $prop);
230 232
231 my (%char2coord, %coord2char); 233 my (%char2coord, %coord2char);
232 234
233 { 235 {
… …
236 $char2coord{ $coord[$_] } = $_; 238 $char2coord{ $coord[$_] } = $_;
237 $coord2char{ $_ } = $coord[$_]; 239 $coord2char{ $_ } = $coord[$_];
238 } 240 }
239 } 241 }
240 242
243 sub _parsetype($);
241 sub _parsetype { 244 sub _parsetype {
242 for (shift) { 245 for (shift) {
243 if (s/e?list of //) { 246 if (s/e?list of //) {
244 $prop->{is_list} = 1; 247 $prop->{is_list} = 1;
245 return _parsetype($_); 248 return _parsetype $_;
246 } elsif (s/composed (\S+)\s+(?:':'\s+)?(\S+)//) { 249 } elsif (s/composed (\S+)\s+(?:':'\s+)?(\S+)//) {
247 my ($i, $o) = ($1, $2); 250 my ($i, $o) = ($1, $2);
248 my ($i1, $o1, $i2, $o2) = (_parsetype($i), _parsetype($o)); 251 my ($i1, $o1, $i2, $o2) = (_parsetype $i, _parsetype $o);
249 return ( 252 return (
250 sub { 253 sub {
251 if ($_[1] =~ /^((?:[^\\:]+|\\.)*)(?::(.*))$/s) { 254 if ($_[1] =~ /^((?:[^\\:]+|\\.)*)(?::(.*))$/s) {
252 # or $_[0]->error ("'Compose' ($i:$o) expected, got '$_[1]'"); 255 # or $_[0]->error ("'Compose' ($i:$o) expected, got '$_[1]'");
253 my ($l, $r) = ($1, $2); 256 my ($l, $r) = ($1, $2);
254 257
258 warn "$i1,$o1,$i2,$o2 ($i,$o)\n";#d#
255 [ 259 [
256 $i1->($_[0], $l), 260 $i1->($_[0], $l),
257 defined $r ? $i2->($_[0], $r) : undef, 261 defined $r ? $i2->($_[0], $r) : undef,
258 ], 262 ],
259 } else { 263 } else {
260 # yes, this is not according to standard, but lets handle it somehow anyway 264 # yes, this is not according to standard, but let's handle it somehow anyway
261 [ $i1->($_[0], $l) ] 265 #[ $i1->($_[0], $l) ] #d# #TODO#
262 } 266 }
263 }, 267 },
264 sub { 268 sub {
265 $o1->($_[0], $_[1][0]) 269 $o1->($_[0], $_[1][0])
266 . (defined $_[1][1] 270 . (defined $_[1][1]
… …
270 ); 274 );
271 } elsif (s/double//) { 275 } elsif (s/double//) {
272 return ( 276 return (
273 sub { 277 sub {
274 $_[1] =~ /^[12]$/ 278 $_[1] =~ /^[12]$/
275 or croak "'Double' (1|2) expected, got '$_[1]'"; 279 or $_[0]->error ("'Double' (1|2) expected, got '$_[1]'");
276 $_[1] 280 $_[1]
277 }, 281 },
278 sub { 282 sub {
279 $_[1] 283 $_[1]
280 }, 284 },
281 ); 285 );
282 } elsif (s/color//) { 286 } elsif (s/color//) {
283 return ( 287 return (
284 sub { 288 sub {
285 $_[1] =~ /^[BW]$/i 289 $_[1] =~ /^[BW]$/i
286 or croak "'Color' (B|W) expected, got '$_[1]'"; 290 or $_[0]->error ("'Color' (B|W) expected, got '$_[1]'");
287 lc $_[1] 291 lc $_[1]
288 }, 292 },
289 sub { 293 sub {
290 uc $_[1] 294 uc $_[1]
291 }, 295 },
292 ); 296 );
293 } elsif (s/none//) { 297 } elsif (s/none//) {
294 return ( 298 return (
295 sub { 299 sub {
296 $_[1] =~ /^$/i 300 $_[1] =~ /^$/i
297 or croak "'None' expected, got '$_[1]'"; 301 or $_[0]->error ("'None' expected, got '$_[1]'");
298 undef 302 undef
299 }, 303 },
300 sub { 304 sub {
301 "", 305 "",
302 }, 306 },
… …
328 ); 332 );
329 } elsif (s/real//) { 333 } elsif (s/real//) {
330 return ( 334 return (
331 sub { 335 sub {
332 $_[1] =~ /^[+-]?[0-9]*\.?[0-9]*$/i 336 $_[1] =~ /^[+-]?[0-9]*\.?[0-9]*$/i
333 or croak "'Real' expected, got '$_[1]'"; 337 or $_[0]->error ("'Real' expected, got '$_[1]'");
334 $_[1]+0, 338 $_[1]+0,
335 }, 339 },
336 sub { 340 sub {
337 $_[1]+0, 341 $_[1]+0,
338 }, 342 },
339 ); 343 );
340 } elsif (s/number//) { 344 } elsif (s/number//) {
341 return ( 345 return (
342 sub { 346 sub {
343 $_[1] =~ /^[+-]?[0-9]*$/i 347 $_[1] =~ /^[+-]?[0-9]*$/i
344 or croak "'Number' expected, got '$_[1]'"; 348 or $_[0]->error ("'Number' expected, got '$_[1]'");
345 $_[1]+0, 349 $_[1]+0,
346 }, 350 },
347 sub { 351 sub {
348 int $_[1], 352 int $_[1],
349 }, 353 },
350 ); 354 );
351 } elsif (s/text//) { 355 } elsif (s/text//) {
352 return ( 356 return (
353 sub { 357 sub {
354 $_[1], 358 warn "$_[0]{CA}<-CA\n";#d#
359 eval { Encode::decode $_[0]{CA}, $_[1] } || $_[1],
355 }, 360 },
356 sub { 361 sub {
357 die; 362 die;
358 }, 363 },
359 ); 364 );

Diff Legend

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