summaryrefslogtreecommitdiffstats
path: root/scripts/quizmaster.pl
diff options
context:
space:
mode:
Diffstat (limited to 'scripts/quizmaster.pl')
-rw-r--r--scripts/quizmaster.pl354
1 files changed, 354 insertions, 0 deletions
diff --git a/scripts/quizmaster.pl b/scripts/quizmaster.pl
new file mode 100644
index 0000000..e226075
--- /dev/null
+++ b/scripts/quizmaster.pl
@@ -0,0 +1,354 @@
+# Quizmaster.pl by Stefan "tommie" Tomanek (stefan@pico.ruhr.de)
+use strict;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = '20170403';
+%IRSSI = (
+ authors => 'Stefan \'tommie\' Tomanek',
+ contact => 'stefan@pico.ruhr.de',
+ name => 'quizmaster',
+ description => 'a trivia script for Irssi',
+ license => 'GPLv2',
+ url => 'http://irssi.org/scripts/',
+ changed => $VERSION,
+ modules => 'Data::Dumper',
+ commands => "quizmaster"
+);
+
+use Irssi;
+use Data::Dumper;
+
+use vars qw(%sessions %questions);
+
+sub show_help() {
+ my $help = "quizmaster $VERSION
+/quizmaster
+ List the running sessions
+/quizmaster import <name> <filename>
+ Import a database (moxxquiz format)
+/quizmaster save
+ Save all imported questions
+/quizmaster start <db1> <db2>...
+ Start a new game in the current channel using the named databases
+ if all databases are omitted, all available are used
+/quizmaster score
+ Display the scoretable of the current game
+/quizmaster hint <number>
+ Give a number of hints
+";
+ my $text='';
+ foreach (split(/\n/, $help)) {
+ $_ =~ s/^\/(.*)$/%9\/$1%9/;
+ $text .= $_."\n";
+ }
+ print CLIENTCRAP &draw_box("Quizmaster", $text, "quizmaster help", 1);
+}
+
+sub draw_box ($$$$) {
+ my ($title, $text, $footer, $colour) = @_;
+ my $box = '';
+ $box .= '%R,--[%n%9%U'.$title.'%U%9%R]%n'."\n";
+ foreach (split(/\n/, $text)) {
+ $box .= '%R|%n '.$_."\n";
+ }
+ $box .= '%R`--<%n'.$footer.'%R>->%n';
+ $box =~ s/%.//g unless $colour;
+ return $box;
+}
+
+sub save_quizfile {
+ local *F;
+ my $filename = Irssi::settings_get_str("quizmaster_questions_file");
+ open(F, ">",$filename);
+ my $dumper = Data::Dumper->new([\%questions], ['quest']);
+ $dumper->Purity(1)->Deepcopy(1);
+ my $data = $dumper->Dump;
+ print (F $data);
+ close(F);
+ print CLIENTCRAP '%R>>%n Quizmaster questions saved to '.$filename;
+}
+
+sub load_quizfile ($) {
+ my ($file) = @_;
+ no strict 'vars';
+ return unless -e $file;
+ my $text;
+ local *F;
+ open F,'<', $file;
+ $text .= $_ foreach (<F>);
+ close F;
+ return unless "$text";
+ %questions = %{ eval "$text" };
+}
+
+sub import_quizfile ($$) {
+ my ($name, $file) = @_;
+ local *F;
+ open(F,'<', $file);
+ my @data = <F>;
+ my @questions;
+ my $quest = {};
+ foreach (@data) {
+ if (/^(.*?): (.*?)$/) {
+ my $item = $1;
+ my $desc = $2;
+ if ($item eq 'Question') {
+ $quest->{question} = $desc;
+ } elsif ($item eq 'Category') {
+ $quest->{category} = $desc;
+ } elsif ($item eq 'Answer') {
+ my $answer = $desc;
+ if ($answer =~ /(.*?)#(.*?)#(.*?)$/) {
+ $answer = '';
+ $answer .= '('.$1.')?' if ($1);
+ $answer .= $2;
+ $answer .= '('.$3.')?' if ($3);
+ }
+ push @{$quest->{answers}}, $answer;
+ } elsif ($item eq 'Regexp') {
+ push @{$quest->{answers}}, $desc;
+ }
+ } elsif (/^$/) {
+ if (defined $quest->{question} && defined $quest->{answers}) {
+ push @questions, $quest;
+ $quest = {};
+ }
+ }
+ }
+ $questions{$name} = \@questions;
+ print CLIENTCRAP "%R>>>%n ".scalar(@questions)." questions have been imported from ".$file;
+}
+
+sub add_questions ($$) {
+ my ($target, $name) = @_;
+ push @{$sessions{$target}{questions}}, $name;
+}
+
+sub ask_question ($) {
+ my ($target) = @_;
+ my ($database, $current) = @{$sessions{$target}{current}};
+ my $question = $questions{$database}->[$current]{question};
+ my $category = '';
+ $category = '['.$questions{$database}->[$current]{category}.']' if defined $questions{$database}->[$current]{category};
+ line2target($target, '>>> '.$category.' '.$question);
+}
+
+sub start_quiz ($) {
+ my ($channel) = @_;
+ line2target($channel, '>>>> A new Quiz has been started <<<<');
+ new_question($channel);
+}
+
+sub stop_quiz ($) {
+ my ($target) = @_;
+ show_scores($target);
+ line2target($target, '>>>> The Quiz has been stopped <<<<');
+ delete $sessions{$target};
+}
+
+sub event_public_message ($$$$) {
+ my ($server, $text, $nick, $address, $target) = @_;
+ check_answer($nick, $text, $target) if defined $sessions{$target} and $sessions{$target}{asking};
+}
+
+sub event_message_own_public ($$$) {
+ my ($server, $msg, $target, $otarget) = @_;
+ check_answer($server->{nick}, $msg, $target) if defined $sessions{$target} and $sessions{$target}{asking};
+}
+
+sub check_answer ($$$) {
+ my ($nick, $text, $target) = @_;
+ my ($database, $answer) = @{$sessions{$target}{current}};
+ my @answers = @{$questions{$database}->[$answer]{answers}};
+ foreach (@answers) {
+ my $regexp = $_;
+ if ($text =~ /$regexp/i) {
+ $sessions{$target}{asking} = 0;
+ solved_question($nick, $target);
+ last;
+ }
+ }
+}
+
+sub solved_question ($$) {
+ my ($nick, $target) = @_;
+ line2target($target, '<<< '.$nick.' solved this question');
+ my $witem = Irssi::window_item_find($target);
+ $sessions{$target}{score}{$nick}++;
+ my $max_points = Irssi::settings_get_int('quizmaster_points_to_win');
+ if ($sessions{$target}{score}{$nick} >= $max_points) {
+ line2target($target, '>>> '.$nick.' has '.$sessions{$target}{score}{$nick}.' points and is the winner.');
+ stop_quiz($target);
+ } else {
+ $sessions{$target}{solved} = 1;
+ $sessions{$target}{next} = time();
+ }
+}
+
+sub new_question ($) {
+ my ($target) = @_;
+ $sessions{$target}{solved} = 0;
+ my $d_num = int( (scalar(@{$sessions{$target}{questions}})-1)*rand() );
+ my $database = $sessions{$target}{questions}->[$d_num];
+ my $new_question = int(scalar(@{$questions{$database}})*rand());
+ $sessions{$target}{current} = [$database, $new_question];
+ $sessions{$target}{timestamp} = time();
+ ask_question($target);
+ $sessions{$target}{asking} = 1;
+}
+
+sub expire_questions {
+ foreach my $target (keys %sessions) {
+ my $expire = Irssi::settings_get_int('quizmaster_timeout');
+ my $pause = Irssi::settings_get_int('quizmaster_pause');
+ if ($sessions{$target}{timestamp}+$expire <= time()) {
+ line2target($target, '>>> No correct answer within '.$expire.' seconds.');
+ new_question($target);
+ } else {
+ my $left = ($sessions{$target}{timestamp}+$expire)-time();
+ #line2target($target, ' >>>> '.$left.' seconds left');
+ }
+ if ($sessions{$target}{solved} && $sessions{$target}{next}+$pause <= time()) {
+ new_question($target);
+ }
+ }
+}
+
+sub give_hint ($$) {
+ my ($target, $level) = @_;
+ my $database = $sessions{$target}{current}->[0];
+ my $current = $sessions{$target}{current}->[1];
+ my $answer = $questions{$database}->[$current]{answers}->[0];
+ my $tip;
+ # remove RegExp stuff
+ $answer =~ s/\(//g;
+ $answer =~ s/\)//g;
+ $answer =~ s/\?//g;
+ foreach (0..length($answer)-1) {
+ if (substr($answer, $_, 1) eq ' ') {
+ $tip .= ' ';
+ } else {
+ $tip .= '_';
+ }
+ }
+ foreach (0..$level) {
+ my $pos = int( rand()*(length($answer)-1) );
+ my $char = substr($answer, $pos, 1);
+ my $pre = substr($tip, 0, $pos);
+ my $post = substr($tip, $pos+1);
+ $tip = $pre.$char.$post;
+ }
+ return $tip;
+}
+
+sub line2target ($$) {
+ my ($target, $line) = @_;
+ my $witem = Irssi::window_item_find($target);
+ $witem->{server}->command('MSG '.$target.' '.$line);
+ #$witem->print('MSG '.$target.' '.$line);
+}
+
+sub show_scores ($) {
+ my ($target) = @_;
+ my $table;
+ foreach (sort {$sessions{$target}{score}{$b} <=> $sessions{$target}{score}{$a}} keys(%{$sessions{$target}{score}})) {
+ $table .= "$_ now has ".$sessions{$target}{score}{$_}." points.\n";
+ }
+ my $box = draw_box('Quizmaster for Irssi', $table, 'score', 0);
+ line2target($target, $_) foreach (split(/\n/, $box));
+}
+
+sub list_databases {
+ my $msg;
+ my $sum = 0;
+ foreach (sort keys %questions) {
+ $msg .= '%U'.$_.'%U '."\n";
+ $msg .= ' '.scalar(@{$questions{$_}}).' questions available'."\n";
+ $sum += scalar(@{$questions{$_}});
+ }
+ $msg .= '|'."\n";
+ $msg .= '`===> '.$sum.' questions total'."\n";
+ print CLIENTCRAP &draw_box("Quizmaster", $msg, "databases", 1);
+}
+
+sub list_sessions {
+ my $msg;
+ foreach (sort keys %sessions) {
+ $msg .= '`->%U'.$_.'%U '."\n";
+ $msg .= ' '.scalar(keys %{$sessions{$_}{score}}).' users scored.'."\n";
+ }
+ print CLIENTCRAP &draw_box("Quizmaster", $msg, "sessions", 1);
+}
+
+sub event_nicklist_changed ($$$) {
+ my ($channel, $nick, $oldnick) = @_;
+ my $target = $channel->{name};
+ return unless (defined $sessions{$target} && $sessions{$target}{score}{$oldnick});
+ my $points = $sessions{$target}{score}{$oldnick};
+ $sessions{$target}{score}{$nick->{nick}} = $points;
+ delete $sessions{$target}{score}{$oldnick};
+}
+
+sub init {
+ my $filename = Irssi::settings_get_str('quizmaster_questions_file');
+ load_quizfile($filename);
+}
+
+sub cmd_quizmaster ($$$) {
+ my ($args, $server, $witem) = @_;
+ my @arg = split(/ /, $args);
+ if (scalar(@arg) == 0) {
+ list_sessions();
+ } elsif ($arg[0] eq 'import') {
+ import_quizfile($arg[1], $arg[2]);
+ } elsif ($arg[0] eq 'save') {
+ save_quizfile();
+ } elsif ($arg[0] eq 'load') {
+ init();
+ } elsif ($arg[0] eq 'start') {
+ shift(@arg);
+ if (scalar @arg == 0) {
+ add_questions($witem->{name}, $_) foreach (keys %questions);
+ } else {
+ foreach (@arg) {
+ add_questions($witem->{name}, $_) if defined $questions{$_};
+ }
+ }
+ start_quiz($witem->{name});
+ } elsif ($arg[0] eq 'stop') {
+ stop_quiz($witem->{name});
+ } elsif ($arg[0] eq 'score') {
+ show_scores($witem->{name}) if defined $sessions{$witem->{name}};
+ } elsif ($arg[0] eq 'next') {
+ new_question($witem->{name}) if defined $sessions{$witem->{name}};
+ } elsif ($arg[0] eq 'hint') {
+ line2target($witem->{name}, give_hint($witem->{name}, $arg[1]));
+ } elsif ($arg[0] eq 'list') {
+ list_databases;
+ } elsif ($arg[0] eq 'help') {
+ show_help();
+ }
+}
+
+Irssi::command_bind($IRSSI{'name'}, \&cmd_quizmaster);
+foreach my $cmd ('import', 'load', 'save', 'list', 'help', 'next', 'hint', 'score', 'stop', 'start') {
+Irssi::command_bind('quizmaster '.$cmd => sub {
+ cmd_quizmaster("$cmd ".$_[0], $_[1], $_[2]); });
+}
+
+
+Irssi::settings_add_int($IRSSI{'name'}, 'quizmaster_points_to_win', 20);
+Irssi::settings_add_int($IRSSI{'name'}, 'quizmaster_timeout', 60);
+Irssi::settings_add_int($IRSSI{'name'}, 'quizmaster_pause', 10);
+Irssi::settings_add_str($IRSSI{'name'}, 'quizmaster_questions_file', "$ENV{HOME}/.irssi/quizmaster_questions");
+
+Irssi::signal_add('message public', 'event_public_message');
+Irssi::signal_add('message own_public', 'event_message_own_public');
+Irssi::signal_add('nicklist changed', 'event_nicklist_changed');
+
+
+Irssi::timeout_add(5000, 'expire_questions', undef);
+
+print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' loaded: /quizmaster help for help';
+
+init();