The Perldoc Perlfunc Quiz

[abcde]

The Perldoc Perlfunc Quiz test your knowledge of the builtin functions. It reads the perlfunc file, gets a random function, and offers you sentences from its documentation as hints until you can guess at it.

It's not meant to be serious, but if you're learning things from it, great!

To play: The program gives you a hint, and you must try to answer. If this hint is not enough - it often isn't - answer "?" or "hint" for another one. If you're fed up, "q" or "quit" will reveal your score. Any other response will be taken as your answer. Good luck!

Example session:

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

Hint: This call is actually implemented in terms of foofrom(2) system 
+call.
?
Hint: Attempts to receive LENGTH characters of data into variable SCAL
+AR from the specified SOCKET filehandle.
recv
Yes, well done!

Hint: Has no effect if the variable is not tied.
untie
Yes, well done!

Hint: If EXPR is omitted, uses $_ .
?
Hint: If EXPR is omitted, uses $_ .
?
Hint: Returns the value of EXPR with the first character in uppercase 
+(titlecase in Unicode).
uc
No! It was `ucfirst'.

q
2 answered, 3 correct = 66.6666666% correct
3 extra hints used = 1 per question
Thanks for playing!

---

#!/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;
}

Edited by demerphq, added readmore.