1# Quizmaster.pl by Stefan "tommie" Tomanek (stefan@pico.ruhr.de)
2use strict;
3
4use vars qw($VERSION %IRSSI);
5$VERSION = '20170403';
6%IRSSI = (
7	   authors     => 'Stefan \'tommie\' Tomanek',
8	   contact     => 'stefan@pico.ruhr.de',
9	   name        => 'quizmaster',
10	   description => 'a trivia script for Irssi',
11	   license     => 'GPLv2',
12	   url         => 'http://irssi.org/scripts/',
13	   changed     =>  $VERSION,
14	   modules     => 'Data::Dumper',
15	   commands    => "quizmaster"
16);
17
18use Irssi;
19use Data::Dumper;
20
21use vars qw(%sessions %questions);
22
23sub show_help() {
24    my $help = "quizmaster $VERSION
25/quizmaster
26    List the running sessions
27/quizmaster import <name> <filename>
28    Import a database (moxxquiz format)
29/quizmaster save
30    Save all imported questions
31/quizmaster start <db1> <db2>...
32    Start a new game in the current channel using the named databases
33    if all databases are omitted, all available are used
34/quizmaster score
35    Display the scoretable of  the current game
36/quizmaster hint <number>
37    Give a number of hints
38";
39    my $text='';
40    foreach (split(/\n/, $help)) {
41        $_ =~ s/^\/(.*)$/%9\/$1%9/;
42        $text .= $_."\n";
43    }
44    print CLIENTCRAP &draw_box("Quizmaster", $text, "quizmaster help", 1);
45}
46
47sub draw_box ($$$$) {
48    my ($title, $text, $footer, $colour) = @_;
49    my $box = '';
50    $box .= '%R,--[%n%9%U'.$title.'%U%9%R]%n'."\n";
51    foreach (split(/\n/, $text)) {
52        $box .= '%R|%n '.$_."\n";
53    }
54    $box .= '%R`--<%n'.$footer.'%R>->%n';
55    $box =~ s/%.//g unless $colour;
56    return $box;
57}
58
59sub save_quizfile {
60    local *F;
61    my $filename = Irssi::settings_get_str("quizmaster_questions_file");
62    open(F, ">",$filename);
63    my $dumper = Data::Dumper->new([\%questions], ['quest']);
64    $dumper->Purity(1)->Deepcopy(1);
65    my $data = $dumper->Dump;
66    print (F $data);
67    close(F);
68    print CLIENTCRAP '%R>>%n Quizmaster questions saved to '.$filename;
69}
70
71sub load_quizfile ($) {
72    my ($file) = @_;
73    no strict 'vars';
74    return unless -e $file;
75    my $text;
76    local *F;
77    open F,'<', $file;
78    $text .= $_ foreach (<F>);
79    close F;
80    return unless "$text";
81    %questions = %{ eval "$text" };
82}
83
84sub import_quizfile ($$) {
85    my ($name, $file) = @_;
86    local *F;
87    open(F,'<', $file);
88    my @data = <F>;
89    my @questions;
90    my $quest = {};
91    foreach (@data) {
92	if (/^(.*?): (.*?)$/) {
93	    my $item = $1;
94	    my $desc = $2;
95	    if ($item eq 'Question') {
96		$quest->{question} = $desc;
97	    } elsif ($item eq 'Category') {
98		$quest->{category} = $desc;
99	    } elsif ($item eq 'Answer') {
100		my $answer = $desc;
101		if ($answer =~ /(.*?)#(.*?)#(.*?)$/) {
102		    $answer = '';
103		    $answer .= '('.$1.')?' if ($1);
104		    $answer .= $2;
105		    $answer .= '('.$3.')?' if ($3);
106		}
107		push @{$quest->{answers}}, $answer;
108	    } elsif ($item eq 'Regexp') {
109		push @{$quest->{answers}}, $desc;
110	    }
111	} elsif (/^$/) {
112	    if (defined $quest->{question} && defined $quest->{answers}) {
113		push @questions, $quest;
114		$quest = {};
115	    }
116	}
117    }
118    $questions{$name} = \@questions;
119    print CLIENTCRAP "%R>>>%n ".scalar(@questions)." questions have been imported from ".$file;
120}
121
122sub add_questions ($$) {
123    my ($target, $name) = @_;
124    push @{$sessions{$target}{questions}}, $name;
125}
126
127sub ask_question ($) {
128    my ($target) = @_;
129    my ($database, $current) = @{$sessions{$target}{current}};
130    my $question = $questions{$database}->[$current]{question};
131    my $category = '';
132    $category = '['.$questions{$database}->[$current]{category}.']' if defined $questions{$database}->[$current]{category};
133    line2target($target, '>>> '.$category.' '.$question);
134}
135
136sub start_quiz ($) {
137    my ($channel) = @_;
138    line2target($channel, '>>>> A new Quiz has been started <<<<');
139    new_question($channel);
140}
141
142sub stop_quiz ($) {
143    my ($target) = @_;
144    show_scores($target);
145    line2target($target, '>>>> The Quiz has been stopped <<<<');
146    delete $sessions{$target};
147}
148
149sub event_public_message ($$$$) {
150    my ($server, $text, $nick, $address, $target) = @_;
151    check_answer($nick, $text, $target) if defined $sessions{$target} and $sessions{$target}{asking};
152}
153
154sub event_message_own_public ($$$) {
155    my ($server, $msg, $target, $otarget) = @_;
156    check_answer($server->{nick}, $msg, $target) if defined $sessions{$target} and $sessions{$target}{asking};
157}
158
159sub check_answer ($$$) {
160    my ($nick, $text, $target) = @_;
161    my ($database, $answer) = @{$sessions{$target}{current}};
162    my @answers = @{$questions{$database}->[$answer]{answers}};
163    foreach (@answers) {
164	my $regexp = $_;
165	if ($text =~ /$regexp/i) {
166	    $sessions{$target}{asking} = 0;
167	    solved_question($nick, $target);
168	    last;
169	}
170    }
171}
172
173sub solved_question ($$) {
174    my ($nick, $target) = @_;
175    line2target($target, '<<< '.$nick.' solved this question');
176    my $witem = Irssi::window_item_find($target);
177    $sessions{$target}{score}{$nick}++;
178    my $max_points = Irssi::settings_get_int('quizmaster_points_to_win');
179    if ($sessions{$target}{score}{$nick} >= $max_points) {
180	line2target($target, '>>> '.$nick.' has '.$sessions{$target}{score}{$nick}.' points and is the winner.');
181	stop_quiz($target);
182    } else {
183	$sessions{$target}{solved} = 1;
184	$sessions{$target}{next} = time();
185    }
186}
187
188sub new_question ($) {
189    my ($target) = @_;
190    $sessions{$target}{solved} = 0;
191    my $d_num = int( (scalar(@{$sessions{$target}{questions}})-1)*rand() );
192    my $database = $sessions{$target}{questions}->[$d_num];
193    my $new_question = int(scalar(@{$questions{$database}})*rand());
194    $sessions{$target}{current} = [$database, $new_question];
195    $sessions{$target}{timestamp} = time();
196    ask_question($target);
197    $sessions{$target}{asking} = 1;
198}
199
200sub expire_questions {
201    foreach my $target (keys %sessions) {
202	my $expire = Irssi::settings_get_int('quizmaster_timeout');
203	my $pause = Irssi::settings_get_int('quizmaster_pause');
204	if ($sessions{$target}{timestamp}+$expire <= time()) {
205	    line2target($target, '>>> No correct answer within '.$expire.' seconds.');
206	    new_question($target);
207	} else {
208	    my $left = ($sessions{$target}{timestamp}+$expire)-time();
209	    #line2target($target, ' >>>> '.$left.' seconds left');
210	}
211	if ($sessions{$target}{solved} && $sessions{$target}{next}+$pause <= time()) {
212	    new_question($target);
213	}
214    }
215}
216
217sub give_hint ($$) {
218    my ($target, $level) = @_;
219    my $database = $sessions{$target}{current}->[0];
220    my $current = $sessions{$target}{current}->[1];
221    my $answer = $questions{$database}->[$current]{answers}->[0];
222    my $tip;
223    # remove RegExp stuff
224    $answer =~ s/\(//g;
225    $answer =~ s/\)//g;
226    $answer =~ s/\?//g;
227    foreach (0..length($answer)-1) {
228	if (substr($answer, $_, 1) eq ' ') {
229	    $tip .= ' ';
230	} else {
231	    $tip .= '_';
232	}
233    }
234    foreach (0..$level) {
235	my $pos = int( rand()*(length($answer)-1) );
236	my $char = substr($answer, $pos, 1);
237	my $pre = substr($tip, 0, $pos);
238	my $post = substr($tip, $pos+1);
239	$tip = $pre.$char.$post;
240    }
241    return $tip;
242}
243
244sub line2target ($$) {
245    my ($target, $line) = @_;
246    my $witem = Irssi::window_item_find($target);
247    $witem->{server}->command('MSG '.$target.' '.$line);
248    #$witem->print('MSG '.$target.' '.$line);
249}
250
251sub show_scores ($) {
252    my ($target) = @_;
253    my $table;
254    foreach (sort {$sessions{$target}{score}{$b} <=> $sessions{$target}{score}{$a}} keys(%{$sessions{$target}{score}})) {
255	 $table .= "$_ now has ".$sessions{$target}{score}{$_}." points.\n";
256    }
257    my $box = draw_box('Quizmaster for Irssi', $table, 'score', 0);
258    line2target($target, $_) foreach (split(/\n/, $box));
259}
260
261sub list_databases {
262    my $msg;
263    my $sum = 0;
264    foreach (sort keys %questions) {
265	$msg .= '%U'.$_.'%U '."\n";
266	$msg .= ' '.scalar(@{$questions{$_}}).' questions available'."\n";
267	$sum += scalar(@{$questions{$_}});
268    }
269    $msg .= '|'."\n";
270    $msg .= '`===> '.$sum.' questions total'."\n";
271    print CLIENTCRAP &draw_box("Quizmaster", $msg, "databases", 1);
272}
273
274sub list_sessions {
275    my $msg;
276    foreach (sort keys %sessions) {
277        $msg .= '`->%U'.$_.'%U '."\n";
278        $msg .= '     '.scalar(keys %{$sessions{$_}{score}}).' users scored.'."\n";
279    }
280    print CLIENTCRAP &draw_box("Quizmaster", $msg, "sessions", 1);
281}
282
283sub event_nicklist_changed ($$$) {
284    my ($channel, $nick, $oldnick) = @_;
285    my $target = $channel->{name};
286    return unless (defined $sessions{$target} && $sessions{$target}{score}{$oldnick});
287    my $points = $sessions{$target}{score}{$oldnick};
288    $sessions{$target}{score}{$nick->{nick}} = $points;
289    delete $sessions{$target}{score}{$oldnick};
290}
291
292sub init {
293    my $filename = Irssi::settings_get_str('quizmaster_questions_file');
294    load_quizfile($filename);
295}
296
297sub cmd_quizmaster ($$$) {
298    my ($args, $server, $witem) = @_;
299    my @arg = split(/ /, $args);
300    if (scalar(@arg) == 0) {
301	list_sessions();
302    } elsif ($arg[0] eq 'import') {
303	import_quizfile($arg[1], $arg[2]);
304    } elsif ($arg[0] eq 'save') {
305	save_quizfile();
306    } elsif ($arg[0] eq 'load') {
307	init();
308    } elsif ($arg[0] eq 'start') {
309	shift(@arg);
310	if (scalar @arg == 0) {
311	    add_questions($witem->{name}, $_) foreach (keys %questions);
312	} else {
313	    foreach (@arg) {
314		add_questions($witem->{name}, $_) if defined $questions{$_};
315	    }
316	}
317	start_quiz($witem->{name});
318    } elsif ($arg[0] eq 'stop') {
319	stop_quiz($witem->{name});
320    } elsif ($arg[0] eq 'score') {
321	show_scores($witem->{name}) if defined $sessions{$witem->{name}};
322    } elsif ($arg[0] eq 'next') {
323	new_question($witem->{name}) if defined $sessions{$witem->{name}};
324    } elsif ($arg[0] eq 'hint') {
325	line2target($witem->{name}, give_hint($witem->{name}, $arg[1]));
326    } elsif ($arg[0] eq 'list') {
327	list_databases;
328    } elsif ($arg[0] eq 'help') {
329	show_help();
330    }
331}
332
333Irssi::command_bind($IRSSI{'name'}, \&cmd_quizmaster);
334foreach my $cmd ('import', 'load', 'save', 'list', 'help', 'next', 'hint', 'score', 'stop', 'start') {
335Irssi::command_bind('quizmaster '.$cmd => sub {
336                    cmd_quizmaster("$cmd ".$_[0], $_[1], $_[2]); });
337}
338
339
340Irssi::settings_add_int($IRSSI{'name'}, 'quizmaster_points_to_win', 20);
341Irssi::settings_add_int($IRSSI{'name'}, 'quizmaster_timeout', 60);
342Irssi::settings_add_int($IRSSI{'name'}, 'quizmaster_pause', 10);
343Irssi::settings_add_str($IRSSI{'name'}, 'quizmaster_questions_file', "$ENV{HOME}/.irssi/quizmaster_questions");
344
345Irssi::signal_add('message public', 'event_public_message');
346Irssi::signal_add('message own_public', 'event_message_own_public');
347Irssi::signal_add('nicklist changed', 'event_nicklist_changed');
348
349
350Irssi::timeout_add(5000, 'expire_questions', undef);
351
352print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' loaded: /quizmaster help for help';
353
354init();
355