lib/Net/IGS.pm

package Net::IGS;
use strict;

sub new {
   my $class = shift;
   bless { @_, events => { %buildin_events } }, $class;
}

sub init {
   my ($self, $user, $pass) = @_;

   $self->{login_name} = $user;
   $self->{login_pass} = $pass;
   $self->{login} = 1;
   $self->{free_pos} = [];
}

sub set_writer {
   my ($self, $cb) = @_;
   $self->{write} = $cb;
}

sub set_ev_cb {
   my ($self, $event, $cb) = @_;

   if (@{$self->{free_pos}}) {
      my $idx = pop @{$self->{free_pos}};
      $self->{events}->{$event}->[$idx] = $cb;
      return $idx;
      
   } else {
      push @{$self->{events}->{$event}}, $cb;
      return ((scalar @{$self->{events}->{$event}}) - 1);
   }
}

sub unset_ev_cb {
   my ($self, $event, $idx) = @_;

   if ($self->{events}->{$event}->[$idx]) { print "REMOVED $idx\n" }
   $self->{events}->{$event}->[$idx] = undef;
   push @{$self->{free_pos}}, $idx;
}

sub feed_event {
   my ($self, $event, @args) = @_;

   print "EVENT<$event,@args>\n";

   return if not $self->{events}->{$event};

   for (@{$self->{events}->{$event}}) {
      $_->($self, @args) if $_;
   }
}

sub send_queue {
   my $self = shift;

   my $str = pop @{$self->{cmd_queue}}
      or return;

   $self->{write}->($str . "\015\012");

   print "> $str\n";
}

sub sendline {
   my ($self, $str) = @_;
   push @{$self->{cmd_queue}}, $str;

   $self->send_queue
      if delete $self->{can_send};
}

sub req_games     { $_[0]->sendline ('games') }
sub req_players   { $_[0]->sendline ('who') }
sub req_moves     { $_[0]->sendline ("moves $_[1]") }
sub req_observe   { $_[0]->sendline ("observe $_[1]") }
sub req_unobserve { $_[0]->sendline ("unobserve $_[1]") }

sub feed_data {
   my ($self, $data) = @_;

   $self->{buffer} .= $data;

   $self->handle_line ($1) while $self->{buffer} =~ s/^(.*)\015\012//;

   if ($self->{login}) {
      if ($self->{buffer} =~ s/^Login: //) {
         $self->sendline ($self->{login_name});
         $self->{login} = 0;
         $self->send_queue;
      }
   }

}

sub handle_line {
   my ($self, $line) = @_;

   if ($line =~ m/^1 1/) {
      $self->sendline ($self->{login_pass});
      $self->send_queue;

   } elsif ($line =~ m/^5 Invalid password/i) {
      print "wrong password";
      exit (1);

   } elsif ($line =~ m/[89] File/) {

      if ($self->{status} eq 'file') {
         $self->{status} = undef;
         $self->feed_event (recv_file => $self->{files}->{$self->{cur_file}});

      } else {
         $self->{status} = 'file';
         $self->{cur_file}++;
      }

   } elsif ($self->{status} eq 'file') {
      $self->{files}->{$self->{cur_file}} .= $line . "\n";

   } elsif ($line =~ m/^21 \{([^}]+)\}/) {
      my $upd = $1;

      $self->feed_event (info => $upd);
      
      if ($upd =~ m/^Match (\d+):/) {
         $self->feed_event (game_begin => $1);
      } elsif ($upd =~ m/^Game (\d+):\s*(\S+)\s+vs\s+(\S+)\s*:\s*(.+?)\s*$/) {
         $self->feed_event (game_over => $1, $2);
      } elsif ($upd =~ m/^(\S+) has disconnected/) {
         $self->feed_event (player_disconnected => $1);
      } elsif ($upd =~ m/^(\S+) has connected/) {
         $self->feed_event (player_connected => $1);
      }

   } elsif ($line =~ m/^1 [58]/) {
      $self->{can_prompt} = 1;
      $self->send_queue;

   } elsif ($line =~ m/^39 IGS entry on/ || $line =~ m/^IGS entry on/) {
      $self->sendline ("toggle client true");
      $self->sendline ("toggle quiet false");
      $self->feed_event ('logged_on');

   #7 [##]  white name [ rk ]      black name [ rk ] (Move size H Komi BY FR) (###)
   #7 [126]     goholic [ 1d*] vs.        tjam [ 1d*] (270   19  0  0.5 13  I) (  0)
   # "7 [%2d] %11s [%4s] vs. %11s [%4s] (%3d %4d %2d %4.1f %2d %s%s) (%3d)",
   } elsif ($line =~ m/^7 \[##\]/) { # ignore

   } elsif ($line =~ m/^7[ ]
                         \[\s*(\d+)\s*\]
                         \s+ (\S+) \s+ \[\s*(\S+)\s*\] \s+ vs\.
                         \s+ (\S+) \s+ \[\s*(\S+)\s*\] \s+
                         \(\s* (\d+) \s+ (\d+) \s+ (\d+) \s+ (-?\d+\.?\d*) \s+ (\d+) [ ] (.)(.) \s*\)
                         \s+\(\s*(\d+)\s*\)/x) { 
      my $game = { number => $1,
                   white => $2, white_rank => $3,
                   black => $4, black_rank => $5,
                   move => $6, size => $7, handicap => $8, komi => $9, byo => $10, Fflag => $11, Rflag => $12
                 };
      $self->feed_event (game_list => $game);

    #  27  Info       Name       Idle   Rank |  Info       Name       Idle   Rank
    #  27   X --   -- ctian       2m     1k* |   X 11   -- fastt       4m     NR 
   } elsif ($line =~ m/^27[ ]\s*([QRSX! ]+?) \s* ((?:--)|\d+) \s+ ((?:--)|\d+) \s+ (\S+) \s+ (\S+) \s+ (\S+)\s+
                          \| \s+([QRSX! ]+?) \s* ((?:--)|\d+) \s+ ((?:--)|\d+) \s+ (\S+) \s+ (\S+) \s+ (\S+)\s*/x) {
      my $player  = { flags => $1, obs => $2, playing => $3, name =>  $4, idle =>  $5, rank =>  $6 };
      my $player2 = { flags => $7, obs => $8, playing => $9, name => $10, idle => $11, rank => $12 };

      $self->feed_event (player_list => $player);
      $self->feed_event (player_list => $player2);

   } elsif ($line =~ m/^27[ ]\s*([QRSX! ]+?) \s* ((?:--)|\d+) \s+ ((?:--)|\d+) \s+ (\S+) \s+ (\S+) \s+ (\S+)\s*/x) {
      my $player = { flags => $1, obs => $2, playing => $3, name => $4, idle => $5, rank => $6 };

      $self->feed_event (player_list => $player);

   } elsif ($line =~ m/^27[ ] [^|]* \| \s+([QRSX! ]+?) \s* ((?:--)|\d+) \s+ ((?:--)|\d+) \s+ (\S+) \s+ (\S+) \s+ (\S+)\s*/x) {
      my $player = { flags => $1, obs => $2, playing => $3, name => $4, idle => $5, rank => $6 };

      $self->feed_event (player_list => $player);

   } elsif ($line =~ m/^15\s+Game\s+(\d+)\s+\S:\s+ 
                       (\S+) \s+ \( \s*(-?\d+) \s+(-?\d+) \s+(-?\d+) \)\s+vs\s+
                       (\S+) \s+ \( \s*(-?\d+) \s+(-?\d+) \s+(-?\d+) \)/x) {

      print "GAMLI: $line\n";
      $self->{games}->{$1} = { white => $2, white_time => $4, white_stones => $5, white_captures => $4,
                               black => $5, black_time => $8, black_stones => $9, black_captures => $7 };
      $self->{cur_game} = $1;

   } elsif ($line =~ m/^15 \s*(\d+)\((.)\): (\S+)/) {
      print "LIL: ($self->{cur_game}) $line\n";
      my $move = { %{$self->{games}->{$self->{cur_game}}} };

      if ($move) {
         $move->{number} = $1;
         $move->{color} = $2 eq 'W' ? 'white' : 'black';
         $move->{coords} = $3;
         $self->feed_event (game_move => $self->{cur_game}, $move);
      }
   } elsif ($line =~ m/^9 Game is titled:\s*(.+?)\s*$/) {
      $self->{games}->{$self->{cur_game}}->{title} = $1;

      $self->feed_event (game_title => $self->{cur_game}, $1);

   } elsif ($line =~ m/^2 /) {
      # ignore

   } elsif ($line !~ m/^\s*$/) {
      print "<<<" . $line . "<\n";

   }
}

1;

Revision:	1.1
Committed:	Fri Jun 20 12:47:01 2008 UTC (18 years, 3 months ago) by root
Branch:	MAIN
CVS Tags:	HEAD
Log Message:	lib/Net/IGS.pm
#	User	Rev	Content
1	root	1.1	package Net::IGS;
2			use strict;
3
4			sub new {
5			my $class = shift;
6			bless { @_, events => { %buildin_events } }, $class;
7			}
8
9			sub init {
10			my ($self, $user, $pass) = @_;
11
12			$self->{login_name} = $user;
13			$self->{login_pass} = $pass;
14			$self->{login} = 1;
15			$self->{free_pos} = [];
16			}
17
18			sub set_writer {
19			my ($self, $cb) = @_;
20			$self->{write} = $cb;
21			}
22
23			sub set_ev_cb {
24			my ($self, $event, $cb) = @_;
25
26			if (@{$self->{free_pos}}) {
27			my $idx = pop @{$self->{free_pos}};
28			$self->{events}->{$event}->[$idx] = $cb;
29			return $idx;
30
31			} else {
32			push @{$self->{events}->{$event}}, $cb;
33			return ((scalar @{$self->{events}->{$event}}) - 1);
34			}
35			}
36
37			sub unset_ev_cb {
38			my ($self, $event, $idx) = @_;
39
40			if ($self->{events}->{$event}->[$idx]) { print "REMOVED $idx\n" }
41			$self->{events}->{$event}->[$idx] = undef;
42			push @{$self->{free_pos}}, $idx;
43			}
44
45			sub feed_event {
46			my ($self, $event, @args) = @_;
47
48			print "EVENT<$event,@args>\n";
49
50			return if not $self->{events}->{$event};
51
52			for (@{$self->{events}->{$event}}) {
53			$_->($self, @args) if $_;
54			}
55			}
56
57			sub send_queue {
58			my $self = shift;
59
60			my $str = pop @{$self->{cmd_queue}}
61			or return;
62
63			$self->{write}->($str . "\015\012");
64
65			print "> $str\n";
66			}
67
68			sub sendline {
69			my ($self, $str) = @_;
70			push @{$self->{cmd_queue}}, $str;
71
72			$self->send_queue
73			if delete $self->{can_send};
74			}
75
76			sub req_games { $_[0]->sendline ('games') }
77			sub req_players { $_[0]->sendline ('who') }
78			sub req_moves { $_[0]->sendline ("moves $_[1]") }
79			sub req_observe { $_[0]->sendline ("observe $_[1]") }
80			sub req_unobserve { $_[0]->sendline ("unobserve $_[1]") }
81
82			sub feed_data {
83			my ($self, $data) = @_;
84
85			$self->{buffer} .= $data;
86
87			$self->handle_line ($1) while $self->{buffer} =~ s/^(.*)\015\012//;
88
89			if ($self->{login}) {
90			if ($self->{buffer} =~ s/^Login: //) {
91			$self->sendline ($self->{login_name});
92			$self->{login} = 0;
93			$self->send_queue;
94			}
95			}
96
97			}
98
99			sub handle_line {
100			my ($self, $line) = @_;
101
102			if ($line =~ m/^1 1/) {
103			$self->sendline ($self->{login_pass});
104			$self->send_queue;
105
106			} elsif ($line =~ m/^5 Invalid password/i) {
107			print "wrong password";
108			exit (1);
109
110			} elsif ($line =~ m/[89] File/) {
111
112			if ($self->{status} eq 'file') {
113			$self->{status} = undef;
114			$self->feed_event (recv_file => $self->{files}->{$self->{cur_file}});
115
116			} else {
117			$self->{status} = 'file';
118			$self->{cur_file}++;
119			}
120
121			} elsif ($self->{status} eq 'file') {
122			$self->{files}->{$self->{cur_file}} .= $line . "\n";
123
124			} elsif ($line =~ m/^21 \{([^}]+)\}/) {
125			my $upd = $1;
126
127			$self->feed_event (info => $upd);
128
129			if ($upd =~ m/^Match (\d+):/) {
130			$self->feed_event (game_begin => $1);
131			} elsif ($upd =~ m/^Game (\d+):\s(\S+)\s+vs\s+(\S+)\s:\s(.+?)\s$/) {
132			$self->feed_event (game_over => $1, $2);
133			} elsif ($upd =~ m/^(\S+) has disconnected/) {
134			$self->feed_event (player_disconnected => $1);
135			} elsif ($upd =~ m/^(\S+) has connected/) {
136			$self->feed_event (player_connected => $1);
137			}
138
139			} elsif ($line =~ m/^1 [58]/) {
140			$self->{can_prompt} = 1;
141			$self->send_queue;
142
143			} elsif ($line =~ m/^39 IGS entry on/ \|\| $line =~ m/^IGS entry on/) {
144			$self->sendline ("toggle client true");
145			$self->sendline ("toggle quiet false");
146			$self->feed_event ('logged_on');
147
148			#7 [##] white name [ rk ] black name [ rk ] (Move size H Komi BY FR) (###)
149			#7 [126] goholic [ 1d] vs. tjam [ 1d] (270 19 0 0.5 13 I) ( 0)
150			# "7 [%2d] %11s [%4s] vs. %11s [%4s] (%3d %4d %2d %4.1f %2d %s%s) (%3d)",
151			} elsif ($line =~ m/^7 \[##\]/) { # ignore
152
153			} elsif ($line =~ m/^7[ ]
154			\[\s(\d+)\s\]
155			\s+ (\S+) \s+ \[\s(\S+)\s\] \s+ vs\.
156			\s+ (\S+) \s+ \[\s(\S+)\s\] \s+
157			\(\s* (\d+) \s+ (\d+) \s+ (\d+) \s+ (-?\d+\.?\d) \s+ (\d+) [ ] (.)(.) \s\)
158			\s+\(\s(\d+)\s\)/x) {
159			my $game = { number => $1,
160			white => $2, white_rank => $3,
161			black => $4, black_rank => $5,
162			move => $6, size => $7, handicap => $8, komi => $9, byo => $10, Fflag => $11, Rflag => $12
163			};
164			$self->feed_event (game_list => $game);
165
166			# 27 Info Name Idle Rank \| Info Name Idle Rank
167			# 27 X -- -- ctian 2m 1k* \| X 11 -- fastt 4m NR
168			} elsif ($line =~ m/^27[ ]\s([QRSX! ]+?) \s ((?:--)\|\d+) \s+ ((?:--)\|\d+) \s+ (\S+) \s+ (\S+) \s+ (\S+)\s+
169			\\| \s+([QRSX! ]+?) \s* ((?:--)\|\d+) \s+ ((?:--)\|\d+) \s+ (\S+) \s+ (\S+) \s+ (\S+)\s*/x) {
170			my $player = { flags => $1, obs => $2, playing => $3, name => $4, idle => $5, rank => $6 };
171			my $player2 = { flags => $7, obs => $8, playing => $9, name => $10, idle => $11, rank => $12 };
172
173			$self->feed_event (player_list => $player);
174			$self->feed_event (player_list => $player2);
175
176			} elsif ($line =~ m/^27[ ]\s([QRSX! ]+?) \s ((?:--)\|\d+) \s+ ((?:--)\|\d+) \s+ (\S+) \s+ (\S+) \s+ (\S+)\s*/x) {
177			my $player = { flags => $1, obs => $2, playing => $3, name => $4, idle => $5, rank => $6 };
178
179			$self->feed_event (player_list => $player);
180
181			} elsif ($line =~ m/^27[ ] [^\|]* \\| \s+([QRSX! ]+?) \s* ((?:--)\|\d+) \s+ ((?:--)\|\d+) \s+ (\S+) \s+ (\S+) \s+ (\S+)\s*/x) {
182			my $player = { flags => $1, obs => $2, playing => $3, name => $4, idle => $5, rank => $6 };
183
184			$self->feed_event (player_list => $player);
185
186			} elsif ($line =~ m/^15\s+Game\s+(\d+)\s+\S:\s+
187			(\S+) \s+ \( \s*(-?\d+) \s+(-?\d+) \s+(-?\d+) \)\s+vs\s+
188			(\S+) \s+ \( \s*(-?\d+) \s+(-?\d+) \s+(-?\d+) \)/x) {
189
190			print "GAMLI: $line\n";
191			$self->{games}->{$1} = { white => $2, white_time => $4, white_stones => $5, white_captures => $4,
192			black => $5, black_time => $8, black_stones => $9, black_captures => $7 };
193			$self->{cur_game} = $1;
194
195			} elsif ($line =~ m/^15 \s*(\d+)\((.)\): (\S+)/) {
196			print "LIL: ($self->{cur_game}) $line\n";
197			my $move = { %{$self->{games}->{$self->{cur_game}}} };
198
199			if ($move) {
200			$move->{number} = $1;
201			$move->{color} = $2 eq 'W' ? 'white' : 'black';
202			$move->{coords} = $3;
203			$self->feed_event (game_move => $self->{cur_game}, $move);
204			}
205			} elsif ($line =~ m/^9 Game is titled:\s(.+?)\s$/) {
206			$self->{games}->{$self->{cur_game}}->{title} = $1;
207
208			$self->feed_event (game_title => $self->{cur_game}, $1);
209
210			} elsif ($line =~ m/^2 /) {
211			# ignore
212
213			} elsif ($line !~ m/^\s*$/) {
214			print "<<<" . $line . "<\n";
215
216			}
217			}
218
219			1;
220