1############################################################ 2# 3# Chess:PGN::Parse - a parser for PGN games 4# 5# Copyright (c) 2002 by Giuseppe Maxia 6# Produced under the GPL (Golden Perl Laziness) 7# Distributed under the GPL (GNU General Public License) 8# 9############################################################ 10 11# StringHandle 12# Utility package to read input from string, imitating 13# a file handle. 14package StringHandle; 15use strict; 16use warnings; 17use overload 18 q{<>} => sub { 19 return shift @{$_[0]}; 20 }; 21 22sub new { 23 my $class = shift; 24 return bless [split /^/xm, $_[0]], $class; 25} 26sub close { } ## no critic 27 28package Chess::PGN::Parse; ## no critic 29use English qw( -no_match_vars ) ; 30 31require 5.006; 32use IO::File; 33 34require Exporter; 35 36our @ISA = qw(Exporter); 37our @EXPORT = qw(shrink_epd expand_epd STR NAG); 38our @EXPORT_OK = qw(); 39 40our $VERSION = '0.20'; # 23-Jan-2015 41 42=head1 NAME 43 44Chess::PGN::Parse - reads and parses PGN (Portable Game Notation) Chess files 45 46=head1 SYNOPSIS 47 48 use Chess::PGN::Parse; 49 use English qw( -no_match_vars ); 50 my $pgnfile = "kk_2001.pgn"; 51 my $pgn = new Chess::PGN::Parse $pgnfile 52 or die "can't open $pgnfile\n"; 53 while ($pgn->read_game()) { 54 print $pgn->white, ", " , $pgn->black, ", ", 55 $pgn->result, ", ", 56 $pgn->game, "\n"; 57 } 58 59 60 use Chess::PGN::Parse; 61 my $text =""; 62 { 63 local $INPUT_RECORD_SEPARATOR = undef; 64 open PGN "< $pgnfile" or die; 65 $text = <PGN>; 66 close $text; 67 } 68 # reads from string instead of a file 69 my $pgn = new Chess::PGN::Parse undef, $text; 70 while ($pgn->read_game()) { 71 print $pgn->white, ", " , $pgn->black, ", ", 72 $pgn->result, ", ", 73 $pgn->game, "\n"; 74 } 75 76 use Chess::PGN::Parse; 77 my $pgnfile = "kk_2001.pgn"; 78 my $pgn = new Chess::PGN::Parse $pgnfile 79 or die "can't open $pgnfile\n"; 80 my @games = $pgn->smart_read_all(); 81 82 83=head1 DESCRIPTION 84 85Chess::PGN::Parse offers a range of methods to read and manipulate Portable Game Notation files. 86PGN files contain chess games produced by chess programs following a standard format (http://www.schachprobleme.de/chessml/faq/pgn/). It is among the preferred means of chess games distribution. Being a public, well established standard, PGN is understood by many chess archive programs. 87Parsing simple PGN files is not difficult. However, dealing with some of the intricacies of the Standard is less than trivial. This module offers a clean handle toward reading and parsing complex PGN files. 88 89A PGN file has several B<tags>, which are key/values pairs at the header of each game, in the format 90 [key "value"] 91 92After the header, the game follows. A string of numbered chess moves, optionally interrupted by braced comments and recursive parenthesized variants and comments. While dealing with simple braced comments is straightforward, parsing nested comments can give you more than a headache. 93 94Chess::PGN::Parse most immediate methods are: 95 read_game() reads one game, separating the tags and the game text. 96 97 parse_game() parse the current game, and stores the moves into an 98 array and optionally saves the comments into an array of hashes 99 for furter usage. It can deal with nested comments and recursive 100 variations. 101 102 quick_parse_game() Same as the above, but doesn't save the comments, 103 which are just stripped from the text. It can't deal with nested 104 comments. Should be the preferred method when we know that we are 105 dealing with simple PGNs. 106 107 smart_parse_game() Best of the above methods. A preliminary check 108 will call parse_game() or quick_parse_game(), depending on the 109 presence of nested comments in the game. 110 111 read_all(), quick_read_all(), smart_read_all() will read all the records 112 in the current PGN file and return an array of hashes with all the 113 parsed details from the games. 114 115=head2 Parsing games 116 117Parsing PGN games is actually two actions: reading and parsing. 118The reading will only identify the two components of a game, i.e. 119the tags and the moves text. During this phase, the tags are 120decomposed and stored into an internal hash for future use, 121while the game text is left untouched. 122 123Reading a game is accomplished through the read_game() method, 124which will identify not only the standard game format but also 125some unorthodox cases, such as games with no separating blank line 126between tags and moves, games with no blank lines at the end of 127the moves, leading blank lines, tags spanning over several lines 128and some minor quibbles. 129If you know that your games don't have any of these problems, 130you might choose the read_standard_game() method, which is a 131bit faster. 132 133After the reading, you can either use the game text as it is, 134or you can ask for parsing. What is it? Parsing is the process 135of identifying and isolating the moves from the rest of the game 136text, such as comments and recursive variations. This process 137can be accomplished in two ways: using quick_parse_game(), the 138non moves elements are just stripped off and discarded, leaving 139an array of bare moves. If the comments and the recursive 140variations (RAV) are valuable to you, you can use the parse_game() 141method, which will strip the excess text, but it can store it 142into an appropriate data structure. Passing the option 143{save_comments =>'yes'} to parse_game(), game comments will 144be stored into a hash, having as key the move number + color. 145Multiple comments for the same move are appended to the previous 146one. If this structure doesn't provide enough details, a further 147option {comments_struct => 'array'} will store an array of 148comments for each move. Even more details are available using 149{comments_struct => 'hol'}, which will trigger the creation of 150a hash of lists (hol), where the key is the comment type (RAV, 151NAG, brace, semicolon, escaped) and the value is a list of 152homogeneous comments belonging to the same move. 153 154A further option {log_errors => 'yes'} will save the errors 155into a structure similar to the comments (no options on the 156format, though. All errors for one given move are just a 157string). What are errors? Just anything that is not recognized 158as any of the previous elements. Not a move, or a move number, 159or a comment, either text or recursive. Anything that the 160parser cannot actively classify as 'known' will be stored 161as error. 162 163=head2 Getting the parsed values 164 165At the end of the exercise, you can access the components 166through some standard methods. 167The standard tags have their direct access method (white, 168black, site, event, date, result, round). More methods give 169access to some commonly used elements: 170game() is the unparsed text, moves() returns an array of parsed 171moves, without move numbers, comments() and errors() return 172the relative structures after parsing. 173About game(), it's worth mentioning that, using quick_parse_game(), 174the game text is stripped of all non moves elements. This is 175an intended feature, to privilege speed. If you need to preserve 176the original game text after parsing, either copy it before 177calling quick_parse_game() or use parse_game() instead. 178 179=head2 Recursive Parsing 180 181PGN games may include RAV (Recursive Annotated Variations) which 182is just game text inside parentheses. 183This module can recognize RAV sequences and store them as comments. 184One of the things you can do with these sequences is to parse 185them again and get bare moves that you can feed to a chess engine 186or a move analyzer (Chess::PGN::EPD by H.S.Myers is one of them). 187Chess::PGN::Parse does not directly support recursive parsing of 188games, but it makes it possible. 189Parse a game, saving the comments as hash of list (see above), 190and then check for comments that are of 'RAV' type. For each 191entry in the comments array, strip the surrounding parentheses 192and create a new Chess::PGN::Parse object with that text. 193Easier to do than to describe, actually. For an example of this 194technique, check the file F<examples/test_recursive.pl>. 195 196=head2 EXPORT 197 198new, STR, read_game, tags, event, site, white, black, round, date, result, game , NAG, moves 199 200=head2 DEPENDENCIES 201 202IO::File 203 204=head1 Class methods 205 206=over 4 207 208=item new() 209 210Create a new Chess::PGN::Parse object (requires file name) 211 my $pgn = Chess::PGN::Parse->new "filename.pgn" 212 or die "no such file \n"; 213 214=cut 215 216my @seven_tags_roster = qw(Event Site Date Round White Black Result); 217 218sub new { 219 my $class = shift; 220 my $filename = shift; 221 my $fh = undef; 222 if (defined $filename) { 223 $fh = new IO::File "< $filename" 224 || return ; 225 } 226 else { 227 my $text = shift; 228 $fh = new StringHandle $text; 229 } 230 my $self = bless { 231 GameMoves =>[], # game moves 232 GameComments =>{}, # comments with reference to the move 233 gamedescr => {}, # will contain the PGN tags 234 GameErrors => {}, # will contain the parsing errors 235 fh => \$fh, # filehandle to the PGN file 236 # this is the memory between loops. The 237 # reading engine recognizes some elements 238 # one line after. 239 # For example, game text ends when we 240 # read tags from the input. At this moment, 241 # we have to return from the method, but 242 # we must keep in memory what we have last read. 243 # This structure will also take care of the 244 # tags spanning over several lines. 245 memory => { 246 tag => q{}, 247 utag => 0, # = unfinished tag 248 game => q{}, 249 tag_printed => 0, 250 game_printed => 0, 251 } 252 }, $class; 253 return $self; 254} 255 256=for internal use 257 the object destroyer cleans possible hanging references 258 259=cut 260 261sub DESTROY { 262 my $self = shift; 263 undef $self->{GameComments}; 264 undef $self->{GameErrors}; 265 undef $self->{gamedescr}; 266 undef $self->{GameMoves}; 267 eval { 268 #if (defined ${$self->{fh}}) { 269 ${$self->{fh}}->close(); 270 #} 271 }; 272 undef $self->{fh}; 273 return; 274} 275my %symbolic_annotation_glyph = ( 276q{$1} => q{!}, 277q{$2} => q{?}, 278q{$3} => q{!!}, 279q{$4} => q{??}, 280q{$5} => q{!?}, 281q{$6} => q{?!}, 282); 283 284my %numeric_annotation_glyph = (); 285 286=item NAG() 287returns the corresponding Numeric Annotation Glyph 288 289=cut 290 291sub NAG { 292 my $item = shift; 293 return unless $item =~ /\$?(\d+)/x; 294 return if ($1 > 139) or ($1 < 0); 295 unless (scalar keys %numeric_annotation_glyph) { 296 local $INPUT_RECORD_SEPARATOR = undef; 297 eval <DATA>; ## no critic 298 } 299 my $nag_ref = \%numeric_annotation_glyph; 300 if (($1 > 0) and ($1 <=6)) { 301 $nag_ref = \%symbolic_annotation_glyph 302 } 303 if ($item =~ /^\$/x) { 304 return $nag_ref->{$item} 305 } 306 else { 307 return $nag_ref->{q{$}.$item} 308 } 309} 310 311=item STR() 312 313returns the Seven Tags Roster array 314 315 @array = $pgn->STR(); 316 @array = PGNParser::STR(); 317 318=cut 319 320sub STR { 321 return @seven_tags_roster; 322} 323 324=item event() 325 326returns the Event tag 327 328=item site() 329 330returns the Site tag 331 332=item date() 333 334returns the Date tag 335 336=item white() 337 338returns the White tag 339 340=item black() 341 342returns the Black tag 343 344=item result() 345 346returns the result tag 347 348=item round() 349 350returns the Round tag 351 352=item game() 353 354returns the unparsed game moves 355 356=item time() 357 358returns the Time tag 359 360=item eco() 361 362returns the ECO tag 363 364=item eventdate() 365 366returns the EventDate tag 367 368=item moves() 369 370returns an array reference to the game moves (no numbers) 371=cut 372 373=item comments() 374 375returns a hash reference to the game comments (the key is the move number and the value are the comments for such move) 376 377=cut 378 379=item errors() 380 381returns a hash reference to the game errors (the key is the move number and the value are the errors for such move) 382 383=item set_event() 384 385returns or modifies the Event tag 386 387=item set_site() 388 389returns or modifies the Site tag 390 391=item set_date() 392 393returns or modifies the Date tag 394 395=item set_white() 396 397returns or modifies the White tag 398 399=item set_black() 400 401returns or modifies the Black tag 402 403=item set_result() 404 405returns or modifies the result tag 406 407=item set_round() 408 409returns or modifies the Round tag 410 411=item set_game() 412 413returns or modifies the unparsed game moves 414 415=item set_time() 416 417returns or modifies the Time tag 418 419=item set_eco() 420 421returns or modifies the ECO tag 422 423=item set_eventdate() 424 425returns or modifies the EventDate tag 426 427 428=item set_moves() 429 430returns or modifies an array reference to the game moves (no numbers) 431 432=cut 433 434sub event { 435 my $self = shift; 436 return $self->{gamedescr}{Event} 437} 438 439sub site { 440 my $self = shift; 441 return $self->{gamedescr}{Site} 442} 443 444sub date { 445 my $self = shift; 446 return $self->{gamedescr}{Date} 447} 448 449sub white { 450 my $self = shift; 451 return $self->{gamedescr}{White} 452} 453 454sub black { 455 my $self = shift; 456 return $self->{gamedescr}{Black} 457} 458 459sub result { 460 my $self = shift; 461 return $self->{gamedescr}{Result} 462} 463 464sub round { 465 my $self = shift; 466 return $self->{gamedescr}{Round} 467} 468 469## no critic 470sub time { 471 my $self = shift; 472 return $self->{gamedescr}{Time} 473} 474## use critic 475 476sub eventdate { 477 my $self = shift; 478 return $self->{gamedescr}{EventDate} 479} 480 481sub eco { 482 my $self = shift; 483 return $self->{gamedescr}{ECO} 484} 485 486sub game { 487 my $self = shift; 488 return $self->{gamedescr}{Game} 489} 490 491sub moves { 492 my $self = shift; 493 return $self->{GameMoves}; 494} 495 496 497sub set_event { 498 my $self = shift; 499 $self->{gamedescr}{Event} = $_[0] if @_; 500 return $self->{gamedescr}{Event} 501} 502 503sub set_site { 504 my $self = shift; 505 $self->{gamedescr}{Site} = shift if @_; 506 return $self->{gamedescr}{Site} 507} 508 509sub set_date { 510 my $self = shift; 511 $self->{gamedescr}{Date} = shift if @_; 512 return $self->{gamedescr}{Date} 513} 514 515sub set_white { 516 my $self = shift; 517 $self->{gamedescr}{White} = shift if @_; 518 return $self->{gamedescr}{White} 519} 520 521sub set_black { 522 my $self = shift; 523 $self->{gamedescr}{Black} = shift if @_; 524 return $self->{gamedescr}{Black} 525} 526 527sub set_result { 528 my $self = shift; 529 $self->{gamedescr}{Result} = shift if @_; 530 return $self->{gamedescr}{Result} 531} 532 533sub set_round { 534 my $self = shift; 535 $self->{gamedescr}{Round} = shift if @_; 536 return $self->{gamedescr}{Round} 537} 538 539sub set_time { 540 my $self = shift; 541 $self->{gamedescr}{Time} = shift if @_; 542 return $self->{gamedescr}{Time} 543} 544 545sub set_eventdate { 546 my $self = shift; 547 $self->{gamedescr}{EventDate} = shift if @_; 548 return $self->{gamedescr}{EventDate} 549} 550 551sub set_eco { 552 my $self = shift; 553 $self->{gamedescr}{ECO} = shift if @_; 554 return $self->{gamedescr}{ECO} 555} 556 557sub set_game { 558 my $self = shift; 559 $self->{gamedescr}{Game} = shift if @_; 560 return $self->{gamedescr}{Game} 561} 562 563sub set_moves { 564 my $self = shift; 565 $self->{GameMoves} = shift if (@_ && (ref $_[0] eq 'ARRAY')) ; 566 return $self->{GameMoves}; 567} 568 569sub errors { 570 my $self = shift; 571 return $self->{GameErrors}; 572} 573 574sub comments { 575 my $self = shift; 576 return $self->{GameComments}; 577} 578 579=for internal use 580initialize the pgn object fields. 581 582=cut 583 584sub _init { 585 my $self = shift; 586 for (keys %{$self->{gamedescr}}) { 587 $self->{gamedescr}{$_} = q{}; 588 } 589 delete $self->{gamedescr}{FirstMove} 590 if exists $self->{gamedescr}{FirstMove}; 591 undef $self->{GameMoves}; 592 undef $self->{GameComments}; 593 undef $self->{GameErrors}; # 0.07 594 return; 595} 596 597=item tags() 598 599returns a hash reference to all the parsed tags 600 601 $hash_ref = $pgn->tags(); 602 603=cut 604 605sub tags { 606 my $self = shift; 607 return \%{$self->{gamedescr}}; 608} 609 610=item read_all() 611 612Will read and parse all the games in the current file and return a reference to an array of hashes. 613Each hash item contains both the raw data and the parsed moves and comments 614 615Same parameters as for parse_game(). Default : discard comments 616 617 my $games_ref = $pgn->read_all(); 618 619=cut 620 621sub read_all { 622 my $self=shift; 623 my $params = shift; 624 my @games =(); 625 while ($self->read_game()) { 626 $self->parse_game($params); 627 my %gd = %{$self->{gamedescr}}; 628 $gd{GameComments} = $self->{GameComments}; 629 $gd{GameErrors} = $self->{GameErrors}; 630 $gd{GameMoves} = $self->{GameMoves}; 631 push @games, \%gd; 632 } 633 return \@games; 634} 635 636=item quick_read_all() 637 638Will read and quick parse all the games in the current file and return a reference to an array of hashes. 639Each hash item contains both the raw data and the parsed moves 640Comments are discarded. Same parameters as for quick_parse_game(). 641 642 my $games_ref = $pgn->quick_read_all(); 643 644=cut 645 646sub quick_read_all { 647 my $self=shift; 648 my $params = shift; 649 my @games =(); 650 while ($self->read_game()) { 651 $self->quick_parse_game($params); 652 my %gd = %{$self->{gamedescr}}; 653 $gd{GameMoves} = $self->{GameMoves}; 654 push @games, \%gd; 655 } 656 return \@games; 657} 658 659=item smart_read_all() 660 661Will read and quick parse all the games in the current file and return a reference to an array of hashes. 662Each hash item contains both the raw data and the parsed moves 663Comments are discarded. Calls smart_read_game() to decide which method is best to parse each given game. 664 665 my $games_ref = $pgn->smart_read_all(); 666 667=cut 668 669sub smart_read_all { 670 my $self=shift; 671 my $params = shift; 672 my @games =(); 673 while ($self->read_game()) { 674 $self->smart_parse_game($params); 675 my %gd = %{$self->{gamedescr}}; 676 $gd{GameMoves} = $self->{GameMoves}; 677 push @games, \%gd; 678 } 679 return \@games; 680} 681 682 683=item read_game() 684 685reads the next game from the given PGN file. 686Returns TRUE (1) if successful (= a game was read) 687or FALSE (0) if no more games are available or 688an unexpected EOF occurred before the end of parsing 689 690 while ($pgn->read_game()) { 691 do_something_smart; 692 } 693 694It can read standard and in some cases even non-standard PGN 695games. The following deviance from the standard are handled: 696 697 1. no blank line between tags and moves; 698 2. no blank line between games 699 3. blank line(s) before a game (start of file) 700 4. multiple tags in the same line 701 5. tags spanning over more lines 702 (can't cumulate with rule 4) 703 6. No tags (only moves). 704 (can't cumulate with rule 2) 705 7. comments (starting with ";") outside the game text 706 707=cut 708 709# 710# read_game() introduced in 0.07 711# 712sub _process_game { 713 my $self = shift; 714 my $memory = $self->{memory}; 715 return 0 unless $memory->{game}; 716 $self->{gamedescr}{missing} .= 'tags' unless $memory->{tag_printed}; 717 $memory->{tag_printed} = 0; 718 $self->{gamedescr}{Game} .= $memory->{game}; 719 $memory->{game} = q{}; 720 $memory->{game_printed} =1; 721 return 1; 722} 723 724sub _process_tag { 725 my $self = shift; 726 my $memory = $self->{memory}; 727 if ($memory->{game}) { 728 $self->_process_game; 729 } 730 return 0 if $memory->{utag}; 731 if ($memory->{tag} =~ tr/]// > 1) { 732 # deals with multiple tags in one line 733 $memory->{tag} =~ s/\]\s?/\]\n/g; 734 } 735 while ($memory->{tag} =~ /\[(\w+)\s+"(.*)"\]\s*/g) { 736 $self->{gamedescr}{$1} = $2; 737 } 738 $memory->{tag_printed} =1; 739 $memory->{tag} = q{}; 740 $memory->{game_printed} = 0; 741 return; 742} 743 744sub read_game { 745 my $self = shift; 746 my $fh = ${$self->{fh}}; 747 my $memory = $self->{memory}; 748 $self->_init(); 749 $self->_process_tag if $memory->{tag}; 750 return $self->_process_game if $memory->{game}; 751 while (<$fh>) { 752 # handle semicolon comments 753 if (/^;/) { 754 if ($memory->{game_printed} or (! $memory->{game})) { # between games 755 chomp; 756 $self->{gamedescr}{Comment} .= $_ ; 757 # comments between games are saved as tags 758 } 759 elsif ($memory->{game}){ 760 $memory->{game} .= $_; 761 } 762 next; # anything else is discarded. 763 } 764 # normalize tagless games 765 if (/^\s*$/) { 766 if ($memory->{game}) { 767 # handles comments with embedded newlines. 768 if (($memory->{game} =~ tr/\{//) < ($memory->{game} =~ tr/\}//) ) { 769 next; 770 } 771 return $self->_process_game; 772 } 773 next; 774 } 775 # deals with multi-line tags 776 if ($memory->{utag}) { 777 chomp; 778 $memory->{tag} .= $_; 779 my $left_brackets = ($memory->{tag} =~ tr/\[//); 780 my $right_brackets = ($memory->{tag} =~ tr/\]//); 781 if ( $left_brackets == $right_brackets ) { 782 $memory->{utag} = 0; 783 $memory->{tag_printed} = 0; 784 $memory->{tag} .= "\n"; 785 } 786 } 787 elsif (/^\[/ && (! $memory->{game})) { 788 my $left_brackets = tr/\[//; 789 my $right_brackets = tr/\]//; 790 if ($left_brackets == $right_brackets) { 791 $memory->{tag} = $_; 792 } 793 elsif ($right_brackets > $left_brackets) { 794 warn "Parsing error at line $.\n"; 795 } 796 else { 797 $memory->{utag} = 1; 798 chomp; 799 $memory->{tag} = $_; 800 $memory->{tag_printed} =0; 801 } 802 } 803 else { 804 s/^\s*//; 805 $memory->{game} .= $_; 806 } 807 if ($memory->{tag}) { 808 return $self->_process_game if $memory->{game}; 809 $self->_process_tag; 810 } 811 } 812 if ($memory->{tag}) { 813 $self->_process_tag; 814 } 815 if ($memory->{game}) { 816 return $self->_process_game; 817 } 818 return 0; 819} 820 821=item read_standard_game() 822 823reads the next game from the given PGN file. 824Returns TRUE (1) if successful (= a game was read) 825or FALSE (0) if no more games are available or 826an unexpected EOF occurred before the end of parsing 827 828 while ($pgn->read_standard_game()) { 829 do_something_smart; 830 } 831 832This method deals only with well formed PGN games. Use 833the more forgiving read_game() for PGN files that don't 834fully respect the PGN standard. 835 836=cut 837 838sub read_standard_game { 839 my $self = shift; 840 my $fh = ${$self->{fh}}; 841 $self->_init(); 842 my $block = 1; 843 #return 0 if eof($fh); # changed in version 0.06 844 while (<$fh>) { 845 return 0 unless defined $_; # 0.06 846 chomp; 847 $block = 0 if /^\s*$/; 848 last unless $block; 849 last unless /\[(\w+)/; 850 my $tag = $1; 851 last unless /\"(.*)\"/; 852 my $value = $1; 853 $self->{gamedescr}{$tag} = $value; 854 } 855 $block = 1; 856 #return 0 if eof($fh); # changed in version 0.06 857 return 0 unless defined $_; # 0.06 858 while (<$fh>) { 859 return 0 unless defined $_; # 0.06 860 $block = 0 if /^\s*$/; 861 last unless $block; 862 $self->{gamedescr}{Game} .= $_; 863 } 864 return 1; 865} 866 867=for internal use 868 869 _get_tags() returns a list of tags depending on the parameters 870 871 _get_format() returns a format to be used when printing tags 872 873 _get_formatted_tag() returns a tag formatted according to the 874 given template. 875 876=cut 877 878sub _get_tags { 879 my $self = shift; 880 my $params = shift; 881 my @newtags=(); 882 my %seen = (Game =>1); 883 if (exists $params->{all_tags} 884 and ($params->{all_tags} =~ /^(?:[Yy][Ee][Ss]|1)$/)) 885 { 886 for (@seven_tags_roster) { 887 push @newtags, $_; 888 $seen{$_}++; 889 } 890 for (sort {lc $a cmp lc $b} keys %{$self->{gamedescr}}) { 891 push @newtags, $_ unless $seen{$_}; 892 } 893 } 894 elsif (exists $params->{tags}) { 895 for (@{$params->{tags}}) { 896 push @newtags, $_; 897 } 898 } 899 else { 900 @newtags = @seven_tags_roster; 901 } 902 return @newtags; 903} 904 905 906sub _get_left_right { 907 my $pattern = shift; 908 my $format = shift; 909 my $left_delimiter = shift; 910 my $right_delimiter = shift; 911 if (defined $pattern) { 912 if (length($pattern) == 1) { 913 $format = $pattern . $format .$pattern; 914 } 915 elsif (length($pattern) == 2) { 916 my @chars = split //, $pattern; 917 $left_delimiter = $chars[0]; 918 $right_delimiter= $chars[1]; 919 } 920 elsif ($pattern =~ /^(.*)\|(.*)$/) { 921 $left_delimiter = $1; 922 $right_delimiter = $2; 923 } 924 } 925 $format = $left_delimiter . $format . $right_delimiter; 926 return $format; 927} 928 929sub _get_format { 930 my $params = shift; 931 my $format = _get_left_right($params->{quotes}, q{#value#},q{"},q{"}); 932 $format = _get_left_right($params->{brackets},q{#tag# }.$format,q{[},q{]}); 933 return $format; 934} 935 936sub _formatted_tag { 937 my ($format, $tag, $value) = @_; 938 my $subst = $format; 939 $subst =~ s/#tag#/$tag/; 940 $subst =~ s/#value#/$value/; 941 return $subst; 942} 943 944=item standard_PGN() 945 946 returns a string containing all current PGN tags, including 947 the game. 948 Parameters are passed through a hash reference. None is 949 required. 950 951 tags => [tag list], # default is the Seven Tags Roster. 952 # You may specify only the tags you want to 953 # print 954 # tags => [qw(White Black Result)] 955 956 all_tags => 'no', # default 'no'. If yes (or 1), it outputs all the tags 957 # if 'tags' and 'all_tags' are used, 'all_tags' 958 # prevails 959 960 nl => q{\n}, # default '\n'. Tag separator. Can be changed 961 # according to your needs. 962 # nl => '<br>\n' is a good candidate for HTML 963 # output. 964 965 brackets => q{[]}, # default '[]'. Output tags within brackets. 966 # Bracketing can be as creative as you want. 967 # If the left and rigth bracketing sequence are 968 # longer than one character, they must be separated 969 # by a pipe (|) symbol. 970 # '()', '(|)\t,'{|}\n' and '{}' are valid 971 # sequences. 972 # 973 # '<h1>|</h1>' will output HTML header 1 974 # '<b>{</b>|<b>}</b>\n' will enclose each tag 975 # between bold braces. 976 977 quotes => q{"}, # default '"'. Quote tags values. 978 # As for brackets, quotes can be specified in 979 # pairs: '<>' and '<|>' are equivalent. 980 # If the quoting sequence is more than one char, 981 # the pipe symbol is needed to separate the left 982 # quote from the right one. 983 # '<i>|</i>' will produce HTML italicized text. 984 985 game => 'yes', # default 'yes'. Output the game text 986 # If the game was parsed, returns a clean list 987 # of moves, else the unparsed text 988 989 comments => 'no' # Default 'no'. Output the game comments. 990 # Requires the 'game' option 991 992=cut 993 994my %switchcolor = ('w' => 'b', 'b' => 'w'); 995sub standard_PGN { 996 my $self = shift; 997 my $params = shift; 998 my %seen =(Game =>1); 999 my @tags = $self->_get_tags($params); 1000 my $out = q{}; 1001 my $nl ="\n"; 1002 my $out_game = 'yes'; 1003 $out_game = 0 if # 0.11 1004 exists $params->{game} 1005 and (lc($params->{game}) ne 'yes'); 1006 1007 my $out_comments = 0; # 0.11 1008 $out_comments = 'yes' if $out_game # 0.11 1009 and (exists $params->{comments} 1010 and (lc($params->{comments}) eq 'yes')); 1011 1012 $nl = $params->{nl} if exists $params->{nl}; 1013 my $format = _get_format($params); 1014 for (@tags) { 1015 $self->{gamedescr}{$_}=q{?} unless exists $self->{gamedescr}{$_}; 1016 #$out .= qq/[$_ "$self->{gamedescr}{$_}"]\n/; 1017 $out .= _formatted_tag($format, $_, $self->{gamedescr}{$_}); 1018 $out .= $nl; 1019 } 1020 if (@tags) { 1021 $out .= $nl; 1022 } 1023 return $out unless $out_game; 1024 if (defined $self->{GameMoves}) { # if parsed 1025 my $count = 0; 1026 my $color = 'w'; 1027 if ((defined $self->{gamedescr}{FirstMove}) # 0.07 1028 and ($self->{gamedescr}{FirstMove} =~ m/(\d+)([bw])/)) # 0.07 1029 { 1030 $count = $1; # 0.07 1031 $color = $2; # 0.07 1032 $out .= "$count\.\.\." if $color eq 'b'; # 0.07 1033 } 1034 my $len = 0; 1035 for (@{$self->moves}) { # 1036 if ($color eq 'w') { 1037 $count++; 1038 $out .= q{ } and $len++ if $len and ($count > 1); 1039 $out .= $count . q{ }; 1040 $len += length($count) +2; 1041 } 1042 else { 1043 $out .= q{ }; 1044 $len++; 1045 } 1046 $out .= $_; 1047 $len += length($_); 1048 if ($out_comments # 0.11 1049 && exists $self->comments->{($count-1)."${color}"}) { # 0.12 1050 my $comment = $self->comments->{($count-1)."${color}"}; # 0.12 1051 my $needs_nl = $comment =~ /^\s*;/; 1052 # 1053 # deal with comment length here 1054 # 1055 if ($len >= 75) { 1056 $len = 0; 1057 $out .= $nl; 1058 } 1059 while ($len + length($comment) > 75) { 1060 my $delta = 75 - $len; 1061 $delta = 0 if $delta < 0; 1062 my ($portion) = $comment =~ /^(.{1,$delta})\W/; 1063 $out .= $portion; 1064 $len = 0; 1065 $out .= $nl; 1066 $comment = substr($comment, length($portion) +1); 1067 } 1068 $out .= $comment; 1069 $out .= $nl if $needs_nl; 1070 $len += length($comment); 1071 } 1072 $color = $switchcolor{$color}; 1073 if ($len >= 75) { 1074 $len = 0; 1075 $out .= $nl; 1076 } 1077 } 1078 $out .=" $self->{gamedescr}{Result}$nl"; 1079 } 1080 else { # not parsed - returns game text 1081 $out .= $self->{gamedescr}{Game}; 1082 } 1083 return $out; 1084} 1085 1086=item smart_parse_game() 1087 1088Parses the current game, returning the moves only. 1089Uses by default quick_parse_game(), unless recursive comments are found in the source game. 1090 1091=cut 1092 1093sub smart_parse_game { 1094 my $self = shift; 1095 my $params = shift; 1096 if ($self->{gamedescr}{Game} =~ /\(/) { 1097 $self->parse_game($params) 1098 } 1099 else { 1100 $self->quick_parse_game($params) 1101 } 1102 return; 1103} 1104 1105=item quick_parse_game() 1106 1107Parses the current game, returning the moves only. 1108Comments are discarded. 1109This function does FAIL on Recursive Annotated Variation or nested comments. 1110Parameters (passed as a hash reference): check_moves = 'yes'|'no'. Default : no. If requested, each move is checked against a RegEx, to filter off possible unbraced comments. 1111 1112=cut 1113 1114# ============================================== 1115# These two regular expressions were produced by 1116# Damian Conway's module Regexp::Common 1117# ---------------------------------------------- 1118# On the author's suggestion, these lines 1119# 1120# use Regexp::Common; 1121# print "$RE{balanced}{-parens=>'()'}\n"; 1122# print "$RE{balanced}{-parens=>'{}'}\n"; 1123# 1124# produced the RegEx code, which was edited 1125# and inserted here for efficiency reasons. 1126# ============================================== 1127 1128our $re_parens; ## no critic 1129$re_parens = qr/ 1130 (?:(?:(?:[(](?:(?>[^)(]+) 1131 |(??{$re_parens}))*[)])) 1132 |(?:(?!))) 1133 /x; 1134 1135our $re_brace; ## no critic 1136$re_brace = qr/ 1137 (?:(?:(?:[{](?:(?>[^}{]+) 1138 |(??{$re_brace}))*[}])) 1139 |(?:(?!))) 1140 /x; 1141 1142# ============================================== 1143 1144# regular expressions for game parsing 1145my $re_result = qr{(?:1\-0|0\-1|1\/2\-1\/2|\*)}; 1146my $re_move = qr{[KQRBN]?[a-h]?[1-8]?x?[a-h][1-8](?:\=?[QRBN])?}; 1147# piece ^^^^^ 1148# unambiguous column or line ^^^ ^^^ 1149# capture ^ 1150# destination square ^^^ ^^^ 1151# promotion ^ ^^^^^ 1152my $re_castling = qr/O\-O(?:\-O)?/; 1153my $re_check = qr/(?:(?:\#|\+(\+)?))?/; 1154my $re_any_move = qr/(?:$re_move|$re_castling)$re_check/; 1155my $re_nag = qr/\$\d+/; 1156my $re_number = qr/\d+\.(?:\.\.)?/; 1157my $re_escape = qr/^\%[^\n]*\n/; 1158my $re_eol_comment= qr/;.*$/; 1159my $re_rav = $re_parens; 1160my $re_comment = $re_brace; 1161 1162sub quick_parse_game { 1163 my $self = shift; 1164 my $params = shift; # hash reference to parameters 1165 $self->{gamedescr}{Game} =~ s/$re_eol_comment//mg; # rm EOL comments 1166 $self->{gamedescr}{Game} =~ s/$re_escape//mgo; # rm escaped lines 1167 $self->{gamedescr}{Game} =~ 1168 s/$re_comment//g; # remove comments 1169 $self->{gamedescr}{Game} =~ 1170 s/$re_rav//g; # remove RAV 1171 return 0 1172 if $self->{gamedescr}{Game} =~ 1173 /\(/; # the game still contains RAV 1174 return 0 1175 if $self->{gamedescr}{Game} =~ 1176 /\{/; # undetected nested comments 1177 $self->{gamedescr}{Game} =~ s/\n/ /g; # remove newlines 1178 $self->{gamedescr}{Game} =~ 1179 s/\r/ /g; # remove return chars (DOS) 1180 $self->{gamedescr}{Game} =~ s/$re_nag//go; # remove NAG 1181 $self->{gamedescr}{Game} =~ s/\d+\.//g; # remove numbers 1182 $self->{gamedescr}{Game} =~ s/\.\.(?:\.)?//g; # remove "..." 1183 $self->{gamedescr}{Game} =~ s/$re_result\s*\Z//o; 1184 my $re_filter = qr/\S/; 1185 if (exists $params->{check_moves} 1186 and ($params->{check_moves} =~ /^(?:yes|1)$/)) 1187 { 1188 $re_filter = $re_any_move; 1189 } 1190 return unless $self->{gamedescr}{Game}; # discards empty games 1191 $self->{GameMoves} = 1192 [grep { m/$re_filter/o } split /\s+/, $self->{gamedescr}{Game}]; 1193 return; 1194} 1195 1196=item parse_game() 1197 1198Parses the current game (after read_game() was called). 1199Accepts parameters as hash reference. 1200 1201 $pgn->parse_game(); # default save_comments => 'no' 1202 1203 $pgn->parse_game({ 1204 save_comments => 'yes', 1205 comments_struct => 'string'}); 1206 1207{comments_struct => 'string'} is the default value 1208When 'comments_struct' is 'string', multiple comments 1209for the same move are concatenated to one string 1210 1211{comments_struct => 'array'} 1212If 'array', comments are stored as an anonymous array, 1213one comment per element 1214 1215{comments_struct => 'hol'} 1216If 'hol', comments are stored as a hash of lists, where 1217there is a list of comments for each comment type 1218(NAG, RAV, braced, semicolon, escaped) 1219 1220 $pgn->parse_game({save_comments => 'yes', 1221 log_errors => 'yes'}); 1222 1223parse_game() implements a finite state machine on two assumptions: 1224 1225 1. No moves or move numbers are truncated at the end of a line; 1226 2. the possible states in a PGN game are: 1227 1228 a. move number 1229 b. move 1230 c. braced comment 1231 d. EOL comment 1232 e. Numeric Annotation Glyph 1233 f. Recursive Annotated Variation 1234 g. Result 1235 h. unbraced comments (barewords, "!?+-=") 1236 1237Items from "a" to "g" are actively parsed and recognized. 1238Anything unrecognized goes into the "h" state and discarded 1239(or stored, if log_errors was requested) 1240 1241=cut 1242 1243{ # start closure for parse_game 1244my %comment_types = ( 1245 q{$} => 'NAG', 1246 q{(} => 'RAV', 1247 q[{] => 'brace', 1248 q{%} => 'escaped', 1249 q{;} => 'semicolon', 1250); 1251 1252sub parse_game { 1253 my $self = shift; 1254 my $params = shift; 1255 my $save_comments = ((exists $params->{save_comments}) 1256 and ($params->{save_comments} =~ /^(?:yes|1)$/)); 1257 my $log_errors = (exists $params->{log_errors}) 1258 and ($params->{log_errors} =~ /^(?:yes|1)$/); 1259 return unless $self->{gamedescr}{Game}; 1260 my $movecount = 0; 1261 my $color = 'b'; 1262 $self->{gamedescr}{Game} =~ s/0\-0\-0/O-O-O/g; 1263 $self->{gamedescr}{Game} =~ s/0\-0/O-O/g; 1264 $self->{gamedescr}{Game} =~ s/$re_result\s*\Z//o; 1265 1266 my $comments_struct = 'string'; 1267 $comments_struct = $params->{comments_struct} 1268 if ($save_comments 1269 and exists $params->{comments_struct}); 1270 $comments_struct = 'string' 1271 unless $comments_struct =~ /^(?:array|hol)$/; 1272 my $plycount = 0; 1273 my $countless =0; 1274 $self->{gamedescr}{Game} =~ s/\s*\Z//; 1275 $self->{gamedescr}{Game} =~ s/^\s*//; 1276 if ($self->{gamedescr}{Game} !~ /\d\./) { 1277 $countless = 1; 1278 $movecount = 1; 1279 } 1280 1281 $self->{GameMoves} = []; 1282 1283 for ($self->{gamedescr}{Game}) { 1284 while (! /\G \s* \z/xgc ) { 1285 if ( m/\G($re_number)\s*/mgc) { 1286 my $num=$1; 1287 if (( $num =~ tr/\.//d) > 1) { 1288 $color = 'w'; 1289 } 1290 if ($movecount == 0) { 1291 $movecount = $num; 1292 $self->{gamedescr}{FirstMove} = 1293 $num.$switchcolor{$color} # fixed 0.07 1294 unless $num.$switchcolor{$color} eq '1w'; 1295 } 1296 elsif ($movecount == ($num -1)) { 1297 $movecount++; 1298 } 1299 elsif ($movecount != $num) { 1300 $self->{GameErrors}->{$movecount.$color} 1301 .= " invalid move sequence ($num <=> $movecount)"; 1302 $movecount++; 1303 } 1304 } 1305 elsif ( m/\G($re_any_move)\s*/mgc ) { 1306 push @{$self->{GameMoves}}, $1; 1307 $color = $switchcolor{$color}; 1308 if ($countless) { 1309 $plycount++; 1310 if ($plycount == 2) { 1311 $plycount =0; 1312 $movecount++; 1313 } 1314 } 1315 } 1316 elsif ( 1317 m/\G($re_comment 1318 |$re_eol_comment 1319 |$re_rav 1320 |$re_nag|$re_escape)\s*/mgcx 1321 ) 1322 { 1323 if ($save_comments) { 1324 my $tempcomment = $1; 1325 $tempcomment =~ tr/\r//d; 1326 $tempcomment =~ s/\n/ /g; 1327 $tempcomment =~ s/^\s+//; 1328 $tempcomment =~ s/\s+$//; 1329 if ($comments_struct eq 'string') { 1330 $self->{GameComments}->{$movecount.$color} .= 1331 q{ } . $tempcomment; 1332 } 1333 elsif ($comments_struct eq 'array') { 1334 push @{$self->{GameComments}->{$movecount.$color}}, 1335 $tempcomment; 1336 } 1337 else { # hol 1338 $tempcomment =~ m/^(.)/; 1339 my $comment_type ='unknown'; 1340 $comment_type = $comment_types{$1} 1341 if ($1 and exists $comment_types{$1}); 1342 push @{$self->{GameComments}->{$movecount.$color}->{$comment_type}} , 1343 $tempcomment; 1344 } 1345 } 1346 } 1347 elsif ( m/\G(\S+\s*)/mgc ) { 1348 if ($log_errors) { 1349 $self->{GameErrors}->{$movecount.$color} .= q{ } . $1; 1350 $self->{GameErrors}->{$movecount.$color} =~ tr/\r//d; 1351 $self->{GameErrors}->{$movecount.$color} =~ s/\n/ /g; 1352 } 1353 } 1354 } 1355 } 1356 return 1; 1357} 1358 1359=item add_comments() 1360 1361Allows inserting comments for an already parsed game; 1362it accepts comments passed as an anonymous hash. 1363An optional second parameter sets the storage type. 1364They are the same as for parse_game(); 1365 'string' (default) all comments for a given move are 1366 concatenated together 1367 'array' each comment for a given move is stored as 1368 an array element 1369 'hol' Comments are stored in a hash of lists 1370 different for each comment type. 1371 1372=cut 1373 1374sub add_comments { 1375 my $self = shift; 1376 my $comments = shift; 1377 my $comment_struct = shift; 1378 $comment_struct = 'string' 1379 unless ($comment_struct && ($comment_struct =~ /^hol|array$/)); 1380 if ($self->moves && $comments && (ref $comments eq 'HASH')) { 1381 for (keys %{ $comments } ) { 1382 next unless /^\d+(?:w|b)$/; 1383 if ($comment_struct eq 'string') { 1384 $self->{GameComments}->{$_} .= 1385 q{ } . $comments->{$_}; 1386 } 1387 elsif ($comment_struct eq 'array') { 1388 push @{$self->{GameComments}->{$_}}, 1389 $comments->{$_}; 1390 } 1391 else { # hol 1392 $comments->{$_} =~ m/^(.)/; 1393 my $comment_type ='unknown'; 1394 $comment_type = $comment_types{$1} 1395 if ($1 and exists $comment_types{$1}); 1396 push @{$self->{GameComments}->{$_}->{$comment_type}} , 1397 $comments->{$_}; 1398 } 1399 } 1400 } 1401 return $self->{GameComments}; 1402} 1403 1404} # end closure for parse_game() 1405 1406=item shrink_epd() 1407 1408Given a EPD (Extended Position Description) string, shrink_epd() will convert it into a bit string, which reduces the original by about 50%. 1409It can be restored to the original string by expand_epd() 1410 1411=cut 1412 1413# K k 0001 1001 001 1414# Q q 0010 1010 010 1415# R r 0011 1011 011 1416# B b 0100 1100 100 1417# N n 0101 1101 101 1418# P p 0110 1110 110 1419# E 0000 0000 000 1420# 111 1421# rnbqkbnr/pppppppp/8/8/3P4/8/PPP1PPPP/RNBQKBNR b KQkq d3 (38 bytes) 1422# 1011 1101 1100 1010 1001 1100 1101 1011 4 1423# 1110 1110 1110 1110 1110 1110 1110 1110 4 1424# 11111000 1 1425# 11111000 1 1426# 11110011 0110 11110100 2.5 1427# 11111000 1 1428# 0110 0110 0110 11110001 0110 0110 0110 0110 4.5 1429# 0011 0101 0100 0010 0001 0100 0101 0011 4 1430# 22 1431 1432{ #start EPD closure 1433my %pieces2bits = ( 1434 K => 1, # 0001 1435 k => 9, # 1001 1436 Q => 2, # 0010 1437 q => 10, # 1010 1438 R => 3, # 0011 1439 r => 11, # 1011 1440 B => 4, # 0100 1441 b => 12, # 1100 1442 N => 5, # 0101 1443 n => 13, # 1101 1444 P => 6, # 0110 1445 p => 14, # 1110 1446 1 => 0, # 0000 1447 2 => 7, # 0111 1448 3 => 8, # 1000 1449 4 => 0xF4, # 1111 0100 1450 5 => 0xF5, # 1111 0101 1451 6 => 0xF6, # 1111 0110 1452 7 => 0xF7, # 1111 0111 1453 8 => 0xF8, # 1111 1000 1454); 1455 1456my %castling2bits = ( 1457 'KQkq' => 15, # 1111 F KQkq 1458 'KQk' => 14, # 1110 E KQk- 1459 'KQq' => 13, # 1101 D KQ-q 1460 'KQ' => 12, # 1100 C KQ-- 1461 'Kkq' => 11, # 1011 B K-kq 1462 'Kk' => 10, # 1010 A K-k- 1463 'Kq' => 9, # 1001 9 K--q 1464 'K' => 8, # 1000 8 K--- 1465 'Qkq' => 7, # 0111 7 -Qkq 1466 'Qk' => 6, # 0110 6 -Qk- 1467 'Qq' => 5, # 0101 5 -Q-q 1468 'Q' => 4, # 0100 4 -Q-- 1469 'kq' => 3, # 0011 3 --kq 1470 'k' => 2, # 0010 2 --k- 1471 'q' => 1, # 0001 1 ---q 1472 q{-} => 0, # 0111 0 ---- 1473); 1474 1475my %ep2bits = ( 1476 q{-} => 0, 1477 'a' => 1, 1478 'b' => 2, 1479 'c' => 3, 1480 'd' => 4, 1481 'e' => 5, 1482 'f' => 6, 1483 'g' => 7, 1484 'h' => 8, 1485); 1486my %color2bits = ('w' => 0, 'b' => 1 ); 1487my %bits2color = ( 0 => 'w', 1 => 'b'); 1488 1489my %bits2pieces = map { $pieces2bits{$_}, $_ } keys %pieces2bits; 1490my %bits2castling = map { $castling2bits{$_}, $_ } keys %castling2bits; 1491my %bits2ep = map { $ep2bits{$_}, $_ } keys %ep2bits; 1492 1493sub shrink_epd { 1494 my $source = shift; 1495 my $piece = q{}; 1496 my $vecstring = q{}; 1497 my $offset = 0; 1498 my ($fen, $color, $castling, $ep) = split / /, $source; 1499 while ($fen =~ /(.)/g) { 1500 next if $1 eq q{/}; 1501 $piece = $pieces2bits{$1}; 1502 if ($piece < 0x0F) { 1503 vec($vecstring, $offset++, 4) = $piece; 1504 } 1505 else { 1506 vec($vecstring, $offset++, 4) = 0x0F; 1507 vec($vecstring, $offset++, 4) = $1; 1508 } 1509 } 1510 vec($vecstring, $offset++, 4) = $color2bits{$color}; 1511 vec($vecstring, $offset++, 4) = $castling2bits{$castling}; 1512 vec($vecstring, $offset++, 4) = $ep2bits{substr($ep,0,1)}; 1513 return $vecstring; 1514} 1515 1516=item expand_epd() 1517 1518given a EPD bitstring created by shrink_epd(), expand_epd() will restore the original text. 1519 1520=cut 1521 1522sub expand_epd { 1523 my $vecstring = shift; 1524 my $piece = -1; 1525 my $asciistr=q{}; 1526 my $offset =0; 1527 my $rowsum =0; 1528 my $overall_sum =0; 1529 while ($offset < length($vecstring)*2) { 1530 $piece = vec($vecstring, $offset++, 4); 1531 if ($piece == 0x0F) { 1532 $piece = hex('F' . vec($vecstring,$offset++,4)); 1533 } 1534 $piece = $bits2pieces{$piece}; 1535 $asciistr .= $piece; 1536 if ($piece =~ /[1-8]/) { 1537 $rowsum += $piece 1538 } 1539 else { 1540 $rowsum++; 1541 } 1542 if ($rowsum == 8) { 1543 $overall_sum += $rowsum; 1544 $rowsum =0; 1545 last if ($overall_sum >= 64); 1546 $asciistr .=q{/}; 1547 } 1548 } 1549 my $color = $bits2color{vec($vecstring,$offset++,4)}; 1550 $asciistr .= q{ } . $color; 1551 $asciistr .= q{ } . $bits2castling{vec($vecstring,$offset++,4)}; 1552 my $ep = $bits2ep{vec($vecstring,$offset++,4)}; 1553 if ($ep ne q{-}) { 1554 $ep .= $color eq 'w' ? '6' : '3'; 1555 } 1556 $asciistr .= q{ } . $ep; 1557 return $asciistr; 1558} 1559} # end EPD closure 1560=back 1561 1562=head1 AUTHOR 1563 1564Giuseppe Maxia, gmax@cpan.org 1565 1566=head1 THANKS 1567 1568Thanks to 1569- Hugh S. Myers for advice, support, testing and brainstorming; 1570- Damian Conway for the recursive Regular Expressions used to parse comments; 1571- all people at PerlMonks (www.perlmonks.org) for advice and good developing environment. 1572- Nathan Neff for pointing out an insidious, hard-to-spot bug in my RegExes. 1573 1574=head1 COPYRIGHT 1575 1576The Chess::PGN::Parse module is Copyright (c) 2002 Giuseppe Maxia, 1577Sardinia, Italy. All rights reserved. 1578 1579You may distribute this software under the terms of either the GNU 1580General Public License version 2 or the Artistic License, as 1581specified in the Perl README file. 1582The embedded and encosed documentation is released under 1583the GNU FDL Free Documentation License 1.1 1584 1585=cut 1586 15871; 1588__DATA__ 1589%numeric_annotation_glyph = ( 1590'$0' => 'null annotation', 1591'$1' => 'good move (traditional "!")', 1592'$2' => 'poor move (traditional "?")', 1593'$3' => 'very good move (traditional "!!")', 1594'$4' => 'very poor move (traditional "??")', 1595'$5' => 'speculative move (traditional "!?")', 1596'$6' => 'questionable move (traditional "?!")', 1597'$7' => 'forced move (all others lose quickly)', 1598'$8' => 'singular move (no reasonable alternatives)', 1599'$9' => 'worst move', 1600'$10' => 'drawish position', 1601'$11' => 'equal chances, quiet position', 1602'$12' => 'equal chances, active position', 1603'$13' => 'unclear position', 1604'$14' => 'White has a slight advantage', 1605'$15' => 'Black has a slight advantage', 1606'$16' => 'White has a moderate advantage', 1607'$17' => 'Black has a moderate advantage', 1608'$18' => 'White has a decisive advantage', 1609'$19' => 'Black has a decisive advantage', 1610'$20' => 'White has a crushing advantage (Black should resign)', 1611'$21' => 'Black has a crushing advantage (White should resign)', 1612'$22' => 'White is in zugzwang', 1613'$23' => 'Black is in zugzwang', 1614'$24' => 'White has a slight space advantage', 1615'$25' => 'Black has a slight space advantage', 1616'$26' => 'White has a moderate space advantage', 1617'$27' => 'Black has a moderate space advantage', 1618'$28' => 'White has a decisive space advantage', 1619'$29' => 'Black has a decisive space advantage', 1620'$30' => 'White has a slight time (development) advantage', 1621'$31' => 'Black has a slight time (development) advantage', 1622'$32' => 'White has a moderate time (development) advantage', 1623'$33' => 'Black has a moderate time (development) advantage', 1624'$34' => 'White has a decisive time (development) advantage', 1625'$35' => 'Black has a decisive time (development) advantage', 1626'$36' => 'White has the initiative', 1627'$37' => 'Black has the initiative', 1628'$38' => 'White has a lasting initiative', 1629'$39' => 'Black has a lasting initiative', 1630'$40' => 'White has the attack', 1631'$41' => 'Black has the attack', 1632'$42' => 'White has insufficient compensation for material deficit', 1633'$43' => 'Black has insufficient compensation for material deficit', 1634'$44' => 'White has sufficient compensation for material deficit', 1635'$45' => 'Black has sufficient compensation for material deficit', 1636'$46' => 'White has more than adequate compensation for material deficit', 1637'$47' => 'Black has more than adequate compensation for material deficit', 1638'$48' => 'White has a slight center control advantage', 1639'$49' => 'Black has a slight center control advantage', 1640'$50' => 'White has a moderate center control advantage', 1641'$51' => 'Black has a moderate center control advantage', 1642'$52' => 'White has a decisive center control advantage', 1643'$53' => 'Black has a decisive center control advantage', 1644'$54' => 'White has a slight kingside control advantage', 1645'$55' => 'Black has a slight kingside control advantage', 1646'$56' => 'White has a moderate kingside control advantage', 1647'$57' => 'Black has a moderate kingside control advantage', 1648'$58' => 'White has a decisive kingside control advantage', 1649'$59' => 'Black has a decisive kingside control advantage', 1650'$60' => 'White has a slight queenside control advantage', 1651'$61' => 'Black has a slight queenside control advantage', 1652'$62' => 'White has a moderate queenside control advantage', 1653'$63' => 'Black has a moderate queenside control advantage', 1654'$64' => 'White has a decisive queenside control advantage', 1655'$65' => 'Black has a decisive queenside control advantage', 1656'$66' => 'White has a vulnerable first rank', 1657'$67' => 'Black has a vulnerable first rank', 1658'$68' => 'White has a well protected first rank', 1659'$69' => 'Black has a well protected first rank', 1660'$70' => 'White has a poorly protected king', 1661'$71' => 'Black has a poorly protected king', 1662'$72' => 'White has a well protected king', 1663'$73' => 'Black has a well protected king', 1664'$74' => 'White has a poorly placed king', 1665'$75' => 'Black has a poorly placed king', 1666'$76' => 'White has a well placed king', 1667'$77' => 'Black has a well placed king', 1668'$78' => 'White has a very weak pawn structure', 1669'$79' => 'Black has a very weak pawn structure', 1670'$80' => 'White has a moderately weak pawn structure', 1671'$81' => 'Black has a moderately weak pawn structure', 1672'$82' => 'White has a moderately strong pawn structure', 1673'$83' => 'Black has a moderately strong pawn structure', 1674'$84' => 'White has a very strong pawn structure', 1675'$85' => 'Black has a very strong pawn structure', 1676'$86' => 'White has poor knight placement', 1677'$87' => 'Black has poor knight placement', 1678'$88' => 'White has good knight placement', 1679'$89' => 'Black has good knight placement', 1680'$90' => 'White has poor bishop placement', 1681'$91' => 'Black has poor bishop placement', 1682'$92' => 'White has good bishop placement', 1683'$93' => 'Black has good bishop placement', 1684'$94' => 'White has poor rook placement', 1685'$95' => 'Black has poor rook placement', 1686'$96' => 'White has good rook placement', 1687'$97' => 'Black has good rook placement', 1688'$98' => 'White has poor queen placement', 1689'$99' => 'Black has poor queen placement', 1690'$100' => 'White has good queen placement', 1691'$101' => 'Black has good queen placement', 1692'$102' => 'White has poor piece coordination', 1693'$103' => 'Black has poor piece coordination', 1694'$104' => 'White has good piece coordination', 1695'$105' => 'Black has good piece coordination', 1696'$106' => 'White has played the opening very poorly', 1697'$107' => 'Black has played the opening very poorly', 1698'$108' => 'White has played the opening poorly', 1699'$109' => 'Black has played the opening poorly', 1700'$110' => 'White has played the opening well', 1701'$111' => 'Black has played the opening well', 1702'$112' => 'White has played the opening very well', 1703'$113' => 'Black has played the opening very well', 1704'$114' => 'White has played the middlegame very poorly', 1705'$115' => 'Black has played the middlegame very poorly', 1706'$116' => 'White has played the middlegame poorly', 1707'$117' => 'Black has played the middlegame poorly', 1708'$118' => 'White has played the middlegame well', 1709'$119' => 'Black has played the middlegame well', 1710'$120' => 'White has played the middlegame very well', 1711'$121' => 'Black has played the middlegame very well', 1712'$122' => 'White has played the ending very poorly', 1713'$123' => 'Black has played the ending very poorly', 1714'$124' => 'White has played the ending poorly', 1715'$125' => 'Black has played the ending poorly', 1716'$126' => 'White has played the ending well', 1717'$127' => 'Black has played the ending well', 1718'$128' => 'White has played the ending very well', 1719'$129' => 'Black has played the ending very well', 1720'$130' => 'White has slight counterplay', 1721'$131' => 'Black has slight counterplay', 1722'$132' => 'White has moderate counterplay', 1723'$133' => 'Black has moderate counterplay', 1724'$134' => 'White has decisive counterplay', 1725'$135' => 'Black has decisive counterplay', 1726'$136' => 'White has moderate time control pressure', 1727'$137' => 'Black has moderate time control pressure', 1728'$138' => 'White has severe time control pressure', 1729'$139' => 'Black has severe time control pressure' 1730); 1731