gen.pl

#!/usr/bin/env perl

use 5.012;
use strict;
use warnings;

use JSON;
use IPC::Open2;
use Digest::MD5 qw(md5_base64);

my @hlwords  = qw/immer nie jede jedem jedes muss keine alle nicht/;
my @markdown = qw/pandoc -f markdown --html-q-tags --ascii/;

my $question;
my $single_choice;
my $source;
my $media;
my %last_option;
my @options;
my @questions = ();

sub md {    # pipe through $markdown
  my ($input) = @_;
  my $pid = open2(\*OUT, \*IN, @markdown)
    or die "open2() failed $!";
  print IN $input;
  close(IN);
  waitpid($pid, 0);

  my $html = do { local $/; <OUT> };
  my $match = join("|", @hlwords);
  $html =~ s!\b($match)\b!<span class="hl">$1</span>!;
  return $html;
}

sub add {
  return unless %last_option;

  if ($last_option{"comment"}) {
    if (defined $last_option{"correct"}) {
      if (($last_option{"correct"} eq JSON::true) and
	  ($last_option{"comment"} =~ /^\s*Nein,/)) {
	warn "$ARGV:$.: Correct answer starting with \"Nein\"\n";
      }
      if (($last_option{"correct"} eq JSON::false) and
	  ($last_option{"comment"} =~ /^\s*Ja,/)) {
	warn "$ARGV:$.: Wrong answer starting with \"Ja\"\n";
      }
    }
    $last_option{"comment"} = md($last_option{"comment"});
  }
  
  push(@options, {%last_option});
}

while (<>) {
  if (/^\s*#/) {
    # ignore comments
  } elsif (/^\.$/) {
    add();

    die "end of block without a question at line $ARGV:$.\n"
      unless defined $question;

    my $any = 0;
    foreach my $opt (@options) {
      $opt->{"option"} = md($opt->{"option"})
	if $opt->{"option"};
      $any = 1 if (not (defined $opt->{"correct"})) or ($opt->{"correct"} eq JSON::true);
    }
    die "no correct option at \"$question\" ($ARGV)\n"
      if not($any) and $single_choice;

    my %ent =
      (
       "id"       => md5_base64($ARGV . $question),
       "question" => md($question),
       "options"  => [@options],
       "multiple" => ($single_choice eq "0" ? \0 : \1)
      );
    $ent{"source"} = $source if defined $source;
    $ent{"media"}  = $media  if defined $media;

    push(@questions, { %ent });
    undef $question;
    undef $single_choice;
    undef $source;
    undef $media;
    undef %last_option;
    undef @options;
  } elsif (/^([01])(.*?)$/) {
    $single_choice = $1;

    $question = $2;
    chomp $question;

    if ($question =~ /\(([[0-9]{4}-[0-9]{2})\)/) {
      $source = $1;
      $question =~ s/\Q($source)\E//;
      chomp $source;
    }
  } elsif (/^[|](.*)/) {
    if ($last_option{"option"}) {
      $last_option{"option"} .= "$1\n";
    } else {
      $question .= "$1\n";
    }
  } elsif (/^@(.*)/) {
    $media = $1;
    chomp $media;
  } elsif (/^([-+?])\s*(.*)/) {
    add();
    %last_option =
      (
       "option"  => $2,
       "correct" => $1 eq "+" ? JSON::true : $1 eq "-" ? JSON::false : JSON::null
      );
  } elsif (/^.*$/) {		# non-empty line
    $last_option{"comment"} .= $_
      if %last_option;
  }
}

say (to_json [@questions]);