Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

TriviaHam - Quiz Irc Bot

by giulienk (Curate)
on Jan 02, 2002 at 14:35 UTC ( #135642=CUFP: print w/ replies, xml ) Need Help??

A while ago i saw someone in an irc channel making quizzes to people using a Mirc script. So i thought a Perl Bot could do the same job, better. I grabbed POE::Component::IRC and started coding something: follows what i came up with.
#!/usr/bin/perl -w #TriviaHam IRC Bot - Helps quizzing in an IRC Channel #Copyright 2001-2002 Giulio Motta - http://www.giuliomotta.com #This program is free software; you can redistribute it and/or #modify it under the terms of the GNU General Public License #http://www.gnu.org/copyleft/gpl.html #This program is distributed in the hope that it will be useful, #but WITHOUT ANY WARRANTY; without even the implied warranty of #MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #GNU General Public License for more details. use strict; use POE; use POE::Component::IRC; use Getopt::Std; my %args; getopt('spnucioP', \%args); my $nick = $args{n} || 'TriviaHam'; my $server = $args{s} || 'irc.slashnet.org'; my $port = $args{p} || 6667; my $username = $args{u} || 'trivia'; my $ircname = $args{i} || "I'm TriviaHam Master"; my $channel = "#" . $args{c} if $args{c}; my $passwd = $args{P} || 'p455W0Rd'; my $owner_nick = $args{o}; my ($q_num, $owner, $question, $answer, $quiztime, %chart); sub _start { my ($kernel) = $_[KERNEL]; $kernel->alias_set( 'smileyninja' ); $kernel->post( 'triviabot', 'register', 'all'); $kernel->post( 'triviabot', 'connect', { Debug => 1, Nick => $nick, Server => $server, Port => $port, Username => $username, Ircname => $ircname, } ); } sub irc_001 { my ($kernel) = $_[KERNEL]; $kernel->post( 'triviabot', 'mode', $nick, '+i' ); $kernel->post( 'triviabot', 'join', $channel ) if $channel; if ($owner_nick) { #this is useless cause i don't know how to #handle the 'whois' i got back $kernel->post( 'triviabot', 'whois', $owner_nick); #here i should set $short_whois = $owner } } sub irc_disconnected { my ($server) = $_[ARG0]; print "Lost connection to server $server.\n"; } sub irc_error { my $err = $_[ARG0]; print "Server error occurred! $err\n"; } sub irc_socketerr { my $err = $_[ARG0]; print "Couldn't connect to server: $err\n"; } sub _stop { my ($kernel) = $_[KERNEL]; print "Control session stopped.\n"; $kernel->post( 'triviabot', 'quit', 'Neenios on ice!' ); $kernel->alias_remove( 'smileyninja' ); } sub irc_public { if ($question) { my ($kernel, $who, $chan, $msg) = @_[KERNEL, ARG0 .. ARG2]; #i use $answer as a regexp now. still this needs #better handling cause not everybody knows regexp if ($msg =~ /$answer/i) { my $nick = get_nick($who); $chart{$nick}{p}++; $quiztime = time - $quiztime; $chart{$nick}{t} += $quiztime; my ($secs, $mins) = localtime $quiztime; $kernel->post('triviabot', 'privmsg', $channel, sprintf( "\cC4Congratulations \cB%s\cB! The answer is \c_\cB%s\cB\c_. (%02d:%02 +d)", $nick, $answer, $mins, $secs) ); $kernel->post('triviabot', 'privmsg', $channel, "Now \cB$nick\cB has \cB$chart{$nick}{p}\cB point" . ($chart{$nick}{p}<=1?'':'s') . "."); ($question, $answer, $quiztime) = undef; } } } sub irc_msg { my ($kernel, $who, $recipients, $msg) = @_[KERNEL, ARG0 .. ARG2]; my ($command, $rest) = $msg =~ /^\s*(\w+)\s*(.*)/; if ($who eq $owner) { SWITCH: for (lc $command) { ($_ eq 'abort') && do{ abort ($kernel); last}; ($_ eq 'channel') && do{ channel ($kernel, $rest); last}; ($_ eq 'cheat') && do{ cheat ($kernel, $rest); last}; ($_ eq 'help') && do{ help ($kernel); last}; ($_ eq 'new') && do{ new_question ($kernel, $rest); la +st}; ($_ eq 'reset') && do{ _reset ($kernel); last}; ($_ eq 'status') && do{ show_chart ($kernel, $rest); last +}; ($_ eq 'quit') && do{ quit ($kernel); last}; } } elsif ($command eq 'owner') { set_owner ($kernel, $rest, $who); } } sub get_nick { $_ = shift; /^(.*)!.*$/ or die "Weird-ass who: $_"; return $1; } sub set_owner { my ($kernel, $rest, $who) = @_; if ($rest eq $passwd) { $owner = $who; $kernel->post('triviabot', 'privmsg', get_nick($who), "You've been successfully authenticated! ". 'Type "help" for commands.'); } } sub abort { my $kernel = shift; ($question, $answer, $quiztime) = undef; $kernel->post('triviabot', 'privmsg', $channel, "\cBQuestion number $q_num went unanswered." ); } sub channel { my $kernel; ($kernel, $_) = @_; s/^([^#])/#$1/; if ($channel) { $kernel->post('triviabot', 'part', $channel); undef $channel; } unless ( $kernel->post('triviabot', 'join', $_) ) { # this should be error checking but it won't work # cause i can't get an error code back $kernel->post('triviabot', 'privmsg', get_nick($owner), "Cannot join $_ !" ); return; } $channel = $_; } sub cheat { my $kernel; ($kernel, $_) = @_; if (my ($nick, $modifier) = /^\s*(.+)\s+([+-]?\d+)\s*$/) { $chart{$nick}{p} += $modifier; $kernel->post('triviabot', 'privmsg', get_nick($owner), "Score for $nick has changed by $modifier. " . "Now is $chart{$nick}{p}." ); } else { $kernel->post('triviabot', 'privmsg', get_nick($owner), "Cannot cheat: usage 'cheat <nick> <modifier>'" ); } } sub help { my $kernel = shift; my $help = <<'EOH'; Usage of TriviaHam owner <password> # authenticates yourself new \q<question>\a<answer> # new question status [param] # display current standings # no param => returns first 3 positions # param = 0 => returns all the positions # param = <other_number> => returns that many positions abort # abort current question cheat <nick> <modifier> # changes nick score by modifier channel <new_channel> # moves bot to another channel reset # reset everything quit # quit the bot help # this help EOH for my $line (split "\n", $help) { $kernel->post('triviabot', 'privmsg', get_nick($owner), $line +); select(undef, undef, undef, 0.25); } } sub _reset { my $kernel = shift; ($q_num, %chart, $question, $answer) = undef; $kernel->post('triviabot', 'privmsg', get_nick($owner), "Quiz reset!" ); } sub new_question { my $kernel; ($kernel, $_) = @_; if (($question, $answer) = /^\\q\s*(.+?)\s*\\a\s*(.+?)\s*$/) { $q_num++; $kernel->post('triviabot', 'privmsg', $channel, "\cBQuestion Number\cC4 $q_num\cC0,1: $question" ); $quiztime = time; } else { $kernel->post('triviabot', 'privmsg', get_nick($owner), "Cannot parse new question '$_'" ); } } sub show_chart { my ($kernel, $how_many) = @_; $how_many =~ s/^.*?(\d+).*?$/$1/; $how_many = keys %chart if ($how_many eq '0'); $how_many ||= 3; $how_many--; my ($j, $min_color, $max_color) = (0, 6, 15); my $loop = $max_color - $min_color; my $to_color = $min_color - 1; $kernel->post('triviabot', 'privmsg', $channel, "\cVTrivial Standings after \cB$q_num\cB question" . ($q_num<= +1?'':'s') . ". QuizMaster is \cB" . get_nick($owner)); my @sorted_comps = sort {$chart{$b}{p} <=> $chart{$a}{p} || $chart{$a}{t} <=> $chart{$b}{t +}} keys %chart; for (@sorted_comps[0..$how_many]) { last unless $_; my ($secs, $mins) = localtime $chart{$_}{t}; $kernel->post('triviabot', 'privmsg', $channel, sprintf( "\cC%d %d) \cB%-9s\cB with \cB%2d\cB point%1s in %02d +:%02d", ++$j + $to_color, $j, $_, $chart{$_}{p}, $chart{$_}{p}<=1?'':'s', $mins, $secs ) ); $to_color -= $loop unless ( $j % $loop ); } } sub quit { my $kernel = shift; $kernel->post( 'triviabot', 'quit', 'Game Over' ); } POE::Component::IRC->new( 'triviabot' ) or die "Can't instantiate new IRC component!\n"; POE::Session->new( 'main' => [qw( _start _stop irc_001 irc_disconnected irc_socketerr irc_error irc_public irc_msg )] ); $poe_kernel->run(); exit 0;
Some notes about the code:
  • I started coding on dicebot.pl example included with POE::Component::IRC, so some code is just borrowed from there.
  • I still got some trouble using POE: i put comments where i can't solve my problems, maybe someone can help me out.
  • I thought about making it a Xchat Perl plug-in not to waste YASC, but i just liked more this solution that lets you install it even on remote shells without Xchat.
  • Thanks goes to Juerd and his irc colors to html. Still someone may find the colors i'm using disturbing or just disgusting. Please give me suggestion on this.
  • I should write some POD, of course. Next thing to do.
  • Yes, i thought about using a DB of answers/questions. Supporting it should be no issue. Still putting questions realtime is funnier. And you need a HUGE DB not to get repeated questions. If someone knows of such a Db (it should be free, of course), please let me know.
  • Help could be powered with specific help about single commands with obvious syntax like help <command>.
  • Biggest issue at the moment is $answer being a full regexp. It's powerful but at least confusing to most. Please note that matching like /$answer/i instead of /^$answer$/i isn't a bug, but the correct behavior.
  • Any other comment, improvement, suggestion is welcome.

gkinueliileunikg

Comment on TriviaHam - Quiz Irc Bot
Download Code
Replies are listed 'Best First'.
Re: TriviaHam - Quiz Irc Bot
by TStanley (Canon) on Jan 03, 2002 at 05:30 UTC
    You might also want to check out my Games::QuizTaker module, as well as the links provided by our wizard.

    TStanley
    --------
    "Suppose you were an idiot... And suppose you were a
    member of Congress... But I repeat myself." -- Mark Twain

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://135642]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (18)
As of 2015-07-29 17:17 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (266 votes), past polls