C Jeopardy: Add tons of new questions; add support for supplemental tidbits; don't obscure dashes and underscors in hints

PBot/VERSION.pm

@@ -13,7 +13,7 @@ use warnings;
 # These are set automatically by the build/commit script
 use constant {
   BUILD_NAME     => "PBot",
-  BUILD_REVISION => 760,
+  BUILD_REVISION => 761,
   BUILD_DATE     => "2014-08-03",
 };
 

modules/cjeopardy.pl

@@ -15,6 +15,9 @@ my $TIMELIMIT = 300;
 my $channel = shift @ARGV;
 my $text = join(' ', @ARGV);
 
+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 }
+
 if ($channel !~ /^#/) {
   print "Sorry, C Jeopardy must be played in a channel.\n";
   exit;
@@ -28,7 +31,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 You may request a new question in $duration.\n";
+    print "The current question is: $last_question";
+    print "You may request a new question in $duration.\n";
     close $fh;
     exit;
   }
@@ -62,7 +66,8 @@ if (not length $text) {
 my @questions;
 open $fh, "<", $CJEOPARDY_FILE or die "Could not open $CJEOPARDY_FILE: $!";
 while (my $question = <$fh>) {
-  my ($question_only) = split /\|/, $question, 2;
+  my ($question_only) = map { decode $_ } split /\|/, encode($question), 2;
+  $question_only =~ s/\\\|/|/g;
   next if length $text and $question_only !~ /\Q$text\E/i;
   push @questions, $question;
 }
@@ -79,11 +84,13 @@ if (length $text) {
 
 my $question = $questions[$question_index];
 
-my ($q, $a) = split /\|/, $question, 2;
+my ($q, $a) = map { decode $_ } split /\|/, encode($question), 2;
 chomp $q;
 chomp $a;
 
+$q =~ s/\\\|/|/g;
 $q =~ s/^\[.*?\]\s+//;
+
 print "$q\n";
 
 open $fh, ">", "$CJEOPARDY_DATA-$channel" or die "Could not open $CJEOPARDY_DATA-$channel: $!";

modules/cjeopardy_answer.pl

@@ -8,6 +8,8 @@ use Text::Levenshtein qw(fastdistance);
 my $CJEOPARDY_DATA = 'cjeopardy.dat';
 my $CJEOPARDY_HINT = 'cjeopardy.hint';
 
+my $hint_only_mode = 0;
+
 my $channel = shift @ARGV;
 my $text = join(' ', @ARGV);
 
@@ -19,15 +21,15 @@ if ($channel !~ /^#/) {
   exit;
 }
 
-$text = lc $text;
-$text =~ s/^\s*is\s*//;
-$text =~ s/^\s*are\s*//;
-$text =~ s/^(a|an)\s+//;
+$text =~ s/^\s*is\s*//i;
+$text =~ s/^\s*are\s*//i;
+$text =~ s/^(a|an)\s+//i;
 $text =~ s/\s*\?*$//;
 $text =~ s/^\s+//;
 $text =~ s/\s+$//;
+my $lctext = lc $text;
 
-if (not length $text) {
+if (not length $lctext) {
   print "What?\n";
   exit;
 }
@@ -43,14 +45,25 @@ foreach my $answer (@valid_answers) {
   chomp $answer;
   $answer =~ s/\\\|/|/g;
 
-  my $distance = fastdistance($text, lc $answer);
-  my $length = (length($text) > length($answer)) ? length $text : length $answer;
+  my $supplemental_text;
+  if ($answer =~ s/\s*{(.*)}\s*$//) {
+    $supplemental_text = $1;
+  }
+
+  my $distance = fastdistance($lctext, lc $answer);
+  my $length = (length($lctext) > length($answer)) ? length $lctext : length $answer;
 
   if ($distance / $length < 0.15) {
     if ($distance == 0) {
-      print "'$answer' is correct!\n";
+      print "'$answer' is correct!";
     } else {
-      print "'$text' is close enough to '$answer'. You are correct!\n"
+      print "'$text' is close enough to '$answer'. You are correct!"
+    }
+
+    if (defined $supplemental_text) {
+      print " $supplemental_text\n";
+    } else {
+      print "\n";
     }
 
     unlink "$CJEOPARDY_DATA-$channel";
@@ -58,8 +71,15 @@ foreach my $answer (@valid_answers) {
 
     if ($channel eq '#cjeopardy') {
       my $question = `./cjeopardy.pl $channel`;
+      
+      if ($hint_only_mode) {
+        my $hint = `./cjeopardy_hint.pl $channel`;
+        $hint =~ s/^Hint: //;
+        print "Next hint: $hint\n";
+      } else {
         print "Next question: $question\n";
       }
+    }
     exit;
   }
 }

modules/cjeopardy_hint.pl

@@ -27,12 +27,18 @@ open my $fh, "<", "$CJEOPARDY_DATA-$channel" or print "There is no open C Jeopar
 @data = <$fh>;
 close $fh;
 
-my @valid_answers = map { lc decode $_ } split /\|/, encode $data[1];
+my @valid_answers = map { decode $_ } split /\|/, encode $data[1];
 
 my ($hint, $length) = ('', 0);
 foreach my $answer (@valid_answers) {
   chomp $answer;
   $answer =~ s/\\\|/|/g;
+
+  my $supplemental_text;
+  if ($answer =~ s/\s*{(.*)}\s*$//) {
+    $supplemental_text = $1;
+  }
+
   if (length $answer > $length) {
     $length = length $answer;
     $hint = $answer;
@@ -47,11 +53,15 @@ if (defined $ret) {
   close $fh;
 }
 
+$last_timeout = 0 if not defined $last_timeout;
+
 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";
     exit;
+  }
 }
 
 $hint_counter++;
@@ -63,11 +73,16 @@ close $fh;
 
 my $hidden_character_count = int length ($hint) * $hints[$hint_counter > $#hints ? $#hints : $hint_counter];
 my $spaces = () = $hint =~ / /g;
+my $dashes = () = $hint =~ /-/g;
+my $underscores = () = $hint =~ /_/g;
 
 my @indices;
-while (@indices <= $hidden_character_count) {
+while (@indices <= $hidden_character_count - $spaces - $dashes - $underscores) {
   my $index = int rand($length);
-  next if substr($hint, $index, 1) eq ' ';
+  my $char = substr($hint, $index, 1);
+  next if $char eq ' ';
+  next if $char eq '-';
+  next if $char eq '_';
   next if grep { $index eq $_ } @indices;
   push @indices, $index; 
 }