Improvements to C Jeopardy module

Moved to its own cjeopardy directory.

Added IRCColors module to print colored text.

Added Scorekeeper module to track scoring statistics.

modules/cjeopardy/.gitignore

@@ -0,0 +1 @@
+scores.sqlite

modules/cjeopardy/IRCColors.pm

@@ -0,0 +1,38 @@
+#!/usr/bin/env perl
+
+use warnings;
+use strict;
+
+package IRCColors;
+
+use Exporter;
+our @ISA = 'Exporter';
+our @EXPORT = qw(%color);
+
+our %color = (
+  white      => "\x0300",
+  black      => "\x0301",
+  blue       => "\x0302",
+  green      => "\x0303",
+  red        => "\x0304",
+  maroon     => "\x0305",
+  purple     => "\x0306",
+  orange     => "\x0307",
+  yellow     => "\x0308",
+  lightgreen => "\x0309",
+  teal       => "\x0310",
+  cyan       => "\x0311",
+  lightblue  => "\x0312",
+  magneta    => "\x0313",
+  gray       => "\x0314",
+  lightgray  => "\x0315",
+
+  bold       => "\x02",
+  italics    => "\x1D",
+  underline  => "\x1F",
+  reverse    => "\x16",
+
+  reset      => "\x0F",
+);
+
+1;

modules/cjeopardy/Scorekeeper.pm

@@ -0,0 +1,153 @@
+#!/usr/bin/env perl
+
+package Scorekeeper;
+
+use warnings;
+use strict;
+
+use DBI;
+use Carp qw(shortmess);
+
+sub new {
+  my ($class, %conf) = @_;
+  my $self = bless {}, $class;
+  $self->initialize(%conf);
+  return $self;
+}
+
+sub initialize {
+  my ($self, %conf) = @_;
+  $self->{filename} = $conf{filename} // 'scores.sqlite';
+}
+
+sub begin {
+  my $self = shift;
+
+  print STDERR "Opening scores SQLite database: $self->{filename}\n";
+
+  $self->{dbh} = DBI->connect("dbi:SQLite:dbname=$self->{filename}", "", "", { RaiseError => 1, PrintError => 0 }) or die $DBI::errstr;
+
+  eval {
+    $self->{dbh}->do(<< 'SQL');
+CREATE TABLE IF NOT EXISTS Scores (
+   id                               INTEGER PRIMARY KEY,
+   nick                             TEXT NOT NULL,
+   channel                          TEXT NOT NULL,
+   correct_answers                  INTEGER DEFAULT 0,
+   wrong_answers                    INTEGER DEFAULT 0,
+   lifetime_correct_answers         INTEGER DEFAULT 0,
+   lifetime_wrong_answers           INTEGER DEFAULT 0,
+   correct_streak                   INTEGER DEFAULT 0,
+   wrong_streak                     INTEGER DEFAULT 0,
+   lifetime_highest_correct_streak  INTEGER DEFAULT 0,
+   lifetime_highest_wrong_streak    INTEGER DEFAULT 0,
+   highest_correct_streak           INTEGER DEFAULT 0,
+   highest_wrong_streak             INTEGER DEFAULT 0,
+   hints                            INTEGER DEFAULT 0,
+   lifetime_hints                   INTEGER DEFAULT 0,
+   last_wrong_timestamp             NUMERIC DEFAULT 0,
+   last_correct_timestamp           NUMERIC DEFAULT 0,
+   quickest_correct                 NUMERIC DEFAULT 0
+)
+SQL
+  };
+
+  print STDERR $@ if $@;
+}
+
+sub end {
+  my $self = shift;
+
+  print STDERR "Closing scores SQLite database\n";
+
+  if(exists $self->{dbh} and defined $self->{dbh}) {
+    $self->{dbh}->disconnect();
+    delete $self->{dbh};
+  }
+}
+
+sub add_player {
+  my ($self, $nick, $channel) = @_;
+
+  my $id = eval {
+    my $sth = $self->{dbh}->prepare('INSERT INTO Scores (nick, channel) VALUES (?, ?)');
+    $sth->bind_param(1, $nick) ;
+    $sth->bind_param(2, $channel) ;
+    $sth->execute();
+    return $self->{dbh}->sqlite_last_insert_rowid();
+  };
+
+  print STDERR $@ if $@;
+  return $id;
+}
+
+sub get_player_id {
+  my ($self, $nick, $channel) = @_;
+
+  my $id = eval {
+    my $sth = $self->{dbh}->prepare('SELECT id FROM Scores WHERE nick = ? AND channel = ?');
+    $sth->bind_param(1, $nick);
+    $sth->bind_param(2, $channel);
+    $sth->execute();
+    my $row = $sth->fetchrow_hashref();
+    return $row->{id};
+  };
+
+  print STDERR $@ if $@;
+
+  $id = $self->add_player($nick, $channel) if not defined $id;
+  return $id;
+}
+
+sub get_player_data {
+  my ($self, $id, @columns) = @_;
+
+  my $player_data = eval {
+    my $sql = 'SELECT ';
+
+    if(not @columns) {
+      $sql .= '*';
+    } else {
+      my $comma = '';
+      foreach my $column (@columns) {
+        $sql .= "$comma$column";
+        $comma = ', ';
+      }
+    }
+
+    $sql .= ' FROM Scores WHERE id = ?';
+    my $sth = $self->{dbh}->prepare($sql);
+    $sth->bind_param(1, $id);
+    $sth->execute();
+    return $sth->fetchrow_hashref();
+  };
+  return $player_data;
+}
+
+sub update_player_data {
+  my ($self, $id, $data) = @_;
+
+  eval {
+    my $sql = 'UPDATE Scores SET ';
+
+    my $comma = '';
+    foreach my $key (keys %$data) {
+      $sql .= "$comma$key = ?";
+      $comma = ', ';
+    }
+
+    $sql .= ' WHERE id = ?';
+
+    my $sth = $self->{dbh}->prepare($sql);
+
+    my $param = 1;
+    foreach my $key (keys %$data) {
+      $sth->bind_param($param++, $data->{$key});
+    }
+
+    $sth->bind_param($param, $id);
+    $sth->execute();
+  };
+}
+
+1;

modules/cjeopardy/cjeopardy.pl

@@ -6,9 +6,11 @@ use strict;
 use Time::HiRes qw/gettimeofday/;
 use Time::Duration qw/duration/;
 
+use IRCColors;
+
 my $CJEOPARDY_FILE    = 'cjeopardy.txt';
-my $CJEOPARDY_DATA    = 'cjeopardy.dat';
+my $CJEOPARDY_DATA    = 'data/cjeopardy.dat';
-my $CJEOPARDY_SHUFFLE = 'cjeopardy.shuffle';
+my $CJEOPARDY_SHUFFLE = 'data/cjeopardy.shuffle';
 
 my $TIMELIMIT = 300;
 
@@ -31,8 +33,8 @@ if (defined $ret) {
   
   if (scalar gettimeofday - $last_timestamp <= $TIMELIMIT) {
     my $duration = duration($TIMELIMIT - scalar gettimeofday - $last_timestamp);
-    print "The current question is: $last_question";
+    print "$color{green}The current question is$color{reset}: $last_question";
-    print "You may request a new question in $duration.\n";
+    print "$color{red}You may request a new question in $duration.$color{reset}\n";
     close $fh;
     exit;
   }
@@ -48,7 +50,7 @@ if (not length $text) {
     close $fh;
 
     if (not @indices) {
-      print "(Shuffling.)\n";
+      print "$color{teal}(Shuffling.)$color{reset}\n";
       shuffle_questions(0);
     } else {
       open my $fh, ">", "$CJEOPARDY_SHUFFLE-$channel" or print "Failed to shuffle questions.\n" and exit;
@@ -58,7 +60,7 @@ if (not length $text) {
       close $fh;
     }
   } else {
-    print "(Shuffling!)\n";
+    print "$color{teal}(Shuffling!)$color{reset}\n";
     $question_index = shuffle_questions(1);
   }
 }
@@ -91,6 +93,7 @@ chomp $a;
 $q =~ s/\\\|/|/g;
 $q =~ s/^\[.*?\]\s+//;
 
+$q =~ s/(this keyword|this operator|this behavior|this preprocessing directive|this escape sequence|this mode|this function specifier|this function|this macro|this predefined macro|this header|this pragma|this fprintf length modifier|this type qualifier|this type|this value|this operand|this many|this|these)/$color{bold}$1$color{reset}/gi;
 print "$q\n";
 
 open $fh, ">", "$CJEOPARDY_DATA-$channel" or die "Could not open $CJEOPARDY_DATA-$channel: $!";

modules/cjeopardy/cjeopardy.txt

@@ -8,8 +8,8 @@
 [3.6 Terms, definitions, and symbols] A byte is composed of a contiguous sequence of bits, the number of which is this.|implementation-defined{Bet you thought it was 8!}
 [3.6 Terms, definitions, and symbols] The least significant bit is called this.|low-order bit|low-order
 [3.6 Terms, definitions, and symbols] The most significant bit is called this.|high-order bit|high-order
-[3.6 Terms, definitions, and symbols] The the low-order bit is also known as this.|least significant bit|least significant
+[3.6 Terms, definitions, and symbols] The low-order bit is also known as this.|least significant bit|least significant
-[3.6 Terms, definitions, and symbols] The the high-order bit is also known as this.|most significant bit|most significant
+[3.6 Terms, definitions, and symbols] The high-order bit is also known as this.|most significant bit|most significant
 [3.15 Terms, definitions, and symbols] This is a region of data storage in the execution environment, the contents of which can represent values.|object
 [3.15 Terms, definitions, and symbols] An object is a region of data storage in the execution environment, the contents of which can represent these.|values
 [4. Conformance] In the standard, ``shall'' is to be interpreted as this on an implementation, or on a program.|requirement{If violated, the behavior is undefined.}
@@ -272,7 +272,7 @@
 [6.2.5 Types] The construction of a pointer type from a referenced type is called this.|pointer type derivation
 [6.2.5 Types] This type describes the type designated by the construct _Atomic (type-name).|atomic
 [6.2.5 Types] An array type of unknown size is this kind of type.|incomplete
-[6.2.5 Types] A type has known constant size if the type is not incomplete and is not this type of array.|VLA{VLA stands for variable length array.}|variable length array
+[6.2.5 Types] A type has known constant size if the type is not incomplete and is not this type of array.|VLA{VLA stands for variable length array.}|variable length|variable length array
 [6.2.5 Types] A pointer to void shall have the same representation and alignment requirements as a pointer to this type.|char|character
 [6.2.6.1 General] Values stored in unsigned bit-fields and objects of type unsigned char shall be represented using this notation.|binary|pure binary|pure binary notation
 [6.2.6.1 General] A value may be copied into an object of type unsigned char [n] (e.g., by memcpy); the resulting set of bytes is called this.|object representation
@@ -997,7 +997,8 @@
 [7.21.9.2 The fseek function] This function sets the file position indicator for the stream pointed to by its stream argument.|fseek
 [7.21.9.2 The fseek function] For a text stream, offset argument shall be either zero or a value returned by an earlier successful call to the ftell function on a stream associated with the same file and its whence argument shall be this.|SEEK_SET
 [7.21.9.2 The fseek function] The fseek function returns this value for a request that cannot be satisfied.|nonzero|!0
-[7.21.9.3 The fsetpos function] This function sets the mbstate_t object (if any) and file position indicator for the stream pointed to by stream according to the value of the object pointed to by pos, which shall be a value obtained from an earlier successful call to this function on a stream associated with the same file.|fsetpos
+[7.21.9.3 The fsetpos function] This function sets the mbstate_t object (if any) and file position indicator for the stream pointed to by stream according to the value of the object pointed to by pos.|fsetpos
+[7.21.9.3 The fsetpos function] The fsetpos function sets the mbstate_t object (if any) and file position indicator for the stream pointed to by stream according to the value of the object pointed to by pos, which shall be a value obtained from an earlier successful call to this function on a stream associated with the same file.|fgetpos
 [7.21.9.4 The ftell function] This function obtains the current value of the file position indicator for the stream pointed to by stream.|ftell
 [7.21.9.5 The rewind function] This function sets the file position indicator for the stream pointed to by stream to the beginning of the file.|rewind
 [7.21.10.1 The clearerr function] This function clears the end-of-file and error indicators for the stream pointed to by stream.|clearerr

modules/cjeopardy/cjeopardy_answer.pl

@@ -6,14 +6,17 @@ use strict;
 use Text::Levenshtein qw(fastdistance);
 use Time::HiRes qw(gettimeofday);
 
-my $CJEOPARDY_DATA = 'cjeopardy.dat';
+use Scorekeeper;
-my $CJEOPARDY_HINT = 'cjeopardy.hint';
+use IRCColors;
-my $CJEOPARDY_LAST_ANSWER = 'cjeopardy.last_ans';
+
+my $CJEOPARDY_DATA        = 'data/cjeopardy.dat';
+my $CJEOPARDY_HINT        = 'data/cjeopardy.hint';
+my $CJEOPARDY_LAST_ANSWER = 'data/cjeopardy.last_ans';
 
 my $hint_only_mode = 0;
 
-my $channel = shift @ARGV;
 my $nick = shift @ARGV;
+my $channel = shift @ARGV;
 my $text = join(' ', @ARGV);
 
 sub encode { my $str = shift; $str =~ s/\\(.)/{sprintf "\\%03d", ord($1)}/ge; return $str; }
@@ -85,9 +88,9 @@ if (defined $ret) {
 
       if ($distance / $length < 0.15) {
         if ($last_nick eq $nick) {
-          print "Er, you already correctly answered that question.\n";
+          print "$color{red}Er, you already correctly answered that question.$color{reset}\n";
         } else {
-          print "Too slow! $last_nick got the correct answer.\n";
+          print "$color{red}Too slow! $color{orange}$last_nick$color{red} got the correct answer.$color{reset}\n";
         }
         exit;
       }
@@ -101,6 +104,11 @@ if (not @data) {
   close $fh;
 }
 
+my $scores = Scorekeeper->new;
+$scores->begin;
+my $player_id = $scores->get_player_id($nick, $channel);
+my $player_data = $scores->get_player_data($player_id);
+
 my @valid_answers = map { decode $_ } split /\|/, encode $data[1];
 
 my $incorrect_percentage = 100;
@@ -115,13 +123,17 @@ foreach my $answer (@valid_answers) {
   }
 
   if ($answer =~ /^[0-9]+$/ and $lctext =~ /^[0-9]+$/) {
+    my $is_wrong = 0;
+
     if ($lctext > $answer) {
-      print "$lctext is too big!\n";
+      print "$color{red}$lctext is too high!$color{reset}\n";
-      exit;
+      $is_wrong = 1;
     } elsif ($lctext < $answer) {
-      print "$lctext is too small!\n";
+      print "$color{red}$lctext is too low!$color{reset}\n";
-      exit;
+      $is_wrong = 1;
     }
+
+    goto WRONG_ANSWER if $is_wrong;
   }
 
   my $distance = fastdistance($lctext, lc $answer);
@@ -135,13 +147,13 @@ foreach my $answer (@valid_answers) {
 
   if ($percentage < 15) {
     if ($distance == 0) {
-      print "'$answer' is correct!";
+      print "'$color{green}$answer$color{reset}' is correct!";
     } else {
-      print "'$text' is close enough to '$answer'. You are correct!"
+      print "'$color{green}$text$color{reset}' is close enough to '$color{green}$answer$color{reset}'. You are correct!"
     }
 
     if (defined $supplemental_text) {
-      print " $supplemental_text\n";
+      print " $color{teal}$supplemental_text$color{reset}\n";
     } else {
       print "\n";
     }
@@ -155,27 +167,62 @@ foreach my $answer (@valid_answers) {
     close $fh;
 
     if ($channel eq '#cjeopardy') {
-      my $question = `./cjeopardy.pl $channel`;
+      my $question = `./cjeopardy/cjeopardy.pl $channel`;
       
       if ($hint_only_mode) {
-        my $hint = `./cjeopardy_hint.pl $channel`;
+        my $hint = `./cjeopardy/cjeopardy_hint.pl $channel`;
         $hint =~ s/^Hint: //;
         print "Next hint: $hint\n";
       } else {
-        print "Next question: $question\n";
+        print "$color{green}Next question$color{reset}: $question\n";
       }
     }
+    
+    $player_data->{correct_answers}++;
+    $player_data->{lifetime_correct_answers}++;
+    $player_data->{correct_streak}++;
+    $player_data->{last_correct_timestamp} = scalar gettimeofday;
+    $player_data->{wrong_streak} = 0;
+
+    if ($player_data->{correct_streak} > $player_data->{highest_correct_streak}) {
+      $player_data->{highest_correct_streak} = $player_data->{correct_streak};
+    }
+
+    if ($player_data->{highest_correct_streak} > $player_data->{lifetime_highest_correct_streak}) {
+      $player_data->{lifetime_highest_correct_streak} = $player_data->{highest_correct_streak};
+    }
+
+    $scores->update_player_data($player_id, $player_data);
+    $scores->end;
     exit;
   }
 }
 
 my $correct_percentage = 100 - $incorrect_percentage;
 if ($correct_percentage >= 80) {
-  printf "Sorry, '$text' is %.1f%% correct. So close!\n", $correct_percentage;
+  printf "Sorry, '$color{red}$text$color{reset}' is %.1f%% correct. So close!\n", $correct_percentage;
 } elsif ($correct_percentage >= 70) {
-  printf "Sorry, '$text' is %.1f%% correct. Almost.\n", $correct_percentage;
+  printf "Sorry, '$color{red}$text$color{reset}' is %.1f%% correct. Almost.\n", $correct_percentage;
 } elsif ($correct_percentage >= 50) {
-  printf "Sorry, '$text' is only %.1f%% correct.\n", $correct_percentage;
+  printf "Sorry, '$color{red}$text$color{reset}' is only %.1f%% correct.\n", $correct_percentage;
 } else {
-  print "Sorry, '$text' is incorrect.\n";
+  print "Sorry, '$color{red}$text$color{reset}' is incorrect.\n";
 }
+
+WRONG_ANSWER:
+$player_data->{wrong_answers}++;
+$player_data->{lifetime_wrong_answers}++;
+$player_data->{wrong_streak}++;
+$player_data->{last_wrong_timestamp} = scalar gettimeofday;
+$player_data->{correct_streak} = 0;
+
+if ($player_data->{wrong_streak} > $player_data->{highest_wrong_streak}) {
+  $player_data->{highest_wrong_streak} = $player_data->{wrong_streak};
+}
+
+if ($player_data->{highest_wrong_streak} > $player_data->{lifetime_highest_wrong_streak}) {
+  $player_data->{lifetime_highest_wrong_streak} = $player_data->{highest_wrong_streak};
+}
+
+$scores->update_player_data($player_id, $player_data);
+$scores->end;

modules/cjeopardy/cjeopardy_hint.pl

@@ -6,14 +6,20 @@ use strict;
 use Time::HiRes qw/gettimeofday/;
 use Time::Duration qw/duration/;
 
-my $CJEOPARDY_DATA = 'cjeopardy.dat';
+use Scorekeeper;
-my $CJEOPARDY_HINT = 'cjeopardy.hint';
+use IRCColors;
+
+my $CJEOPARDY_DATA   = 'data/cjeopardy.dat';
+my $CJEOPARDY_HINT   = 'data/cjeopardy.hint';
 
 my @hints = (0.90, 0.75, 0.50, 0.25, 0.10);
 my $timeout = 30;
 
+my $nick    = shift @ARGV;
 my $channel = shift @ARGV;
 
+print STDERR "nick: $nick, channel: $channel\n";
+
 sub encode { my $str = shift; $str =~ s/\\(.)/{sprintf "\\%03d", ord($1)}/ge; return $str; }
 sub decode { my $str = shift; $str =~ s/\\(\d{3})/{"\\" . chr($1)}/ge; return $str }
 
@@ -59,7 +65,7 @@ my $duration = scalar gettimeofday - $last_timeout;
 if ($duration < $timeout) {
   $duration = duration($timeout - $duration);
   unless ($duration eq 'just now') {
-    print "Please wait $duration before requesting another hint.\n";
+    print "$color{red}Please wait $duration before requesting another hint.$color{reset}\n";
     exit;
   }
 }
@@ -91,4 +97,13 @@ foreach my $index (@indices) {
   substr $hint, $index, 1, '.';
 }
 
-print "Hint: $hint\n";
+print "$color{lightgreen}Hint$color{reset}: $hint\n";
+
+my $scores = Scorekeeper->new;
+$scores->begin;
+my $id = $scores->get_player_id($nick, $channel);
+my $player_data = $scores->get_player_data($id, 'hints', 'lifetime_hints');
+$player_data->{hints}++;
+$player_data->{lifetime_hints}++;
+$scores->update_player_data($id, $player_data);
+$scores->end;

modules/cjeopardy/data/.gitignore

@@ -0,0 +1 @@
+*