Vote Bot Source

#!/usr/bin/perl -w

=head1 VoteBot

This is the #c-lounge vote bot.

Author: D. Robins <dbrobins@davidrobins.net> (czth)

History:
  20030210  dbr  created

XXX suggestions XXX

allow comments with votes (alycat)
 vote (yes|no) for foo "comment"
 comments for <>

abstain / don't care vote (alycat)

=cut

package VoteBot;

use strict;
use POE qw(Kernel Session Component::IRC Wheel::ReadLine);
use Data::Dumper;
use IO::File;
use POSIX qw(strftime);

my $Who = 'czth!dbrobins@davidrobins.net';
my $Id = 'VoteBot';
my $Me = 'C-Vote';
my $Lounge = '#c-lounge';
my $Key = 'polite';
my $Data = 'VoteBot.dat';
my $TZ = 'CST';
my %Vote;
my $Log;
my $Quit;

sub now {
  my $t = @_ ? shift : time();
  $t ? strftime('%Y-%m-%d %H:%M '.$TZ,localtime($t)) : '<unknown>'
}

# log to file
sub flog(@) {
  unless(defined $Log) {
    $Log = IO::File->new(">>VoteBot.log") or die "create log: $!";
    $Log->autoflush();
    $Log->print("*** logging started at ".now()." ***\n");
  }
  my $line = join ', ',@_;
  $line =~ s/\n?$/\n/;
  $Log->print(strftime('%H:%M ',localtime()).$line);
}

sub _start {
  my ($k,$s,$h) = @_[KERNEL,SESSION,HEAP];
  flog "_start: read votes\n";
  %Vote = %{do $Data};
  flog "votes: ".(keys %Vote)."\n" if scalar keys %Vote;
  flog "creating ReadLine wheel\n";
  $h->{wheel} = POE::Wheel::ReadLine->new(InputEvent => 'input');
  $h->{wheel}->clear();
  $h->{wheel}->put("VoteBot\n");
  $h->{wheel}->get('> ');
  flog "_start: register P::C::I\n";
  $k->post($Id,'register','all');
  $k->post($s,'reconnect');
}

sub _stop {
  flog "_stop - saving votes\n";
  my $vote = Dumper(\%Vote);
  $vote =~ s/^\$VAR1 = {/{/;
  open VOTE,">$Data" or die "write: $!";
  print VOTE $vote;
  close VOTE;
  $Log->close() if $Log;
}

sub _default {
  flog "_default caught unhandled $_[ARG0] event\n";
  flog " parameters: @{$_[ARG1]}\n";
  0
}

sub say {
  my ($k,$target,$text) = @_;
  my $pre = '';
  if(ref $target) {
    ($target,my $nick) = @{$target};
    $pre = "$nick: ";
  }
  $k->post($Id,'privmsg',$target,$pre.$_) for split /\n/,$text;
}

sub irc_connected {
  flog "connected\n";
}

sub irc_001 {  # welcome message, ready for commands
  my ($self,$k) = @_[OBJECT,KERNEL];
  flog "welcome\n";
  $k->post($Id,'mode',$Me,'+i');
  $self->do_join($k);
}

sub irc_kick {
  my ($k,$who,$where,$nick,$why) = @_[KERNEL,ARG0..ARG3];
  $k->delay('rejoin',30) if lc $nick eq lc $Me and not $Quit;
}

sub irc_socketerr {
  my ($k,$err) = @_[KERNEL,ARG0];
  flog "connect failed: $err\n";
  $k->delay('reconnect',600) unless $Quit;
}

sub irc_error {
  my ($k,$err) = @_[KERNEL,ARG0];
  flog "server error: $err\n";
  $k->delay('reconnect',600) unless $Quit;
}

sub irc_disconnected {
  my $k = $_[KERNEL];
  flog "disconnected\n";
  $k->delay('reconnect',30) unless $Quit;
}

sub irc_public {
  my ($self,$k,$who,$where,$text) = @_[OBJECT,KERNEL,ARG0..ARG2];
  return unless grep { lc $_ eq lc $Lounge } @{$where};
  $self->command($k,$who,1,$text);
}

sub have_topic {
  my ($self,$k,$target,$topic) = @_;
  if(not defined $topic) {
    unless(scalar keys %Vote) {
      say($k,$target,'no votes at present');
      return 0;
    }
    return 1;
  }
  unless(exists $Vote{$topic}) {
    say($k,$target,"sorry, no such topic as '$topic'");
    return 0;
  }
  1
}

sub split_votes {
  my ($self,$vote) = @_;
  my ($yes,$no) = ([],[]);
  while(my ($nick,$info) = each %{$vote->{vote}}) {
    push @{$info->[0] ? $yes : $no}, $nick;
  }
  ($yes,$no)
}

# type is 0, private, 1, public, 2, local
sub command {
  my ($self,$k,$who,$type,$text) = @_;
  my $nick = (split /!/,$who)[0];
  $text =~ s/^\s+//; $text =~ s/\s+$//; $text =~ s/\s+/ /g;

  my $target = $text =~ s/ (on|in|to) chan(nel)?$// ? [$Lounge,$nick] : $nick;
  $target = $Lounge if 2 == $type;  # local commands output to channel

  # vote (yes|no) (on|for) <topic>
  if($text =~ /^vote (yes|no) (?:on|for) (\w+)$/i) {
    unless(1 == $type) {
      say($k,$target,"sorry, votes must be cast in the channel");
      return;
    }
    $target = [$Lounge,$nick];
    my $topic = lc $2;
    return unless $self->have_topic($k,$target,$topic);
    my $yes = $1 =~ /^y/;
    my $vote = $yes ? 'yes' : 'no';
    my $rec = $Vote{$topic};
    my $desc = $rec->{desc};
    unless(exists $rec->{vote}->{$nick}) {
      $rec->{vote}->{$nick} = [$yes,$who];
      say($k,$target,"registered '$vote' vote for '$topic'");
      return;
    }
    if($rec->{vote}->{$nick}->[0] eq $yes) {
      say($k,$target,"I already had it that way");
    } else {
      say($k,$target,"changed vote to '$vote' for '$topic'");
      $rec->{vote}->{$nick} = [$yes,$who];
    }

  # new vote "<description>" as <topic>
  } elsif($text =~ /^new vote \"([^"]+)\" as (\w+)$/i) {
    if(0 == $type) {
      say($k,$target,"sorry, votes must be created in the channel");
      return;
    }
    $target = [$Lounge,$nick];
    my ($topic,$desc) = (lc $2,$1);
    if(exists $Vote{$topic}) {
      say($k,$target,"sorry, topic '$topic' already exists");
      return;
    }
    $Vote{$topic} = { desc => $desc, topic => $topic, vote => {},
     when => time(), author => $nick };
    say($k,$target,"added vote '$desc' as '$topic'");

  # stats for <topic>
  } elsif($text =~ /^stats for (\w+)$/i) {
    my $topic = lc $1;
    return unless $self->have_topic($k,$target,$topic);
    say($k,$target,"topic '$topic': $Vote{$topic}->{desc} \@ ".now($Vote{$topic}->{when}).' by '.$Vote{$topic}->{author});
    my ($yes,$no) = $self->split_votes($Vote{$topic});
    my ($y,$n) = ($#{$yes}+1,$#{$no}+1);
    say($k,$target,"$y yes vote".($y==1 ? '' : 's').(@{$yes} ? ": @{$yes}" : ''));
    say($k,$target,"$n no vote".($n==1 ? '' : 's').(@{$no} ? ": @{$no}" : ''));
    if($y+$n) {
      say($k,$target,sprintf "%.2f%% yes, %.2f%% no (%d vote%s)",
       100*$y/($y+$n),100*$n/($y+$n),$y+$n,($y+$n == 1) ? '' : 's');
    }

  # (show|list) votes
  } elsif($text =~ /^list votes$/) {
    return unless $self->have_topic($k,$target);
    say($k,$target,"currently voting on '".(join "', '",keys %Vote)."'");

  # summarize votes
  } elsif($text =~ /^summ(?:arize)? votes$/) {
    return unless $self->have_topic($k,$target);
    my @sum;
    while(my ($topic,$vote) = each %Vote) {
      my ($yes,$no) = $self->split_votes($vote);
      push @sum, "$topic (".($#{$yes}+1).'/'.($#{$yes}+$#{$no}+2).')';
    }
    say($k,$target,join ', ',@sum);

  # describe vote <topic>
  } elsif($text =~ /^desc(?:ribe)? vote (\w+)$/) {
    my $topic = lc $1;
    return unless $self->have_topic($k,$target,$topic);
    say($k,$target,"'$topic' is ".$Vote{$topic}->{desc}.' created by '.$Vote{$topic}->{author}.' @ '.now($Vote{$topic}->{when}));

  # votes (for|by) <topic>
  } elsif($text =~ /^votes for (\w+)$/ or $text =~ /^my votes$/) {
    my $user = defined $1 ? $1 : $nick;
    my (@yes,@no);
    while(my ($topic,$vote) = each %Vote) {
      my $info = $vote->{vote}->{$user};
      push @{$info->[0] ? \@yes : \@no}, $topic if defined $info;
    }
    if(not @yes and not @no) {
      say($k,$target,"$user has no votes");
    } else {
      @yes = qw(<nothing>) unless @yes;
      @no = qw(<nothing>) unless @no;
      say($k,$target,"$user voted yes on ".(join ', ',@yes)." and no on ".
       join(', ',@no));
    }

  # show votes
  } elsif($text =~ /^show (votes|unvoted)$/i) {
    return unless $self->have_topic($k,$target);
    my $unv = lc $1 eq 'unvoted';
    my $pre = $unv ? 'you have not voted on ' : 'current votes are ';
    my @vote;
    while(my ($topic,$vote) = each %Vote) {
      next if $unv and $vote->{vote}->{$nick};
      push @vote, "$topic (".$vote->{desc}.')';
    }
    if($#vote < 0) {
      say($k,$target,$unv ? 'no new votes' : 'no votes');
    } else {
      say($k,$target,$pre.join ', ',@vote);
    }

  # help vote
  } elsif($text =~ /^help vot\w+$/i) {  # voting, votes, vote, ...
    say($k,$target,"new vote \"<description>\" as <key>, vote (yes|no) on <key>, stats for <key>, summarize votes, describe vote <key>, list votes, show votes, show unvoted, my votes, votes (for|by) <nick>");

  # unknown command in private
  } elsif(0 == $type) {
    say($k,$target,"sorry... (try 'help vote')")  if 0 == $type;
  }

  return unless 2 == $type;  # admin commands

  # delete vote <topic>
  if($text =~ /^delete vote (\w+)$/) {
    my $topic = lc $1;
    return unless $self->have_topic($k,$target,$topic);
    delete $Vote{$topic};
    say($k,$target,"deleted vote '$topic'");

  # quit <message>
  } elsif($text =~ /^quit(?: (.+$))?$/) {
    my $bye = defined $1 ? $1 : '';
    $Quit = 1;  # don't reconnect, we're leaving
    $k->post($Id,'quit',$bye);

  # say <text>
  } elsif($text =~ /^s(?:ay)? (.+)$/) {
    say($k,$target,$1);

  }
}

sub irc_msg {
  my ($self,$k,$who,$where,$text) = @_[OBJECT,KERNEL,ARG0..ARG2];
  $self->command($k,$who,0,$text);
}

sub do_join {
  my ($self,$k) = @_;
  $k->post($Id,'join',$Lounge,$Key);
}

sub rejoin {
  my ($self,$k) = @_[OBJECT,KERNEL];
  flog "rejoin\n";
  $self->do_join($k);
}

sub reconnect {
  my $k = $_[KERNEL];
  flog "connecting\n";
  $k->post($Id,'connect',{
   Nick     => $Me,
   UserName => 'cvotebot',
   IrcName  => "#c ops' voting bot",
   Server   => 'irc.qeast.net',
   Port     => 6669,
  });
}

sub input {
  my ($self,$k,$h,$text) = @_[OBJECT,KERNEL,HEAP,ARG0];
  $text = 'quit ^C' unless defined $text;  # interrupt -> quit
  flog "local: '$text'";
  $h->{wheel}->addhistory($text);
  $self->command($k,$Who,2,$text);
  if($Quit) {
    $h->{wheel}->put("quit\n\n");
    delete $h->{wheel};
    flog "quitting";
  } else {
    $h->{wheel}->get('> ');
  }
}


package main;

use strict;
use POE qw(Kernel Session Component::IRC);

POE::Component::IRC->new($Id) or die "P::C::I init failed";

my $bot = bless {},'VoteBot';

POE::Session->create(
  object_states => [$bot => [qw(_start _stop _default irc_connected irc_001
   irc_kick irc_disconnected irc_public irc_socketerr irc_error irc_msg rejoin
   reconnect input)]],
);

eval {
  $poe_kernel->run();
};

if($@) {
  VoteBot::flog "died: $@";
}