FICS spellbot

FICSBot.pm

package FICSBot;

use strict;
use warnings;
use base qw( Bot );
use IO::Select;

our $VERSION = "1.0.0";
our $DEBUG = 0;

my $default_object = undef;

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = new Bot();
    bless $self, $class;
    $default_object = $self;

    $self->{handle} = shift || "g";
    $self->{password} = shift || "";
    $self->{server} = shift || "freechess.org";
    $self->{port} = shift || "5000";
    $self->{timeout} = shift || 1;

    $self->{logroot} = '/tmp/';
    $self->{prompt} = 'fics%';
    $self->{logged_in} = 0;
    $self->{buffer} = [];
    $self->{buffer2} = "";
    $self->{follow} = {};
    $self->{autoobserve} = 1;
    $self->{_last_send} = time;
    $self->{blocking} = 1;

    @{$self->{operators}} = qw( Aighearach Dot vek coolgal zyla );

    @{$self->{callbacks}} = ();

    $self->init_parsers();
    return $self;
}

# return current(new) blocking setting
sub blocking {
    my $self = shift;
    if ( @_ ) {
	$self->{blocking} = shift;
    }
    return $self->{blocking};
}

sub logged_in {
    my $self = shift;
    return $self->{logged_in};
}

sub handle {
    my $self = shift;
    return $self->{handle};
}

sub get_event {
    my $self = shift;

  EVENT_LOOP:
    for (;;) {
	if ( defined (my $data = $self->read_fics) ) {
	    next EVENT_LOOP unless defined (my $event = $self->parse( $data ));
	    return $event;
	}
	else {
	    if ( $self->{blocking} ) {
		sleep $self->{timeout};
	    }
	    else {
		return undef;
	    }
	}

      CALLBACK:
	foreach my $callback ( @{$self->{callbacks}} ) {
	    if ( ref $callback eq 'CODE' ) {
		print STDERR "executing callback $callback\n" if $DEBUG > 50;
		eval {
		    &$callback;
		};
		die "$@\n" if defined $@ and $@;
	    }
	    else {
		next CALLBACK;
	    }
	}

	if ( $self->connected() ) {
	    if ( time - $self->{_last_send} > 3000 ) {
		$self->print( 'z' );
	    }
	}

	exit if $self->{logged_in} and not $self->connected;
    }

}

sub parse {
    my $self = shift;
    my $data = shift;

  PARSER:
    {
	$_ = $data;
	foreach my $parser ( @{$self->{parser}} ) {
#	    print "parser ",$parser->{name}, " regex: '",$parser->{regex},"'\n" if $DEBUG >= 1;
	    if ( $data =~ $parser->{regex} ) {
		print "executing:",$parser->{name},"\n" if $DEBUG >= 20;
		my $event;
	#	eval {
		    $event = eval $parser->{code};
		    die "$@\n" if defined $@ and $@;
	#	};
#		print "EVENT: $event\n" if $event;
		die "$@" if defined $@ and $@ =~ /^\S+\s+failure/;
		warn "ERROR: $@\n" if defined $@ and $@;
		return $event if $event;
	    }
	}
    }
    return  undef;
}

sub add_callback {
    my $self = shift;
    # potential bug here if you subclass, have objects of both classes, and clone objects using new()
    unless ( ref $default_object eq ref $self ) {
	unshift @_, $self;
	$self = $default_object;
    }
    my $c = 0;
    foreach my $callback ( @_ ) {
	next unless ref $callback eq 'CODE';
	print STDERR "adding callback $callback\n" if $DEBUG;
	push @{$self->{callbacks}}, $callback and $c++;
    }
    return $c;
}

sub add_parser {
    my $self = shift;
    my $name = shift;
    my $regex = shift;
    defined(my $code = shift) or return undef;
    my $priority = shift || 1;

    print "adding parser name:$name regex:$regex\n" if $DEBUG >= 5;
    
    #my $regex_c    = eval "qr/$regex/i";
#    print "ERROR compiling regex while adding parser $name: $@\n" if defined $@ and $@;
    my %parser = ( name      => $name,
		   regex     => $regex,
		   #		   regex_c   => $regex_c,
		   code      => $code,
		   priority  => $priority,
		 );

    push @{$self->{parser}}, \%parser;
    return scalar %parser;
}

sub list_parsers {
    my $self = shift;
    my %search = map { $_ => 1 } @_;
    my %found = ();

    if ( %search ) {

	foreach my $parser (@{$self->{parser}}) {
	    foreach my $word ( keys %search ) {
		if ( $parser->{name} =~ /$word/i ) {
		    $found{$word} = 1;
		}
	    }
	}
    }

    else {
	foreach(@{$self->{parser}}) {
	    $found{$_->{name}} = 1;
	}
    }

    return keys %found;
}

sub init_parsers {
    my  $self = shift;
    @{$self->{parser}} = ();

    $self->add_parser( "other",
		       qr/./,
		       q{
			 return 0 unless $self->{logged_in};
			 chomp (my $data = $_);
			 print ( "UNKNOWN STRING:$data\n" ) if length $data;
			 return 0;
			},
		       99,
		     ) if $DEBUG >= 21;

    $self->add_parser( "logged in",
		       qr/^\\*\*\*\*/,
		       q{
			 return 0 if $self->{logged_in};
			 s/^.*$//;
			 $self->{logged_in} = 1;
#			 print "logged in as ",$self->{handle},"\n";
			 $self->print( "set style 3" );
			 $self->print( "set open 0" );
			 $self->print( "set seek 0" );
			 $self->print( "set shout 1" );
			 $self->print( "set cshout 1" );
#			 $self->print( "-chan 1" );
#			 $self->print( "-chan 2" );
#			 $self->print( "-chan 50" );
#			 $self->print( "+gnot test" );
#			 $self->print( "obs test" );
			 return new FICSBot::Event::Login( $self->{handle} );
			},
		       50,
		     );

    $self->add_parser( "login:",
		       qr/^login:\s*/,
 		       q{
			 return 0 if $self->{logged_in};
			 $self->print( $self->{handle} );
			 return 0;
			},
		       -50,
		     );
    
    $self->add_parser( "password:",
		       qr/^password:\s*$/,
		       q{
			 return 0 if $self->{logged_in};
			 die "login failure: bad password?" if exists $self->{password_attempt};
			 $self->{password_attempt} = 1;
			 print "sending password\n";
			 $self->print( $self->{password} );
			 sleep 1;
			 $self->print( "z" );
			 return 0;
			},
		       -50,
		     );

    $self->add_parser( "guest login generic",
		       qr/^Press\sreturn\sto\senter\sthe\sserver\sas\s\"(.*)\"/,
#		       qr/^Logging\syou\sin\sas\s\"([^\"]+)\"/,
		       q{
			 return 0 if $self->{logged_in};
			 $self->{handle} = $1;
			 $self->print( "" );
			 return 0;
			},
		       -50,
		     );

    $self->add_parser( "tell",
		       qr/^(\w+)(\S*)\stells\syou:\s(.*)/,
		       #qr/^Logging\syou\sin\sas\s\"([^\"]+)\"/,
		       q{
			 return 0 unless $self->{logged_in};
			 chomp (my ( $handle, $raw_badges, $message ) = ( $1, $2, $3 ));
#			 print "got tell from $handle: '$message'\n";

			 return new FICSBot::Event::Tell( $self, $handle, $raw_badges, $message );
			},
		       1,
		     );


    $self->add_parser( "(told name)",
		       qr/^\(told\s\S+\)\n/,
		       q{
			 return 0 unless $self->{logged_in};
#			 print "TOLD SOMEBODY SOMETHING\n";
			 s/^\(told\s\S+\)\n//g;
			 return 0;
			},
		       11,
		     );

    $self->add_parser( "system announcement",
		       qr/^\*\*ANNOUNCEMENT\*\*/,
		       q{
			 s/\*\*ANNOUNCEMENT.*//;
			 return 0;
			},
		       10,
		     );

    $self->add_parser( "game started",
		       qr/^Game\snotification:\s(\S+)\s\S+\s\S+\s(\S+)\s[^:]+:\sGame\s(\d+)/m,
		       q{
			 return 0 unless $self->{logged_in};
			 my ( $name1, $name2, $game ) = ( $1, $2, $3 );
			 s/^Game\snotification:\s\S+\s\S+\s\S+\s\S+\s[^:]+:\sGame\s\d+\s*\n?//m;

			 if ( $name1 =~ m{(.*?)(\(.*\))} ) {
			     $name1 = $1;
			     my $badges = $2;
			     my @badges = $badges =~ s/\((.*?)\)//g;
			     foreach my $badge ( @badges ) {
				 print "badge:'$badge'\n";
			     }
			 }

			 if ( $self->{autoobserve} or exists $self->{follow}->{$name1} or exists  $self->{follow}->{$name2} ) {
			     $self->print( "observe $game" );
			 }
			 $self->{log}->{$game} = [ $name1, $name2 ];
			
			 print( "saw game $game starting: $name1 vs $name2\n" );
			 return 0;
			},
		       -50,
		     );

#{Game 4 (Dopey vs. LorenzoTraldi) Dopey checkmated} 0-1
    $self->add_parser( "game result",
		       qr/^\{Game\s(\d+)\s\((\S+)\svs\.\s(\S+)\)\s(\S+)\s(.*?)\}\s(\S+)/,
		       q{
			 return 0 unless $self->{logged_in};
			 my ( $game, $player1, $player2, $loser, $cause, $result ) = ( $1, $2, $3, $4, $5, $6 );
			 s/^\{Game\s\d+\s\(\S+\svs\.\s\S+\)\s\S+\s.*?\}\s\S+//;
			 print "game $game ($player1 vs $player2) $result\n" if $DEBUG >= 1;
			 return new FICSBot::Event::Game( $game, $player1, $player2, "$loser $cause $result");
			},
		       -55,
		     );


    $self->add_parser( "game observing",
		       qr/^You\sare\snow\sobserving\sgame\s(\d+)/m,
		       q{
			 return 0 unless $self->{logged_in};
			 my ( $game ) = ( $1 );
			 $self->{game}->{$game} = {};
			 $self->print( "ginfo $game" );
			 s/^You\sare\snow\sobserving\sgame\s(\d+)\.?\s*\n?//m,
			 print "Observing game $game\n" if $DEBUG >= 1;
			 return 0;
			},
		       -55,
		     );

    $self->add_parser( "game info",
		       qr/^Game\s(\d+):\sGame\sinformation\.\n\s*(\S+)\s\S+\svs\s(\S+)/m,
		       q{
			 return 0 unless $self->{logged_in};
			 my ( $game, $player1, $player2 ) = ( $1, $2, $3 );
#			 $self->{game}->{$game}->{player1} = $player1;
#			 $self->{game}->{$game}->{player2} = $player2;
			
			 my $event = new FICSBot::Event::Game( $game, $player1, $player2, "$_" );
			
			 return $event;
			},
		       -25,
		     );
    
    $self->add_parser( "game data style 3",
		       #qr/\nGame\s(d+)\s\((\S+)\s\S+\s(\S+?)\)(.*)/s,
		       qr/Game\s(\d+)\s\((\S+)\s\S+\s(\S+?)\)\n(.*)/s,
		       q{
			 return 0 unless $self->{logged_in};
			 my ( $game, $player1, $player2, $style3 ) = ( $1, $2, $3, $4 );

			 $self->{game}->{$game}->{player1} = $player1 unless exists $self->{game}->{$game}->{player1};
			 $self->{game}->{$game}->{player2} = $player2 unless exists $self->{game}->{$game}->{player2};
						
			 my $event = new FICSBot::Event::Game( $game, $player1, $player2, $style3 );
			 print "move in game $game $player1 vs. $player2:\n'$style3'\n" if $DEBUG >= 2;
			 return $event;
			},
		       5,
		     );

    $self->add_parser( "kibitz",
		       qr/^(\S+?)\[(\d+)\]\skibitzes:\s(.*)/s,
		       q{
			 return 0 unless $self->{logged_in};
			 chomp (my ( $handle, $game, $message ) = ( $1, $2, $3, $4 ));
			 my $player1 = $self->{game}->{$game}->{player1};
			 my $player2 = $self->{game}->{$game}->{player2};
			 my $event = new FICSBot::Event::Kibitz( $player1, $player2, $handle, $message );

			 return $event;
			},
		       5,
		     );

    $self->add_parser( "whisper",
		       qr/^(\S+?)\[(\d+)\]\swhispers:\s(.*)/s,
		       q{
			 return 0 unless $self->{logged_in};
			 chomp (my ( $handle, $game, $message ) = ( $1, $2, $3, $4 ));
			 my $player1 = $self->{game}->{$game}->{player1};
			 my $player2 = $self->{game}->{$game}->{player2};
			 my $event = new FICSBot::Event::Whisper( $player1, $player2, $handle, $message );

			 return $event;
			},
		       5,
		     );

    $self->add_parser( "channel",
		       qr/^(\w+)(\S*)\((\d+)\):\s(.*)/s,
		       q{
			 return 0 unless $self->{logged_in};
			 chomp (my ( $handle, $badges, $channel, $message ) = ( $1, $2, $3, $4 ));
			 #s/^\w+\S*\(\d+\):\s.*//s;
			 return new FICSBot::Event::Channel( $self, $channel, $handle, $badges, $message );
			},
		       5,
		     );



    $self->sort_parser();
    return 1;
}

sub sort_parser {
    my $self = shift;
    @{$self->{parser}} =
      map { $_->[0] }
	sort { $a->[1] <=> $b->[1] }
	  map { [ $_, $_->{priority} ] }
	    @{$self->{parser}};
}

sub is_operator {
    my $self = shift;
    my $name = shift;

    foreach my $op ( @{$self->{operators}} ) {
	if ( lc($name) eq  lc($op) ) {
	    return 1;
	}
    }
    return 0;
}

sub follow {
    my $self = shift;
    if ( my @names = @_ ) {
	foreach my $name ( @names ) {
	    $self->{follow}->{$name} = 1;
	}
	return 1;
    }
    else {
        return keys %{$self->{follow}};
    }
}

sub unfollow {
    my $self = shift;
    if ( my @names = @_ ) {
	foreach my $name ( @names ) {
	    delete $self->{follow}->{$name} if exists $self->{follow}->{$name};
	}
	return 1;
    }
    return undef;
}

sub add_log {
    my $self   = shift;
    my $type   = shift;
    my $number = shift;
    my $name   = shift;
    if ( exists( $self->{logs}{$type}{$number}{$name} ) ) {
	return "already logging $type $number to $name";
    }
    else {
	my $root = ( $name =~ m|^\/| ) ? "" : $self->{logroot};
	$self->{logs}{$type}{$number}{$name} = "$root$name";
	return "starting log of $type $number to $name";
    }
}

sub read_fics {
    my $self = shift;
    my $data = "";
    my $chunk = "";

#    print "hello\n";
    if ( IO::Select->new( $self->{connection} )->can_read( .001 ) ) {
#    print "world\n";
#    print "read:", IO::Select->new( $self->{connection} )->can_read( 1 ),"\n";
	
	my $bytes = $self->{connection}->sysread( $data, 1024 );

	$data =~ tr/\r//d;
	$data =~ s/^\n*//;
	$data =~ s/\n+/\n/g;
	print "GOT:'$data'\n" if $DEBUG >= 10 and defined $data and $data;
	
#	$data =~ s/^[\n\s]+//g if $self->{logged_in};
	$self->{buffer} .= $data;
	$data = "";
    }

    if ( $self->{logged_in} ) {
	if ( $self->{buffer} =~ s/^(.*?)\n(?:$self->{prompt}\s*)//s ) {
	    $data = $1;
	    $data =~ s/^\\\s+/ /gom;
	    $data =~ tr/\n//d;
	    $data =~ s/^\s+//go;
	}
    }
    else {
	if ( $self->{buffer} =~ s/^(.*?[\n:])//s ) {
	    $data = $1;
	}
    }

    return $data || undef;
}

sub connected {
    my $self = shift;
    if ( exists $self->{connection} and defined $self->{connection} ) {
	if ( $self->{connection}->connected() ) {
	    return $self->{connection};
	}
	else {
	    return 0;
	}
    }

    return undef;
}

sub connect {
    my $self = shift;

    $self->{connection} = new IO::Socket::INET( Proto => "tcp",
						PeerAddr => $self->{server},
						PeerPort => $self->{port},
						Timeout  => 3,
					      )
      or return undef;
    $self->{connection}->blocking( 0 );
    return scalar ( defined $self->{connection} ) ? $self->{connection} : undef;
}

sub quit {
    my $self = shift;
    return undef unless defined $self;
    return $self->print( "quit" );
}

sub tell {
    my $self = shift;
    my $who = shift;
    my $raw = join "", @_;
    my $prefix = "tell $who ";
    return undef unless defined $raw and length $raw;
    return $self->command( $prefix,$raw );
}

sub command {
    my $self = shift;
    my $command = shift;
    defined(my $data = shift) or return undef;
    # grab one char less than the max length of a FICS command (padding is for \n) off the front of $data, and loop until it's empty.
    while ( my $chunk = substr($data, 0, $FICSBot::Limits::CommandSize - 1 - length $command ) ) {
	substr($data,0,length $chunk) = ""; # cut out the chunk
	$self->print( "$command$chunk\n" ) or return undef;
    }
    return 1;

}

sub qtell {
    my $self = shift;
    my $who = shift;
    my $data = join "", @_;
    return undef unless defined $data and length $data;
    $data =~ s/\n/\\n/g;
    return $self->print( "qtell $who $data" );
}

sub print {
    my $self = shift;
    # potential bug here if you subclass, have objects of both classes, and clone objects using new()
    unless ( ref $default_object eq ref $self ) {
	unshift @_, $self;
	$self = $default_object;
    }

    my $data = join "", @_;

    $data =~ tr/\r\n//d;

    if ( $self->connected() ) {
	print "sending ",length($data) + 1," chars: $data\n" if $DEBUG >= 20;
	$self->{_last_send} = time;
	$self->{connection}->print( $data,"\n" );
	return 1;
    }
    else {
	return 0;
    }
}

#####
#####
package FICSBot::Event;

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = {};
    bless $self, $class;

    $self->{type} = shift || "unknown";
    $self->{data} = shift || "null";
    $self->{who} = undef;

    return $self;
}

sub type {
    my $self = shift;
    return $self->{type};
}

sub data {
    my $self = shift;
    return $self->{data};
}

sub reply {
    my $self = shift;
    return undef unless exists $self->{bot} and defined $self->{bot};
    my $who = $self->who;
    my $data = join "", @_;
    return undef unless defined $who and defined $data and length $data;
    return $self->{bot}->tell( $who, $data );
}

#####
#####
package FICSBot::Event::Game;
use base qw{ FICSBot::Event };

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $game = shift;
    my $player1 = shift;
    my $player2 = shift;
    defined (my $game_data = shift) or return undef;
    my $self = new FICSBot::Event( "game", $game_data );

    $self->{player1} = $player1;
    $self->{player2} = $player2;

    return bless $self, $class;

}

sub player1 {
    my $self = shift;
    return $self->{player1};
}

sub player2 {
    my $self = shift;
    return $self->{player2};
}

sub number {
    my $self = shift;
    return $self->{game};
}

#####
#####
package FICSBot::Event::Kibitz;
use base qw{ FICSBot::Event::Game };

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $player1 = shift;
    my $player2 = shift;
    my $who = shift;
    defined (my $kib_data = shift) or return undef;
    my $self = new FICSBot::Event( "kibitz", $kib_data );

    $self->{player1} = $player1;
    $self->{player2} = $player2;
    $self->{who} = $who;

    return bless $self, $class;
}

sub who {
    my $self = shift;
    return $self->{who};
}

#####
#####
package FICSBot::Event::Whisper;
use base qw{ FICSBot::Event::Game };

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $player1 = shift;
    my $player2 = shift;
    my $who = shift;
    defined (my $data = shift) or return undef;
    my $self = new FICSBot::Event( "whisper", $data );

    $self->{player1} = $player1;
    $self->{player2} = $player2;
    $self->{who} = $who;

    return bless $self, $class;
}

sub who {
    my $self = shift;
    return $self->{who};
}

#####
#####
package FICSBot::Event::Tell;
use base qw{ FICSBot::Event };

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $bot = shift;
    my $who = shift;
    my $badges = shift;
    defined (my $data = shift) or return undef;
    my $self = new FICSBot::Event( "tell", $data );

    my %badge = ( );
		
    while ( $badges =~ s/\(([^\)\(]+)\)// ) {
	$badge{$1} = 1;
    }
			
    print "badge $who:",join(",", keys %badge), ":\n" if $DEBUG >= 5;

    $self->{who} = $who;
    %{$self->{badge}} = %badge;
    $self->{message} = $data;
    $self->{bot} = $bot;

    return bless $self, $class;;
}

sub registered {
    my $self = shift;

    if ( exists $self->{badge}->{'U'} ) {
	if ( $self->{badge}->{'U'} ) {
	    return 0;
	}
	else {
	    return 1;
	}
    }
    return 1;
}

sub operator {
    my $self = shift;
    return $self->{bot}->is_operator( $self->who );
}

sub admin {
    my $self = shift;

    if ( exists $self->{badge}->{'*'} ) {
	if ( $self->{badge}->{'*'} ) {
	    return 1;
	}
	else {
	    return 0;
	}
    }
    return undef;
}

sub message {
    my $self = shift;
    return $self->{message};
}

sub who {
    my $self = shift;
    return $self->{who};
}

#####
#####
package FICSBot::Event::Channel;
use base qw{ FICSBot::Event::Game };

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $bot = shift;
    my $channel = shift;
    my $who = shift;
    my $badges = shift;
    defined (my $data = shift) or return undef;
    my $self = new FICSBot::Event( "channel", $data );

    my %badge = ();
		
    while ( $badges =~ s/\(([^\)\(]+)\)// ) {
	$badge{$1} = 1;
    }
			
    print "badge $who:",join(",", keys %badge), ":\n" if $DEBUG >= 5;

    $self->{bot} = $bot;
    $self->{channel} = $channel;
    $self->{who} = $who;
    %{$self->{badge}} = %badge;
    $self->{message} = $data;

    return bless $self, $class;
}

sub registered {
    my $self = shift;

    if ( exists $self->{badge}->{'U'} ) {
	if ( $self->{badge}->{'U'} ) {
	    return 0;
	}
	else {
	    return 1;
	}
    }
    return undef;
}

sub admin {
    my $self = shift;

    if ( exists $self->{badge}->{'*'} ) {
	if ( $self->{badge}->{'*'} ) {
	    return 1;
	}
	else {
	    return 0;
	}
    }
    return undef;
}

sub message {
    my $self = shift;
    return $self->{message};
}

sub channel {
    my $self = shift;
    return $self->{channel};
}

sub who {
    my $self = shift;
    return $self->{who};
}


#####
#####
package FICSBot::Event::Login;
use base qw{ FICSBot::Event };

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    defined (my $who = shift) or return undef;
    my $self = new FICSBot::Event( "login", $who );

    $self->{who} = $who;
    return bless $self, $class;
}

sub who {
    my $self = shift;
    return $self->{who};
}

#####
#####
package FICSBot::Limits;
our $CommandSize = 200;

#end
1;

spellbot.pl

#!/usr/bin/perl
use strict;
use warnings;
use lib '/home/paris/programming/chess';
use IO::Socket;
use IO::Select;
use Getopt::Long;
use POSIX qw( setsid ctime );
use FICSBot;
use Lingua::Ispell;
;use Mail::Sendmail;

$| = 1;
$FICSBot::Limits::CommandSize = 400;
$FICSBot::DEBUG = 0;
chomp( $Lingua::Ispell::path = `which ispell` );

my %opts = ( server   => "freechess.org",
	     port     => 5000,
	     login    => "SpellBot",
	     password => 'xxxx',
	     owner    => "Aighearach",
	     logdir   => "/home/paris/programming/chess",
	     log      => "/home/paris/programming/chess/spellbot_debug.log",
	   );

GetOptions( 'server=s'   => \$opts{server},
	    'port=i'     => \$opts{port},
	    'login=s'    => \$opts{login},
	    'password=s' => \$opts{password},
	    'owner=s'    => \$opts{owner},
	    'log=s'      => \$opts{log},
	    'console'    => \$opts{console},
	    'logdir=s'   => \$opts{logdir},
	    'help'       => \$opts{help},
	  );
$opts{logdir} =~ s|/$||;

if ( defined $opts{help} ) {
    print <<EOF;
Usage: $0 [options]
Options:
  --server=SERVERNAME
  --port=PORT
  --login=LOGIN
  --password=PASSWORD
  --owner=OWNER          all this does is set the name used in the help messages
  --logdir=/path/to/dir  Sets the directory to store logs in
  --log=/path/to/file    Probably not usefully other than for debugging
  --console              Prevents detaching from the terminal
  --help                 This listing

For additional help, contact the Goddess at your local Sacred Oak
EOF

    exit;
}

unless ( $opts{console} ) {
    #daemonize
    open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
    open STDOUT, ">>$opts{log}"
      or die "Error opening log file: $!";
    {
	defined( my $pid = fork() )
	  or die "failed fork()ing: $!";
	exit if $pid;
	eval {
	    require POSIX;
	    &POSIX::setsid;
	};
    }
    open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
}

open USERLOG, ">$opts{logdir}/databot.user.log" or die "can't open $opts{logdir}/databot.user.log for writing: $!";

print "Started $0 at ".ctime(time);
#die "the end";
#print "eek\n";
my $bot = new FICSBot( $opts{login}, $opts{password}, $opts{server}, $opts{port} );
#push @{$bot->{operators}}, "gilly";
my %follow = ();
my @channels = ( 1, 2, 50, 85, 88 );

$bot->connect() or
  die "couldn't connect to $opts{server}:$opts{port}";
print "connected\n";

EVENT:
while ( my $event = $bot->get_event ) {
#    print "event:", $event->type,"\n";

    if ( $event->type eq "tell" ) {
	if ( lc $event->who eq lc "roboadmin" ) {
	    next;
	}

	if ( $bot->is_operator($event->who) ) {
	
	    if ( $event->message =~ /^command\s+(.*)/ ) {
		my $command = $1;
		$bot->print( $command );
		$event->reply( "sending '$command' (message='".$event->message."')" );
		next EVENT;
	    }
	    elsif ( $event->message =~ /^add\s+(.*)$/s ) {
		my @words = split ' ', $1;
		foreach my $word ( @words ) {
		    Lingua::Ispell::add_word( $word );
		}
		$event->reply( "added ", join_english( "and", @words ) );
		next EVENT;
	    }

	}

	if ( $event->message =~ /^\s*follow\s*$/ ) {
	    unless ( $event->registered ) {
		$event->reply( &unreg_refusal_string );
		next EVENT;
	    }
	    $event->reply( "Okay, I'll now report on your errors in shouts and channels. Current channels watched are: ",join(" and ", join( ", ", @channels[0..$#channels-1]), $channels[-1]),"." );
	    $follow{$event->who} = 1;
	}
	elsif ( $event->message =~ /^\s*unfollow\s*$/ ) {
	    unless ( $event->registered ) {
		$event->reply( &unreg_refusal_string );
		next EVENT;
	    }

	    $event->reply( "Okay, I won't report on your errors in shouts or channels." );
	    delete $follow{$event->who};
	}
	elsif ( $event->message =~ /^\s*help/io ) {
	    $event->reply( help_string( $event->who ) );
	}
	else {
	    my $c = 0;
	    foreach my $error ( spell( $event ) ) {
		$event->reply( $error );
		$c++;
	    }
	    $event->reply( "No errors detected, ",$event->who, "." ) unless $c;
	}

	
#	unless ( $event->admin ) {
	print USERLOG $event->who, ":", $event->message,"\n";
#	}

    } # end if tell
    elsif ( $event->type eq "login" ) {
	print "Logged in as ",$event->who,"\n";

	my @help = split /\s*\n\s*/, &help_string;

	$bot->print( "set 1 programmed by Aighearach" );
	#now kludge in a blank line
	$bot->print( "set $_ blargh" ) foreach ( 2,3 );
	$bot->print( "set 2" );

	my $i = 3;
	$bot->print( "set ",$i++," $_" ) foreach @help;
		
	foreach ( @channels ) {
	    $bot->print( "+chan $_" );
	}
    }
    elsif ( $event->type eq "channel" or $event->type eq "shout" or $event->type eq "cshout" ) {
	if ( exists $follow{$event->who} ) {
	    foreach my $error ( spell( $event ) ) {
		$event->reply( $error );
	    }
	}
    }
    else {
	print "what's an event type ",$event->type," do?\n";
    }
}

# takes a FICSBot::Event object and returns a list of error strings, each containing suggestions for one wrong word
sub spell {
    my $event = shift || return undef;
    my @responses = ();
    foreach my $error ( Lingua::Ispell::spellcheck( $event->message )  ) {
	#next unless defined $error and ref $error and ref $error->{misses} eq 'ARRAY';
	my @tries = scalar ( exists $error->{misses} and ref $error->{misses} eq 'ARRAY' ) ? @{$error->{misses}} : ();
	print "Saw incorrect from ",$event->who,": ",$error->{term},"\n";
	if ( @tries ) {
	    push @responses, join( "",
				   "I don't know \"",
				   $error->{term},
				   "\", did you mean ",
				   join_english( "or", @tries ),
				   ,"?"
				 );
	}
	else {
	    push @responses, "Sorry ".$event->who.", I have no clue what ".$error->{term}." could be.";
	}
    }
    return @responses;
}


sub help_string {
    my $user = shift || "biological life form";
    my $botname = $bot->{handle};
    my $help = <<HELP;
Hello, $user. I am a spelling bot. 
Usage: tell $botname command || words 
  commands: 
follow:      monitors your channel tells and shouts for spelling mistakes 
unfollow:    turns off monitoring of channel tells and shouts. 
*NOTE*: shout spelling not implemented

HELP

  return $help;

}

# example:
# print join_english( "and", 1, 2, 3, 4, 5 );
# output:
# 1, 2, 3, 4 and 5
sub join_english {
    my $glue = shift || "";
    return @_ unless $#_;
    return join( " $glue ",
		 join( ", ", @_[0..$#_-1] ), # all but the last one
		 $_[$#_] # and the last one (which can also be the only one!)
	       );
}

sub unreg_refusal_string {
    return <<EOF;
Unregestered users may spell words, but may not use other commands. Please read issue the server command "help register" for information on opening a chess server account, and accessing the full range of spellbot features.
EOF
}