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