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