chriso has asked for the wisdom of the Perl Monks concerning the following question:

I have come to seek wisdom from those who know. Where others have failed, I hope you can provide (a solution of course). Below is a quiz script to produce questions and answer boxes. Following that script is a script I've created which will eventually grade the quizes. This is the script where the problems lie. I'm having two problems.
One is with the match operator not providing a proper match in the 'if' statement. If I set up the if statement to match more than one character (ie. =~ /ad/i), it doesn't work. If I match only one character, it works fine (ie. =~ /d/i).
To see what the problem is, I then print out s1-s4 to make sure the characters I am trying to match are really there. I also decided to print out the key/value pairs in three different ways, each separated by the horizontal rule. Herein lies the second problem.
Note that the first two ways print out the key and values correctly. However, the third method prints the key correctly, but only prints out the first character of the value. Strange. I have tried the script using perl 5.6 for NetWare, and also ActiveState perl 5.6 and get the same results. Can anyone help me???? I've also included the text file being used to input the various data. Many thanks.

******** CODE TO PRINT QUIZ 

use CGI qw(:standard);
print header;

local $/ = "~\n";   
$infile = param('file'); 

print start_html (
    -title=>'quiz',
    -BGCOLOR=>'beige'
    );

print start_form (
    -method=>'POST',
    -action=>"http://netlab/perl/obenberger/gradequiz.cgi"
    );

open (FILE, $infile) || die "Cannot open $infile: $!";

while (<FILE>) {  
chomp;    
($type, $value) = split (/:/, $_); 

if ($type =~ m/q/i) {    # ******* CHECKS FOR QUESTION LINE
   print "<B>$value</B><BR>";
}

if ($type =~ m/a/i) {    # ********* CHECKS FOR ANSWER LINE
    @answers = split (/,/, $value);  
    $anslength = @answers; 
}

if ($type =~ m/^s/) {    # *** DETERMINES TYPE OF ANSWER BOX
    %selections = split (/,/, $value);
    @options = keys (%selections);
    if ($anslength > 1) {    
    print checkbox_group(-name=>$type, -values=>\@options, -linebreak=
+>'true', -labels=>\%selections);
    }else {
    print "<BR>";
    print radio_group(-name=>$type, -values=>\@options, -linebreak=>'t
+rue', -labels=>\%selections, -default=>'-');
    }
    print "<BR><HR><BR>";
}

}   # ********** END WHILE STATEMENT
close (FILE);

print "<CENTER>";
print submit (-value=>'Grade') . "&nbsp; &nbsp;";
print reset (-value=>'Reset answers');
print "</CENTER>";

print end_form;
print end_html;

[download]
*** CODE TO GRADE QUIZ - THIS IS WHERE THE PROBLE IS. 
use CGI qw(:standard);
print header;
print start_html (-title=>'graded quiz', -BGCOLOR=>'beige');

# The match doesn't work if more than one character is matched
if(param('s1') =~ m/ad/i) {
print "<B><BR>Correct! Congradulations! Your answer was a</B><P>";
}else{
print "<B><BR>Incorrect! You did not mark the correct answer!</B><P>";
   }
print "<BR>The value for s1 is: <B>";
print param('s1');
print "</B><P>";
print "The value for s2 is: <B>";
print param('s2');
print "</B><P>";
print "The value for s3 is: <B>";
print param('s3');
print "</B><P>";
print "The value for s4 is: <B>";
print param('s4');
print "</B><P>";

print "<HR>";

foreach $key (param()) {
print "NAME = ";
print $key;
print " and VALUE = ";
print param($key);
print "<P>";
}
print "<HR>";

# Only the first character of the value is printed. Why?
foreach $key (param()) {
print "NAME = " . $key . "and VALUE = " . param($key)  . "<P>";
}
print end_html;

[download]
********* DATA
q1:Which are two items found in the kitchen?~
a1:a,d~
s1:a,pot,b,wrench,c,screw driver,d,fork~
q2:How much is 2 + 2?~
a2:b~
s2:a,2,b,4,c,5,d,3,e,1~
q3:Which of the following are modes of transportation?~
a3:a,c~
s3:a,car,b,fence,c,plane,d,pants~
q4:The part of the body that contains the brain is the ______~
a4:c~
s4:a,arm,b,stomach,c,head,d,leg,e,foot

Replies are listed 'Best First'.
Re: Match function not providing results
by Corion (Patriarch) on Dec 14, 2001 at 19:23 UTC

    The reason your regular expressions don't work is that you are using them wrong.

    The perlre manpage (use perldoc perlre to view it) gives a short introduction to regular expressions and how to construct them.

    Here's a short attempt at a hands-on introduction geared towards your problem :

    A regular expression that matches a single character is /f/. This one would match barfoo.

    A regular expression that matches a sequence of characters is, for example, /foo/, which would match barfoobaz, but which would not match barfobaz, because the second o is missing.

    To now construct a regular expression that matches one character out of a set of characters, we neet to look at the set constructors for regular expressions, [ and ]. The characters between [] in a regular expression will match any of the characters in a string. So our above examples could be rewritten to /[f]/, which would still only match the letter f, and /[f][o][o]/, which will first try to match the set containing only a f, and after that an o and after that another o. But that is not what you want. You want to match (for example), the string ab. To that, we extend the set from containing one character to two characters : /[ab]/ will match (for example) afoo and bar and zob.

    So you will want to construct from the answer data a regular expression and collect all correct answers in a []-set, and match the string against that RE.

    perl -MHTTP::Daemon -MHTTP::Response -MLWP::Simple -e ' ;    # The  
$d = new HTTP::Daemon and fork and getprint $d->url and exit;#spider
($c = $d->accept())->get_request(); $c->send_response( new   #in the
HTTP::Response(200,$_,$_,qq(Just another Perl hacker\n))); ' #  web

    [download]
[reply]
[d/l]
[select]
      I think I'm catching on. I tried the expression =~ /ad/ with better results. However, I now get a correct answer if I check a or ab or ac. I also get incorrect answers if I check bd or cd. What I'm ultimately going to do is have a variable which will contain the answer. For example, $answer might contain a,d (as seen in the text file). I was hoping to be able to compare param('sX') with $answer to make sure the person selected the correct answers. Therefore, I want to make sure I get a true response only if param('sX') contains all the characters in $answer, not just one. Is there a better way of accomplishing this without having to use m//? I tried using if(param('s1') eq "ad" but that didn't work either as I suspect I'm not understanding how param() returns the value. Thanks
[reply]

        I guess you mean /[ad]/. If we look at what I wrote above, /[ad]/ will match any string that contains either an a or a d, which is not yet exactly what you want.

        My advice is that you don't need regular expressions at all, since the set of correct answers can be constructed as a string, for example ad, and the set of given answers can be concatenated to a string as well. Checking whether an answer is correct in total is then just a matter of comparing two strings for equality. But first, we need to take a look at the CGI documentation for checkboxes. The example there tells us how to get the checked boxes, so now all we got to do is to concatenate these into one string and compare them against the correct answer : 

        my @selected_answers = param('s1');
my $correct_answer = join( "", @selected_answers );

if ($given_answer ne $correct_answer) {
  print "Bleh ! You lose !"
} else {
  print "Yay ! Correct !"
}

        [download]

        A small side note - you are not using the strict module. This is very bad and will hide many programming errors from your eyes. So please use strict; !

        perl -MHTTP::Daemon -MHTTP::Response -MLWP::Simple -e ' ;    # The  
$d = new HTTP::Daemon and fork and getprint $d->url and exit;#spider
($c = $d->accept())->get_request(); $c->send_response( new   #in the
HTTP::Response(200,$_,$_,qq(Just another Perl hacker\n))); ' #  web

        [download]
[reply]
[d/l]
[select]
Re: Match function not providing results
by andye (Curate) on Dec 14, 2001 at 19:27 UTC
    chriso,

    I must admit that I haven't read your code fully, but I'm not sure your regexp is correct. This:

    param('s1') =~ m/ad/i

    [download]
    will match any string which contains an 'a' and a 'd' right next to each other, e.g. 'add', 'dad', etc. I'm not sure if that's what you want to do...

    If you want to match a string which contains an 'a' and a 'd' anywhere in the string, e.g. 'and' or 'drag', then here's an easy way: 

    param('s1') =~ /a/i and param('s1') =~ /d/i

    [download]
    Hope that helps,
    andy.

    Update: if you want one or the other, then you could do 

    param('s1') =~ /a/i or param('s1') =~ /d/i

    [download]
    or, as Corion suggests, you could use a character class.

    If you have a list of characters that you want to match any of, then you could do it like this: 

    my @list = qw(a b c);
if (param('s1) =~ /[@list]/xi) {
    print "one of the characters matched"
}

    [download]
    where the /x at the end of the regexp makes it ignore white space (because @list will expand like this: 'a b c').

    andy.

[reply]
[d/l]
[select]
Re: Match function not providing results
by Steve_p (Priest) on Dec 14, 2001 at 19:49 UTC
    I'm looking at the expected answers and I'm not sure that your regular expression is correct. By looking for /ad/i, you are looking for a and d right next to each other. If the parameter you are sending is "a,d", then you will not get a match. If they are only coming in that order, then you could change your regular expression to /a,d/. If not then 
    if(param('s1') =~ /a/ && param('s1') =~ /d/)
    should work.
[reply]

Back to Seekers of Perl Wisdom