CODEWITHSUNDEEP
regexperlstring-matching
kspaeth
kspaeth

Reputation: 31

Print out preceding lines after regex match

I am writing a sort of quiz program. I am using a .txt file as a test bank, but cant figure out how to (using regex's) match each question and print out the possible answers on different lines.I originally was just going to do true false so I didnt need to match anything else and just matching "1" worked fine. Basically I just need the question on one line and the answers on others. Here is an example of a question

1.) some text
 a.) solution 
 b.) solution 
 c.) solution

code i had before:

while (<$test>) {

    foreach my $line (split /\n/) {

        my $match1 = "1";

            if ($line =~ /$match1/) {
                $question1 = $line;
                print "$question1\n";
                print "Answer: ";           
                $answer1 = <>;
                chomp ($answer1);
                    if ( $answer1 =~ /(^a$)/i) {
                        $score1 = 20;
                            push @score, $score1;
                    }       
            }

Upvotes: 1

Views: 104

Answers (2)

user557597
user557597

Reputation:

This is probably over simplified.
It just reads in the test data and creates a structure.
You could use it to grade test takers answers. 

use strict;
use warnings;

use Data::Dumper;

$/ = undef;

my $testdata = <DATA>;

my %HashTest = ();
my $hchoices;
my $hqeustion;
my $is_question = 0;

while ( $testdata =~ /(^.*)\n/mg )
{
    my $line = $1;
    $line =~ s/^\s+|\s+$//g;
    next if ( length( $line ) == 0);

    if ( $line =~ /^(\d+)\s*\.\s*\)\s*(.*)/ )
    {
       $is_question = 1;
       $HashTest{ $1 }{'question'} = $2;
       $HashTest{ $1 }{'choices'}  = {};
       $HashTest{ $1 }{'answer'}  = 'unknown';

       $hqeustion = $HashTest{ $1 };
       $hchoices  = $HashTest{ $1 }{'choices'};
    }
    elsif ( $is_question && $line =~ /^\s*(answer)\s*:\s*([a-z])/ )
    {
        $hqeustion->{'answer'} = $2;
    }
    elsif ( $is_question && $line =~ /^\s*([a-z])\s*\.\s*\)\s*(.*)/ )
    {
        $hchoices->{ $1 } = $2;
    }
}

print "\nQ & A summary\n-------------------------\n";

for my $qnum ( keys %HashTest )
{
    print "Question $qnum:  $HashTest{$qnum}{'question'}'\n";
    my $ans_code = $HashTest{$qnum}{'answer'};
    print "Answer: ($ans_code)  $HashTest{$qnum}{'choices'}{$ans_code}\n\n";
}

print "---------------------------\n";
print Dumper(\%HashTest);


__DATA__

1.) What is the diameter of the earth?
 a.) Half the distance to the sun 
 b.) Same as the moon 
 c.) 6,000 miles
 answer: c

2.) Who is buried in Grants Tomb?
 a.) Thomas Edison 
 b.) Grant, who else 
 c.) Jimi Hendrix
 answer: b

Output: 

Q & A summary
-------------------------
Question 1:  What is the diameter of the earth?'
Answer: (c)  6,000 miles

Question 2:  Who is buried in Grants Tomb?'
Answer: (b)  Grant, who else

---------------------------
$VAR1 = {
          '1' => {
                   'question' => 'What is the diameter of the earth?',
                   'answer' => 'c',
                   'choices' => {
                                  'c' => '6,000 miles',
                                  'a' => 'Half the distance to the sun',
                                  'b' => 'Same as the moon'
                                }
                 },
          '2' => {
                   'question' => 'Who is buried in Grants Tomb?',
                   'answer' => 'b',
                   'choices' => {
                                  'c' => 'Jimi Hendrix',
                                  'a' => 'Thomas Edison',
                                  'b' => 'Grant, who else'
                                }
                 }
        };

Upvotes: 0

Axeman
Axeman

Reputation: 29854

I really couldn't get what you were getting at, so I wrote this sample program.

use 5.016;
use strict;
use warnings;
my ( @lines, @questions, $current_question );

sub prompt { 
    my ( $prompt ) = @_;
    print $prompt, ' ';
    STDOUT->flush;
    my $val = <>;
    return $val;
}

QUESTION:
while ( <DATA> ) { 
    if ( my ( $ans ) = m/^=(\w+)/ ) {
        INPUT: { 
            say @lines;
            last unless defined( my $answer = prompt( 'Your answer:' ));
            say '';
             my ( $response ) = $answer =~ /([a-z])\s*$/;
            if ( not $response ) { 
                $answer =~ s/\s*$//; #/
                say "Invalid response. '$answer' is not an answer!\n"; 
                redo INPUT;
            }
            if ( $response eq $ans ) { 
                say 'You are right!';
            }
            elsif ( my $ansln = $current_question->{$response} ) { 
                if ( $response eq 'q' ) { 
                    say 'Quitting...';
                    last QUESTION;
                }
                say <<"END_SAY";
You chose:\n$current_question->{$response}
The correct answer was:\n$current_question->{$ans}
END_SAY
            }
            else { 
                say "Invalid response. '$response' is not an answer!\n";
                redo INPUT;
            }
        };
        @lines = ();
        prompt( 'Press enter to continue.' );
        say '';
    }
    else { 
        if ( my ( $qn, $q ) = m/^\s*(\d+)\.\)\s+(.*\S)\s*$/ ) { 
            push @questions, $current_question = { question => $q };
        }
        else {
            my ( $l, $a ) = m/^\s+([a-z])/;
            $current_question->{$l} = ( m/(.*)/ )[0];
        }
        push @lines, $_;
    }
}

__DATA__
1.) Perl is
  a.) essential
  b.) fun
  c.) useful
=c
2.) This question is
 a.) Number two
 b.) A test to see how this format is parsed.
 c.) Unneeded
=b

Upvotes: 1

Related Questions