C Jeopardy can now be user-filtered to skip undesirable questions

modules/cjeopardy/cjeopardy.pl

@@ -12,6 +12,7 @@ use QStatskeeper;
 
 my $CJEOPARDY_FILE    = 'cjeopardy.txt';
 my $CJEOPARDY_DATA    = 'data/cjeopardy.dat';
+my $CJEOPARDY_FILTER  = 'data/cjeopardy.filter';
 my $CJEOPARDY_HINT    = 'data/cjeopardy.hint';
 my $CJEOPARDY_SHUFFLE = 'data/cjeopardy.shuffle';
 
@@ -44,9 +45,41 @@ if (defined $ret) {
     close $fh;
     exit;
   }
+  close $fh;
+}
+
+my $filter_regex;
+my $filter_text;
+$ret = open $fh, "<", "$CJEOPARDY_FILTER-$channel";
+if (defined $ret) {
+  my $words = <$fh>;
+  close $fh;
+
+  chomp $words;
+
+  $filter_text = $words;
+  $filter_text =~ s/,/, /g;
+  $filter_text =~ s/, ([^,]+)$/ or $1/;
+
+  print "[Filter active! Skipping questions containing $filter_text.]\n";
+
+  my @w = split /,/, $words;
+  my $sep = '';
+  $filter_regex .= '(?:';
+  foreach my $word (@w) {
+    $filter_regex .= $sep;
+    $filter_regex .= $word =~ m/^\w/ ? '\b' : '\B';
+    $filter_regex .= quotemeta $word;
+    $filter_regex .= $word =~ m/\w$/ ? '\b' : '\B';
+    $sep = '|';
+  }
+  $filter_regex .= ')';
 }
 
 my $question_index;
+my $shuffles = 0;
+
+NEXT_QUESTION:
 
 if (not length $text) {
   $ret = open $fh, "<", "$CJEOPARDY_SHUFFLE-$channel";
@@ -58,6 +91,7 @@ if (not length $text) {
     if (not @indices) {
       print "$color{teal}(Shuffling.)$color{reset}\n";
       shuffle_questions(0);
+      $shuffles++;
     } else {
       open my $fh, ">", "$CJEOPARDY_SHUFFLE-$channel" or print "Failed to shuffle questions.\n" and exit;
       foreach my $index (@indices) {
@@ -68,6 +102,7 @@ if (not length $text) {
   } else {
     print "$color{teal}(Shuffling!)$color{reset}\n";
     $question_index = shuffle_questions(1);
+    $shuffles++;
   }
 }
 
@@ -77,12 +112,21 @@ while (my $question = <$fh>) {
   my ($question_only) = map { decode $_ } split /\|/, encode($question), 2;
   $question_only =~ s/\\\|/|/g;
   next if length $text and $question_only !~ /\Q$text\E/i;
+  next if defined $filter_regex and $question_only =~ /$filter_regex/i;
   push @questions, $question;
 }
 close $fh;
 
 if (not @questions) {
-  print "No questions containing '$text' found.\n";
+  if (length $text) {
+    print "No questions containing '$text' found.\n";
+  } else {
+    if ($shuffles <= 1) {
+      goto NEXT_QUESTION;
+    } else {
+      print "No questions available.\n";
+    }
+  }
   exit;
 }
 
@@ -92,6 +136,10 @@ if (length $text) {
 
 my $question = $questions[$question_index];
 
+if (not defined $question) {
+  goto NEXT_QUESTION;
+}
+
 my ($q, $a) = map { decode $_ } split /\|/, encode($question), 2;
 chomp $q;
 chomp $a;

modules/cjeopardy/cjeopardy_answer.pl

@@ -308,6 +308,9 @@ foreach my $answer (@valid_answers) {
         $hint =~ s/^Hint: //;
         print "Next hint: $hint\n";
       } else {
+        if ($question =~ s/^(\[Filter active[^\n]+\n)//) {
+          print $1;
+        }
         print "$color{magneta}Next question$color{reset}: $question\n";
       }
     }

modules/cjeopardy/cjeopardy_filter.pl

@@ -0,0 +1,69 @@
+#!/usr/bin/env perl
+
+use warnings;
+use strict;
+
+use Fcntl qw(:flock);
+
+my $MAX_WORDS = 3;
+
+my $CJEOPARDY_DATA   = 'data/cjeopardy.dat';
+my $CJEOPARDY_FILTER = 'data/cjeopardy.filter';
+
+my $channel = shift @ARGV;
+my $filter  = join(' ', @ARGV);
+
+if ($channel !~ /^#/) {
+  print "Sorry, C Jeopardy must be played in a channel. Feel free to join #cjeopardy.\n";
+  exit;
+}
+
+if (not length $filter) {
+  my $ret = open my $fh, '<', "$CJEOPARDY_FILTER-$channel";
+  if (not defined $ret) {
+    print "There is no filter active for $channel. Usage: filter <comma or space separated list of words> or `filter clear` to clear.\n";
+    exit;
+  }
+
+  my $words = <$fh>;
+  close $fh;
+  chomp $words;
+  $words =~ s/,/, /;
+  $words =~ s/, ([^,]+)$/ or $1/;
+  print "Filter active. Questions containing $words will be skipped. Usage: filter <comma or space separated list of words> or `filter clear` to clear.\n";
+  exit;
+}
+
+open my $semaphore, ">", "$CJEOPARDY_DATA-$channel.lock" or die "Couldn't create semaphore lock: $!";
+flock $semaphore, LOCK_EX;
+
+$filter = lc $filter;
+
+if ($filter eq 'clear') {
+  unlink "$CJEOPARDY_FILTER-$channel";
+  print "Filter cleared.\n";
+  exit;
+}
+
+$filter =~ s/(^\s+|\s+$)//g;
+my @words = split /[ ,]+/, $filter;
+
+if (not @words) {
+  print "What?\n";
+  exit;
+}
+
+if (@words > $MAX_WORDS) {
+  print "Too many words. You may set up to $MAX_WORDS word" . ($MAX_WORDS == 1 ? '' : 's') . " in the filter.\n";
+  exit;
+}
+
+open my $fh, '>', "$CJEOPARDY_FILTER-$channel" or die "Couldn't open $CJEOPARDY_FILTER-$channel: $!";
+print $fh join ',', @words;
+print $fh "\n";
+close $fh;
+
+my $w = join ', ', @words;
+$w =~ s/, ([^,]+)$/ or $1/;
+print "Questions containing $w will be skipped.\n";
+exit;