Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
355 lines (320 sloc) 10.5 KB
# 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();