3 # Quick and nasty script to load a game record and play it
4 # through via a FICS server.
6 # Anthony Wesley and Andrew Tridgell, July 2004
8 # Usage: play2.pl server client1/passwd1 client2/passwd2
10 # Reads game records on stdin.
15 my $server = shift @ARGV;
16 my ($client1,$pass1) = split(/\//, shift @ARGV);
17 my ($client2,$pass2) = split(/\//, shift @ARGV);
19 print "Connecting to $server , port 5000\n";
20 print "[$client1 / $pass1 ] , [$client2 / $pass2 ]\n";
22 my $S1 = new IO::Socket::INET(
27 ) or die "Could not connect";
29 my $S2 = new IO::Socket::INET(
34 ) or die "Could not connect";
36 $S1->setsockopt(&Socket::IPPROTO_TCP, &Socket::TCP_NODELAY, 1) || die;
37 $S2->setsockopt(&Socket::IPPROTO_TCP, &Socket::TCP_NODELAY, 1) || die;
39 print "Connection opened. Logging in...\n";
41 Login($S1,$client1,$pass1) or die "Could not login $client1";
42 Login($S2,$client2,$pass2) or die "Could not login $client2";
48 # ensure we don't have any left over games
49 $S1->print("resign $client2\n");
51 print "Reading game record from stdin...\n";
53 my $game_comment = "";
56 while(my $line = <STDIN>) {
58 if ($line =~ /^\[/ || $line eq "") {
60 $game_comment .= "$line\n";
63 $game = extract_moves($game);
65 print "Starting game $game_num\n";
66 PlayGame($S1,$S2,$game);
80 Challenge($s1,$client1,$s2,$client2) or die "Could not setup game";
82 my $res = Play($s1, $s2, $game);
84 $s1->print("resign\n");
86 print "Writing bad game - $res\n";
89 open(FILE, ">>badgames.txt") || die "can't open badgames.txt";
90 print FILE "[$res]\n$game\n\n";
94 WaitFor($s1, "$client1 vs. $client2");
95 WaitFor($s2, "$client1 vs. $client2");
97 WaitFor($s1, "No ratings adjustment done");
98 WaitFor($s2, "No ratings adjustment done");
108 $s->print($name . "\n");
109 $s->print($pass . "\n");
110 $s->print("set style 12\n\n");
120 my @lines = split(/[\n\r]+/, $txt);
121 foreach my $l (@lines) {
123 $l =~ s/^\s+//; $l =~ s/\s+$//;
126 next if $l =~ /^\s+\[/;
128 # Maybe contains moves?
132 # Strip out the move numbers
133 # $moves =~ s/\d+\.\s+//g;
140 my $s1 = shift; # socket for client1
141 my $client1 = shift; # username for initiator
142 my $s2 = shift; # socket for receipient
143 my $client2 = shift; # name of receipient
145 $s1->print("match $client2 1 1 w u\n");
147 WaitFor($s1, "Issuing: $client1");
148 WaitFor($s2, "Challenge: $client1");
149 WaitFor($s2, "You can \"accept\"");
150 $s2->print("accept\n");
151 WaitFor($s2,"You accept the challenge of $client1");
152 WaitFor($s1,"$client2 accepts your challenge");
153 WaitFor($s1,"Creating: $client1");
154 WaitFor($s1,".$client1 vs. $client2. Creating");
155 WaitFor($s2,"Creating: $client1");
156 WaitFor($s2,".$client1 vs. $client2. Creating");
167 my $who_to_move = "w";
168 my @moves = split(/\s+/, $game);
173 CheckMove($s1,"none") || return "Initialisation failed for white";
174 CheckMove($s2,"none") || return "Initialisation failed for black";
176 foreach my $m (@moves) {
177 next if ($m =~ /^\d/);
178 last if ($m =~ /^\[/);
181 if ($who_to_move eq "w") {
184 # print "White moves $movenum. $m\n";
188 # print "Black moves $movenum ... $m\n";
193 $res = CheckMove($p1,$m);
195 return "Failed on move $movenum - $res";
198 $res = CheckMove($p2,$m);
200 return "Failed on move $movenum - $res";
204 if ($who_to_move eq "b") {
213 if ($who_to_move eq "w") {
227 $s->print($m . "\n");
238 while ($l = $s->getline) {
240 # print "line3=\n[[[$l\n]]]\n";
241 if ($l =~ /^\s+fics%\s+$/) {
247 if ($l =~ /Illegal Move/i) {
248 return "Server reports illegal move $m";
250 if ($l =~ /Ambiguous Move/i) {
251 return "Server reports ambiguous move $m";
253 my $rmove = ParseStyle12($l);
258 if (!MoveEqual($rmove,$m)) {
259 return "wrong RecvMove $rmove should be $m";
264 return "eof from server";
271 if ($s =~ /\<12\>.*\(\d+\:\d\d\)\s(\S+)/m) {
282 $s->print("resign\n");
290 # remove check and good move markers
291 if ($m1 =~ /^(.*)[+!]/) {
295 if ($m2 =~ /^(.*)[+!]/) {
312 while (my $l = $s->getline) {
315 # print "GOT: $str\n";
318 if ($l =~ /^\s+fics%\s+$/) {