Games::SGF::Util - Utility pack for Games::SGF objects

Games-SGF documentation Contained in the Games-SGF distribution.

Index

Code Index:

NAME

Top

Games::SGF::Util - Utility pack for Games::SGF objects

VERSION

Top

Version 0.993

SYNOPSIS

Top

Quick summary of what the module does.

Perhaps a little code snippet.

    use Games::SGF::Util;

    my $util = new Games::SGF::Util($sgf);

    $util->filter( "C", undef ); # removes all comments from SGF

DISCRIPTION

Top

This is a collection of useful methods for manipulating a Games::SGF object.

All Util methods in this module will not call any game movement methods. This means in order to work with files with multiple games you must move to the game of choice then pass it into a util object.

METHODS

Top

new

  $util = new Games::SGF::Util($sgf);

This initializes a new Games::SGF::Util object. Will return undef if $sgf is no supplied.

touch

  $util->touch(\&sub);

This will call &sub for every node in $sgf. &sub will be passed the $sgf object. any subroutines which manipulate the $sgf tree will lead to undefined behavior. The safe methods to use are:

property in Games::SGF
getProperty in Games::SGF
setProperty in Games::SGF
isCompose in Games::SGF
isStone in Games::SGF
isMove in Games::SGF
isPoint in Games::SGF
compose in Games::SGF
stone in Games::SGF
move in Games::SGF
point in Games::SGF
err in Games::SGF

filter

  $util->fiter( $tag, \&sub);

Will call &sub for every $tag which is in $sgf. &sub will be passed the tag value. The value then be reset to the return of &sub. If the return is "" the tag will be unset.

If the tag has a value list each value will be sent to $callback.

If the $callback returns undef it will not be set.

Example:

  # removes all comments that don't match m/Keep/
  $util->filter( "C", sub { return $_[0] =~ m/Keep/ ? $_[0] : ""; );

gameInfo

  my(@games) = $util->gameInfo;
  foreach my $game (@games) {
      print "New Game\n";
      foreach my $tag (keys %$game) {
         print "\t$tag -> $game->{$tag}\n";
      }
  }

Will return the game-info tags for all games represented in the current game tree. The return order is the closest to the root, and then the closest to the main line branch.

UNWRITTEN

sgf

   $sgf = $util->sgf;
   $sgf = $util->sgf($sgf)

This returns a clone of the $sgf object associated with $util, or sets the $sgf object to a clone of object supplied.

ALSO SEE

Top

Games::SGF

AUTHOR

Top

David Whitcomb, <whitcode at gmail.com>

BUGS

Top

Please report any bugs or feature requests to bug-games-sgf at rt.cpan.org, or through the web interface at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Games-SGF. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.

SUPPORT

Top

You can find documentation for this module with the perldoc command.

    perldoc Games::SGF::Util

You can also look for information at:

* RT: CPAN's request tracker

http://rt.cpan.org/NoAuth/Bugs.html?Dist=Games-SGF

* AnnoCPAN: Annotated CPAN documentation

http://annocpan.org/dist/Games-SGF

* CPAN Ratings

http://cpanratings.perl.org/d/Games-SGF

* Search CPAN

http://search.cpan.org/dist/Games-SGF

COPYRIGHT & LICENSE

Top

Copyright 2008 David Whitcomb, all rights reserved.

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Games-SGF documentation Contained in the Games-SGF distribution. 
package Games::SGF::Util;

use warnings;
use strict;
use Games::SGF;
no warnings 'redefine';


our $VERSION = 0.993;



sub new {
   my $inv = shift;
   my $class = ref $inv || $inv;
   my $sgf = shift;
   if($sgf) {
#      $sgf = $sgf->clone(); # So we are not working with the actual sgf file
   } else {
      return undef;
   }
   return bless \$sgf, $class;
}


sub touch {
   my $self = shift;
   my $callback = shift;
   my $sgf = $$self;
   my( @branches ) = (-1); # Stores the branch stack
   $sgf->gotoRoot;
   {
      my $last = pop @branches;
      &$callback($sgf) if $last == -1; # callback on current node

      if( $last < $sgf->branches and $sgf->gotoBranch(++$last)) {
         push @branches, $last,-1;
      } elsif(@branches > 0 ) {
         $sgf->prev;
         pop @branches;
      } else {
         last;
      }
      redo;
   }
}


sub filter {
   my $self = shift;
   my $tag = shift;
   my $callback = shift;

   return $self->touch(
      sub {
         my $sgf = shift;
         my $values = $sgf->property($tag);
         my @set;
         if( $values ) {
            if( $callback ) {
               foreach( @$values ) {
                  my $ret = &$callback($_);
                  if( defined $ret ) {
                     push @set, $ret
                  }
               }
            } # else unset tag
            $sgf->setProperty($tag,@set);
         }
      }
   );         
}


sub gameInfo {
   my $self = shift;
   my $isRec = shift; # set if a recursive call
   my $sgf = $$self;
   my( @games );
   # if this is first run 
   $sgf->gotoRoot unless $isRec;
   
   # touch all nodes in this branch
   {
      # check for games and add to @games
      my(@tags) = $sgf->property;
      my $game = {};
      foreach my $t (@tags) {
         if( $sgf->getTagType($t) & $sgf->T_GAME_INFO ) {
            $game->{$t} = $sgf->getProperty($t);
         }
      }
      if( keys %$game ) {
         $games[@games] = $game;
      }
      redo if $sgf->next;
   }

   # touch all variations
   for( my $i = 0; $i < $sgf->branches; $i++ ) {
      #add game info of branch onto our list
      $sgf->gotoBranch($i);
      push @games, $self->gameInfo( 1 );
      $sgf->gotoParent;
   }
   return @games;
}


sub sgf {
   my $self = shift;
   my $sgf = shift;
   if($sgf) {
      $$self = $sgf;#->clone();
      return $sgf;
   }
   $sgf = $$self;
   return $sgf;#->clone();
}
1;
__END__