html/quizmaster.pl
1 # Quizmaster.pl by Stefan "tommie" Tomanek (stefan@pico.ruhr.de)
2 use strict;
3
4 use vars qw($VERSION %IRSSI);
5 $VERSION = '20030208';
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
18 use Irssi;
19 use Data::Dumper;
20
21 use vars qw(%sessions %questions);
22
23 sub 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
47 sub 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
59 sub 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
71 sub 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
84 sub 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
122 sub add_questions ($$) {
123 my ($target, $name) = @_;
124 push @{$sessions{$target}{questions}}, $name;
125 }
126
127 sub 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
136 sub start_quiz ($) {
137 my ($channel) = @_;
138 line2target($channel, '>>>> A new Quiz has been started <<<<');
139 new_question($channel);
140 }
141
142 sub stop_quiz ($) {
143 my ($target) = @_;
144 show_scores($target);
145 line2target($target, '>>>> The Quiz has been stopped <<<<');
146 delete $sessions{$target};
147 }
148
149 sub 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
154 sub 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
159 sub 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
173 sub 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
188 sub 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
200 sub 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
217 sub 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
244 sub 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
251 sub 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
261 sub 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
274 sub 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
283 sub 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
292 sub init {
293 my $filename = Irssi::settings_get_str('quizmaster_questions_file');
294 load_quizfile($filename);
295 }
296
297 sub 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
333 Irssi::command_bind($IRSSI{'name'}, \&cmd_quizmaster);
334 foreach my $cmd ('import', 'load', 'save', 'list', 'help', 'next', 'hint', 'score', 'stop', 'start') {
335 Irssi::command_bind('quizmaster '.$cmd => sub {
336 cmd_quizmaster("$cmd ".$_[0], $_[1], $_[2]); });
337 }
338
339
340 Irssi::settings_add_int($IRSSI{'name'}, 'quizmaster_points_to_win', 20);
341 Irssi::settings_add_int($IRSSI{'name'}, 'quizmaster_timeout', 60);
342 Irssi::settings_add_int($IRSSI{'name'}, 'quizmaster_pause', 10);
343 Irssi::settings_add_str($IRSSI{'name'}, 'quizmaster_questions_file', "$ENV{HOME}/.irssi/quizmaster_questions");
344
345 Irssi::signal_add('message public', 'event_public_message');
346 Irssi::signal_add('message own_public', 'event_message_own_public');
347 Irssi::signal_add('nicklist changed', 'event_nicklist_changed');
348
349
350 Irssi::timeout_add(5000, 'expire_questions', undef);
351
352 print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' loaded: /quizmaster help for help';
353
354 init();