#!/usr/bin/env perl
# The Great Perldoc Perlfunc Quiz!
# by abcde.

use strict;

my $perlfunc  = `perldoc -l perlfunc`;    # Where is perlfunc?
my @functions = ();
my @sentences = ();

my $answered = 0;
my $correct  = 0;
my $hints    = 0;

$SIG{INT} = \&finale;                     # Show the scores when we qu
+it

open( QS, $perlfunc ) or die("Can't open $perlfunc: $!");

while (<QS>) {
    last if /^=head2 Perl Functions by Category/;
}

while (<QS>) {
    last if /^\*/;
    s/C<sub\*>//g;                        # These do not work
    s/C<-I<X>>//g;                        # Because of POD formatting
    while (1) {
        if (/C<(.*?)>/) {
            push @functions, $1;
            s/C<$1>//;
        }
        else { last; }
    }
}

srand(time);

# Make the game slightly easier
@functions = grep { !/^[sg]et/ } @functions;
@functions = grep { !/^end/ } @functions;

# Now we have a list of all the functions
# So play the game!

print "The Perldoc Perlfunc Quiz!\n";
print "Answer '?' for a hint, 'q' to quit.\n";
print "Anything else for an answer.\n\n";

do {

    # Pick a random function
    my $function = $functions[ int rand scalar @functions ];

    # Find some sentences
    seek QS, 0, 0;
    while (<QS>) { last if /^=item $function/; }

    my $sentence = "";
    while (<QS>) {
        next if (/^\s/);
        if (/^=item (.*?)\b/) {
            last unless (/^=item $function/);
        }
        else {
            chomp;
            $sentence .= "$_ ";# if $_ =~ /$function/; ?
        }
    }

    $sentence =~ s/\b$function/\033[36mfoo\033[0m/ig;    # Disguisery!
    $sentence =~ s/.<(.*?)>/$1/g;        # Strip all POD formatting
    @sentences = split /\.\b/, $sentence;
    @sentences = grep ( length $_ > 3, @sentences );    # Remove silly
+ hints
    @sentences = grep ( /[a-zA-Z]/, @sentences );

    while (1) {
        my $hint = $sentences[ int rand scalar @sentences ];
        $hint .= ")" if $hint =~ /^\(/;
        print("Hint: $hint\n");
        my $in = lc <STDIN>;
        chomp $in;
        if ( $in eq "hint" or $in eq "?" ) {
            $hints++;
            next;
        }
        if ( $in eq "quit" or $in eq "q" ) {
            finale();
        }
        if ( $in eq $function ) {
            print "Yes, well done!\n\n";
            $answered++;
            $correct++;
            last;
        }
        else {
            print "No! It was `$function'!\n\n";
            $answered++;
            last;
        }
    }

} while (1);

sub finale {
    if ( $answered == 0 ) {
        print "0 answered, 0 correct = 0%\n";
        print "I hope for your sake you nuked that level\n";
        exit;
    }
    print "$answered answered, $correct correct = "
      . $correct / $answered * 100
      . "% correct\n";
    print "$hints extra hints used = " . $hints / $answered . " per qu
+estion\n";
    print "Thanks for playing!\n";
    close(QS);
    exit;
}
[download]