Adding upstream version 20231031.upstream/20231031upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

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();