[ViewVC] Contents of: cvs/kgsueme/bin/kgs-igs

#!/opt/bin/perl

# lots of things have been hardcoded. search for #d# to find the places

require 5.008;

use KGS::Protocol;
use KGS::Listener::Debug;

use IO::Socket::INET;
use Event;

use Getopt::Long;
use Carp;

our $VERSION = '0.0'; # be more confident....

$SIG{QUIT} = sub { Carp::confess "SIGQUIT" };

my $conn = new KGS::Protocol;
my $kgs;
my $igs;

my $verbose = 1;
my $user;
my $pass;

$Event::DIED = sub {
   Event::verbose_exception_handler (@_);
   Event::unloop_all;
};

sub rank($) {
   return "NR" if !$_[0]->is_ranked || !$_[0]->rank;
   return $_[0]->rank
          . ($_[0]->is_reliable ? "*" : "");
}

sub format_user($) {
   my $format =
      sprintf "%s|%s|%s",
         $_[0]{name},
         $_[0]->flags_string,
         $_[0]->rank_string;

   $format =~ y/ //d;
   $format;
}

sub coord($$) {
   qw(A B C D E F G H J K L M N O P Q R S T U V W X Y Z)[$_[0]] . $_[1];
}

#############################################################################

package kgs;

use base KGS::Listener;

sub new {
   my $class = shift;
   my $self = bless { @_ }, $class;

   print STDERR "$0 version $VERSION connecting...\n" if $verbose;

   my $sock = new IO::Socket::INET PeerHost => KGS::Protocol::KGSHOST, PeerPort => KGS::Protocol::KGSPORT
      or die "connect: $!";

   $sock->blocking (1);
   $conn->handshake ($sock);

   $self->listen ($conn, "any");

   # Listener for kgs data
   $self->{w} = Event->io (fd => $sock, poll => 'r', cb => sub {
      my $len = sysread $sock, my $buf, 16384;
      if ($len) {
         $conn->feed_data ($buf);
      } elsif (defined $len || (!$!{EINTR} and !$!{EAGAIN})) {
         print STDERR "disconnected\n" if $verbose;
         Event::unloop;
      }
   });

   $conn->login ("kgs-igs $VERSION", $self->{user}, delete $self->{password});

   $self;
}

sub inject_login {
   my ($self, $msg) = @_;

   print STDERR "login: $msg->{message}\n" if $verbose >= 2;

   if ($msg->{success}) {
      $igs->login_ok ($msg->{message});
   } else {
      $igs->login_failed ($msg->{message});
   }
}

sub inject_msg_room {
   my ($self, $msg) = @_;

   #use PApp::Util; warn PApp::Util::dumpval $msg;#d#
   $igs->send ("21 !$msg->{name}!: $msg->{message}");
}

sub inject_any {
   my ($self, $msg) = @_;
   if ($verbose >= 2) {
      print STDERR "DEBUG: $msg->{type}#$msg->{channel}";
      for (sort keys %$msg) {
         print  STDERR"   $_<$msg->{$_}>";
      }
      print STDERR "\n";
   }
}

sub inject_upd_rooms {
   my ($self, $msg) = @_;

   for (@{$msg->{rooms}}) {
#      $gtp->send ("kgs-room-update $_->{channel} $_->{name}");
   }
}

sub inject_msg_chat {
   my ($self, $msg) = @_;

   return unless (lc $self->{conn}{name}) eq (lc $msg->{name2});

#   $gtp->send ("kgs-user-chat $msg->{name} $msg->{message}");
}

sub inject_new_game {
   my ($self, $msg) = @_;

   $::lastnew = $msg->{channel};#d#
#   $gtp->send ("kgs-game-new $msg->{id} $msg->{channel}");
}

#############################################################################

package room;

use base KGS::Listener::Room;

sub new {
   my $class = shift;
   my $self = $class->SUPER::new (conn => $conn, @_);

   $self->listen ($self->{conn});
   $self->join;

   $self;
}

sub event_join {
   my $self = shift;

   $self->SUPER::join (@_);

   $self->{timer} = Event->timer (after => 0, interval => 60, cb => sub {
      $self->req_games;
   });
}

sub event_update_games {
   my ($self, $add, $upd, $del) = @_;

#   for (@$add, @$upd) {
#      $gtp->send (sprintf "kgs-game-update %d %d %s %s %s %s %d %d %f %d %d %d %d %s",
#                  $self->{channel}, $_->{channel},
#                  $_->type_char,
#                  ::format_user $_->{user1},
#                  ::format_user $_->{user2},
#                  ::format_user $_->{user3},
#                  $_->size,
#                  $_->{handicap},
#                  $_->{komi},
#                  $_->moves,
#                  $_->{flags},
#                  $_->{observers},
#                  $_->{saved},
#                  $_->{notes},
#      );
#   }
#
#   for (@$del) {
#      $gtp->send ("kgs-game-delete $self->{channel} $_->{channel}");
#   }
}

sub event_update_users {
   my ($self, $add, $upd, $del) = @_;

#   for (@$add, @$upd) {
#      $gtp->send (sprintf "kgs-user-update %s", ::format_user $_);
#   }
#
#   for (@$del) {
#      $gtp->send (sprintf "kgs-user-remove %s", ::format_user $_);
#   }
}

sub DESTROY {
   my $self = shift;

   $self->{timer}->cancel if $self->{timer};

   $self->SUPER::DESTROY;
}

#############################################################################

package game;

use Gtk2::GoBoard::Constants;

use base KGS::Listener::Game;

sub new {
   my $class = shift;
   my $self = $class->SUPER::new (conn => $conn, @_);

   $self->listen ($self->{conn});
   $self->join;

   $self;
}

sub event_update_users {
   return;

   my ($self, $add, $upd, $del) = @_;

   for (@$add, @$upd) {
      $gtp->send (sprintf "kgs-user-update %s", ::format_user $_);
   }

   for (@$del) {
      $gtp->send (sprintf "kgs-user-remove %s", ::format_user $_);
   }
}

sub inject_resign_game {
   my ($self, $msg) = @_;

   $gtp->set_gid ($self->{channel});
   $gtp->send ("play " . (qw(b w))[$msg->{player}] . " resign");
}

sub inject_final_result {
   my ($self, $msg) = @_;

   $gtp->send (sprintf "kgs-game-score %f %f %f %f %f %f",
               $_->{whitescore}{territory}, $_->{whitescore}{captures}, $_->{whitescore}{komi},
               $_->{blackscore}{territory}, $_->{blackscore}{captures}, $_->{blackscore}{komi});
}

sub inject_set_teacher {
   my ($self, $msg) = @_;
}

sub event_update_game {
   my ($self) = @_;

   $gtp->set_gid ($self->{channel});

   # timesettings etc.
}

sub event_update_tree {
   my ($self) = @_;

   $gtp->set_gid ($self->{channel});

   my $path = $self->get_path;
   my $prev = $self->{prevpath};

   $self->{prevpath} = [ @$path ];

   if (@$prev > 1
       and @$path > @$prev
       and (join ":", @$prev) eq (join ":", @$path[0 .. $#$prev])) {

      splice @$path, @prev, $#path, ();

   } else {
      $gtp->send ("boardsize $path->[0]{rules}{size}");
      $gtp->send ("komi $path->[0]{rules}{komi}");
      $gtp->send ("clear_board");

      my $setup = shift @$path;
      my $handi;

      while (my ($k, $v) = each %$setup) {
         if ($k =~ /^(\d+),(\d+)$/) {
            $handi .= " " . ::coord $1, $2;
         }
      }

      $gtp->send ("set_free_handicap$handi");
   }

   for (@$path) {
      while (my ($k, $v) = each %$_) {
         if ($k =~ /^(\d+),(\d+)$/) {
            if ($v->[0] & MARK_MOVE) {
               if ($v->[0] & MARK_B) {
                  $gtp->send ("play b ". ::coord $1, $2);
               } else {
                  $gtp->send ("play w ". ::coord $1, $2);
               }
            }
         }
      }
   }
}

sub DESTROY {
   my $self = shift;

   $self->SUPER::DESTROY;
}

#############################################################################

package igs;

use Gtk2::GoBoard::Constants;
use KGS::Constants;

use Fcntl;

sub new {
   my $class = shift;
   my $self = bless { @_ }, $class;

   my $buf;
   $self->{w} = Event->io (fd => $self->{fh}, poll => 'r', cb => sub {
      0 < sysread $self->{fh}, $buf, 4096, length $buf
         or Event::unloop -1;

      #$buf =~ y/\x00-\x09\x0b-\x0c\x0e-\x1f\x80-\xff//d;
      while ($buf =~ s/^([^\015\012]*)\015?\012//) {
         $self->{feed}->($1);
      }
   });

   syswrite $self->{fh}, "##########################################################\r\n" for 1..1;
   sleep 1; # required for amny clients :/
   syswrite $self->{fh}, "Login: ";

   $self->{feed} = sub {
      my $user = $_[0];
      print "login<$user>\n";
      #$self->send ("\377\373\1");
      $self->send ("1 1");
      $self->{feed} = sub {
         warn "pass <$_[0]>\n";#d#
         $kgs = new kgs user => $user, password => $_[0] eq "guest" ? "" : $_[0];

         $self->{feed} = sub { };
      }
   };

   $self;
}

sub send {
   my ($self, $cmd) = @_;

   print "SEND<$cmd>\n";#d#
   syswrite $self->{fh}, "$cmd\015\012";
}

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

   warn "GOT<$line>\n";#d#

   if ($line =~ /^ga/) { # gamelist
      $self->send ("7 [##]  white name [ rk ]      black name [ rk ] (Move size H Komi BY FR) (###)");
      if ($self->{room}) {
         for (values %{$self->{room}{games} || {}}) {
            next if $_->{size} <= 0 || $_->{moves} <= 0 || $_->{handicap} < 0 || $_->is_scored;

            $self->send (sprintf
                  "7 [%d] %11s [%4s] vs. %11s [%4s] (%3d %4d %2d %3.1f %2d %s%s) (%3d)",
                  $_->{channel},
                  $_->{user2}{name}, ::rank $_->{user2},
                  $_->{user1}{name}, ::rank $_->{user1},
                  $_->{moves},
                  $_->{size},
                  $_->{handicap},
                  $_->{komi},
                  0, "F", "I",
                  $_->{observers});
         }
      }
   } elsif ($line =~ /^chan/) { # channels
      $self->send ("9 #13 Title: English Game Room -- Open");

   } elsif ($line =~ /^(y\S*|;)\s*/g) { # yell
      my $channel = $self->{channel};
      $channel = $1 if $line =~ /\\(\d+)\s*/gc;

      if ($self->{channel} != $channel) {
         $self->{channel} = $channel;
         (delete $self->{room})->part if $self->{room};

         if ($channel > 0) {
            $self->{room} = new room channel => $channel;
            $self->send ("32 Changing into channel $channel.");
            $self->send ("32 Welcome to cyberspace.");#maybe title##d#

         }
      }

      if ($channel > 0) {
         # msg_chat to room
      }
   } else {
      $self->send ("5 Unknown command.");
   }

   $self->send ("1 5");

}

sub login_ok {
   my ($self, $msg) = @_;

   $self->{feed} = sub { $self->feed ($_[0]) };
   #$self->send ("39 IGS entry on 05 - 26 - 2004");
   #$self->send ("9 File"); # motd

   $self->send ("9 File");
   $self->send (" $msg");
   $self->send ("9 File");
   $self->send ("1 5");

   $self->{room} = new room channel => 13; # auto-join english room #d#
}

sub login_failed {
   my ($self, $msg) = @_;

   $self->send ("5 $msg");
   Event::unloop -1;
}

package main;

sub usage {
   print STDERR <<EOF;
Usage: $0 [options] port
           -v             increase verbosity
           -q             decrease verbosity

EOF
   exit shift;
}

GetOptions (
      "v"   => sub { $verbose++ },
      "q"   => sub { $verbose-- },
      "h"   => sub { usage(0) },
) or die usage(1);

my $port = $ARGV[0] || 6969;

my $socket = new IO::Socket::INET LocalPort => $port, Listen => 1, ReuseAddr => 1,
   or die "cannot create listening socket on port $port: $!";

print "Listening on 127.0.0.1:$port, please connect to it using your igs client.\n";

while (my $fh = $socket->accept) {
   if (fork == 0) {
      $igs = new igs fh => $fh;

      Event::loop;
      exit 0;
   }
}

1;


Revision:	1.1
Committed:	Wed May 26 03:28:36 2004 UTC (20 years ago) by pcg
Branch:	MAIN
Log Message:	* empty log message *
#	Content
1	#!/opt/bin/perl
2
3	# lots of things have been hardcoded. search for #d# to find the places
4
5	require 5.008;
6
7	use KGS::Protocol;
8	use KGS::Listener::Debug;
9
10	use IO::Socket::INET;
11	use Event;
12
13	use Getopt::Long;
14	use Carp;
15
16	our $VERSION = '0.0'; # be more confident....
17
18	$SIG{QUIT} = sub { Carp::confess "SIGQUIT" };
19
20	my $conn = new KGS::Protocol;
21	my $kgs;
22	my $igs;
23
24	my $verbose = 1;
25	my $user;
26	my $pass;
27
28	$Event::DIED = sub {
29	Event::verbose_exception_handler (@_);
30	Event::unloop_all;
31	};
32
33	sub rank($) {
34	return "NR" if !$_[0]->is_ranked \|\| !$_[0]->rank;
35	return $_[0]->rank
36	. ($_[0]->is_reliable ? "*" : "");
37	}
38
39	sub format_user($) {
40	my $format =
41	sprintf "%s\|%s\|%s",
42	$_[0]{name},
43	$_[0]->flags_string,
44	$_[0]->rank_string;
45
46	$format =~ y/ //d;
47	$format;
48	}
49
50	sub coord($$) {
51	qw(A B C D E F G H J K L M N O P Q R S T U V W X Y Z)[$_[0]] . $_[1];
52	}
53
54	#############################################################################
55
56	package kgs;
57
58	use base KGS::Listener;
59
60	sub new {
61	my $class = shift;
62	my $self = bless { @_ }, $class;
63
64	print STDERR "$0 version $VERSION connecting...\n" if $verbose;
65
66	my $sock = new IO::Socket::INET PeerHost => KGS::Protocol::KGSHOST, PeerPort => KGS::Protocol::KGSPORT
67	or die "connect: $!";
68
69	$sock->blocking (1);
70	$conn->handshake ($sock);
71
72	$self->listen ($conn, "any");
73
74	# Listener for kgs data
75	$self->{w} = Event->io (fd => $sock, poll => 'r', cb => sub {
76	my $len = sysread $sock, my $buf, 16384;
77	if ($len) {
78	$conn->feed_data ($buf);
79	} elsif (defined $len \|\| (!$!{EINTR} and !$!{EAGAIN})) {
80	print STDERR "disconnected\n" if $verbose;
81	Event::unloop;
82	}
83	});
84
85	$conn->login ("kgs-igs $VERSION", $self->{user}, delete $self->{password});
86
87	$self;
88	}
89
90	sub inject_login {
91	my ($self, $msg) = @_;
92
93	print STDERR "login: $msg->{message}\n" if $verbose >= 2;
94
95	if ($msg->{success}) {
96	$igs->login_ok ($msg->{message});
97	} else {
98	$igs->login_failed ($msg->{message});
99	}
100	}
101
102	sub inject_msg_room {
103	my ($self, $msg) = @_;
104
105	#use PApp::Util; warn PApp::Util::dumpval $msg;#d#
106	$igs->send ("21 !$msg->{name}!: $msg->{message}");
107	}
108
109	sub inject_any {
110	my ($self, $msg) = @_;
111	if ($verbose >= 2) {
112	print STDERR "DEBUG: $msg->{type}#$msg->{channel}";
113	for (sort keys %$msg) {
114	print STDERR" $_<$msg->{$_}>";
115	}
116	print STDERR "\n";
117	}
118	}
119
120	sub inject_upd_rooms {
121	my ($self, $msg) = @_;
122
123	for (@{$msg->{rooms}}) {
124	# $gtp->send ("kgs-room-update $_->{channel} $_->{name}");
125	}
126	}
127
128	sub inject_msg_chat {
129	my ($self, $msg) = @_;
130
131	return unless (lc $self->{conn}{name}) eq (lc $msg->{name2});
132
133	# $gtp->send ("kgs-user-chat $msg->{name} $msg->{message}");
134	}
135
136	sub inject_new_game {
137	my ($self, $msg) = @_;
138
139	$::lastnew = $msg->{channel};#d#
140	# $gtp->send ("kgs-game-new $msg->{id} $msg->{channel}");
141	}
142
143	#############################################################################
144
145	package room;
146
147	use base KGS::Listener::Room;
148
149	sub new {
150	my $class = shift;
151	my $self = $class->SUPER::new (conn => $conn, @_);
152
153	$self->listen ($self->{conn});
154	$self->join;
155
156	$self;
157	}
158
159	sub event_join {
160	my $self = shift;
161
162	$self->SUPER::join (@_);
163
164	$self->{timer} = Event->timer (after => 0, interval => 60, cb => sub {
165	$self->req_games;
166	});
167	}
168
169	sub event_update_games {
170	my ($self, $add, $upd, $del) = @_;
171
172	# for (@$add, @$upd) {
173	# $gtp->send (sprintf "kgs-game-update %d %d %s %s %s %s %d %d %f %d %d %d %d %s",
174	# $self->{channel}, $_->{channel},
175	# $_->type_char,
176	# ::format_user $_->{user1},
177	# ::format_user $_->{user2},
178	# ::format_user $_->{user3},
179	# $_->size,
180	# $_->{handicap},
181	# $_->{komi},
182	# $_->moves,
183	# $_->{flags},
184	# $_->{observers},
185	# $_->{saved},
186	# $_->{notes},
187	# );
188	# }
189	#
190	# for (@$del) {
191	# $gtp->send ("kgs-game-delete $self->{channel} $_->{channel}");
192	# }
193	}
194
195	sub event_update_users {
196	my ($self, $add, $upd, $del) = @_;
197
198	# for (@$add, @$upd) {
199	# $gtp->send (sprintf "kgs-user-update %s", ::format_user $_);
200	# }
201	#
202	# for (@$del) {
203	# $gtp->send (sprintf "kgs-user-remove %s", ::format_user $_);
204	# }
205	}
206
207	sub DESTROY {
208	my $self = shift;
209
210	$self->{timer}->cancel if $self->{timer};
211
212	$self->SUPER::DESTROY;
213	}
214
215	#############################################################################
216
217	package game;
218
219	use Gtk2::GoBoard::Constants;
220
221	use base KGS::Listener::Game;
222
223	sub new {
224	my $class = shift;
225	my $self = $class->SUPER::new (conn => $conn, @_);
226
227	$self->listen ($self->{conn});
228	$self->join;
229
230	$self;
231	}
232
233	sub event_update_users {
234	return;
235
236	my ($self, $add, $upd, $del) = @_;
237
238	for (@$add, @$upd) {
239	$gtp->send (sprintf "kgs-user-update %s", ::format_user $_);
240	}
241
242	for (@$del) {
243	$gtp->send (sprintf "kgs-user-remove %s", ::format_user $_);
244	}
245	}
246
247	sub inject_resign_game {
248	my ($self, $msg) = @_;
249
250	$gtp->set_gid ($self->{channel});
251	$gtp->send ("play " . (qw(b w))[$msg->{player}] . " resign");
252	}
253
254	sub inject_final_result {
255	my ($self, $msg) = @_;
256
257	$gtp->send (sprintf "kgs-game-score %f %f %f %f %f %f",
258	$_->{whitescore}{territory}, $_->{whitescore}{captures}, $_->{whitescore}{komi},
259	$_->{blackscore}{territory}, $_->{blackscore}{captures}, $_->{blackscore}{komi});
260	}
261
262	sub inject_set_teacher {
263	my ($self, $msg) = @_;
264	}
265
266	sub event_update_game {
267	my ($self) = @_;
268
269	$gtp->set_gid ($self->{channel});
270
271	# timesettings etc.
272	}
273
274	sub event_update_tree {
275	my ($self) = @_;
276
277	$gtp->set_gid ($self->{channel});
278
279	my $path = $self->get_path;
280	my $prev = $self->{prevpath};
281
282	$self->{prevpath} = [ @$path ];
283
284	if (@$prev > 1
285	and @$path > @$prev
286	and (join ":", @$prev) eq (join ":", @$path[0 .. $#$prev])) {
287
288	splice @$path, @prev, $#path, ();
289
290	} else {
291	$gtp->send ("boardsize $path->[0]{rules}{size}");
292	$gtp->send ("komi $path->[0]{rules}{komi}");
293	$gtp->send ("clear_board");
294
295	my $setup = shift @$path;
296	my $handi;
297
298	while (my ($k, $v) = each %$setup) {
299	if ($k =~ /^(\d+),(\d+)$/) {
300	$handi .= " " . ::coord $1, $2;
301	}
302	}
303
304	$gtp->send ("set_free_handicap$handi");
305	}
306
307	for (@$path) {
308	while (my ($k, $v) = each %$_) {
309	if ($k =~ /^(\d+),(\d+)$/) {
310	if ($v->[0] & MARK_MOVE) {
311	if ($v->[0] & MARK_B) {
312	$gtp->send ("play b ". ::coord $1, $2);
313	} else {
314	$gtp->send ("play w ". ::coord $1, $2);
315	}
316	}
317	}
318	}
319	}
320	}
321
322	sub DESTROY {
323	my $self = shift;
324
325	$self->SUPER::DESTROY;
326	}
327
328	#############################################################################
329
330	package igs;
331
332	use Gtk2::GoBoard::Constants;
333	use KGS::Constants;
334
335	use Fcntl;
336
337	sub new {
338	my $class = shift;
339	my $self = bless { @_ }, $class;
340
341	my $buf;
342	$self->{w} = Event->io (fd => $self->{fh}, poll => 'r', cb => sub {
343	0 < sysread $self->{fh}, $buf, 4096, length $buf
344	or Event::unloop -1;
345
346	#$buf =~ y/\x00-\x09\x0b-\x0c\x0e-\x1f\x80-\xff//d;
347	while ($buf =~ s/^([^\015\012]*)\015?\012//) {
348	$self->{feed}->($1);
349	}
350	});
351
352	syswrite $self->{fh}, "##########################################################\r\n" for 1..1;
353	sleep 1; # required for amny clients :/
354	syswrite $self->{fh}, "Login: ";
355
356	$self->{feed} = sub {
357	my $user = $_[0];
358	print "login<$user>\n";
359	#$self->send ("\377\373\1");
360	$self->send ("1 1");
361	$self->{feed} = sub {
362	warn "pass <$_[0]>\n";#d#
363	$kgs = new kgs user => $user, password => $_[0] eq "guest" ? "" : $_[0];
364
365	$self->{feed} = sub { };
366	}
367	};
368
369	$self;
370	}
371
372	sub send {
373	my ($self, $cmd) = @_;
374
375	print "SEND<$cmd>\n";#d#
376	syswrite $self->{fh}, "$cmd\015\012";
377	}
378
379	sub feed {
380	my ($self, $line) = @_;
381
382	warn "GOT<$line>\n";#d#
383
384	if ($line =~ /^ga/) { # gamelist
385	$self->send ("7 [##] white name [ rk ] black name [ rk ] (Move size H Komi BY FR) (###)");
386	if ($self->{room}) {
387	for (values %{$self->{room}{games} \|\| {}}) {
388	next if $_->{size} <= 0 \|\| $_->{moves} <= 0 \|\| $_->{handicap} < 0 \|\| $_->is_scored;
389
390	$self->send (sprintf
391	"7 [%d] %11s [%4s] vs. %11s [%4s] (%3d %4d %2d %3.1f %2d %s%s) (%3d)",
392	$_->{channel},
393	$_->{user2}{name}, ::rank $_->{user2},
394	$_->{user1}{name}, ::rank $_->{user1},
395	$_->{moves},
396	$_->{size},
397	$_->{handicap},
398	$_->{komi},
399	0, "F", "I",
400	$_->{observers});
401	}
402	}
403	} elsif ($line =~ /^chan/) { # channels
404	$self->send ("9 #13 Title: English Game Room -- Open");
405
406	} elsif ($line =~ /^(y\S\|;)\s/g) { # yell
407	my $channel = $self->{channel};
408	$channel = $1 if $line =~ /\\(\d+)\s*/gc;
409
410	if ($self->{channel} != $channel) {
411	$self->{channel} = $channel;
412	(delete $self->{room})->part if $self->{room};
413
414	if ($channel > 0) {
415	$self->{room} = new room channel => $channel;
416	$self->send ("32 Changing into channel $channel.");
417	$self->send ("32 Welcome to cyberspace.");#maybe title##d#
418
419	}
420	}
421
422	if ($channel > 0) {
423	# msg_chat to room
424	}
425	} else {
426	$self->send ("5 Unknown command.");
427	}
428
429	$self->send ("1 5");
430
431	}
432
433	sub login_ok {
434	my ($self, $msg) = @_;
435
436	$self->{feed} = sub { $self->feed ($_[0]) };
437	#$self->send ("39 IGS entry on 05 - 26 - 2004");
438	#$self->send ("9 File"); # motd
439
440	$self->send ("9 File");
441	$self->send (" $msg");
442	$self->send ("9 File");
443	$self->send ("1 5");
444
445	$self->{room} = new room channel => 13; # auto-join english room #d#
446	}
447
448	sub login_failed {
449	my ($self, $msg) = @_;
450
451	$self->send ("5 $msg");
452	Event::unloop -1;
453	}
454
455	package main;
456
457	sub usage {
458	print STDERR <<EOF;
459	Usage: $0 [options] port
460	-v increase verbosity
461	-q decrease verbosity
462
463	EOF
464	exit shift;
465	}
466
467	GetOptions (
468	"v" => sub { $verbose++ },
469	"q" => sub { $verbose-- },
470	"h" => sub { usage(0) },
471	) or die usage(1);
472
473	my $port = $ARGV[0] \|\| 6969;
474
475	my $socket = new IO::Socket::INET LocalPort => $port, Listen => 1, ReuseAddr => 1,
476	or die "cannot create listening socket on port $port: $!";
477
478	print "Listening on 127.0.0.1:$port, please connect to it using your igs client.\n";
479
480	while (my $fh = $socket->accept) {
481	if (fork == 0) {
482	$igs = new igs fh => $fh;
483
484	Event::loop;
485	exit 0;
486	}
487	}
488
489	1;
490
491