perl cgi script for amino acids.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 

191 lines
5.9 KiB

#!/usr/bin/env perl
use strict;
use warnings;
use Data::Dumper;
# utility functions
sub urldecode {
my ($a) = @_;
$a =~ s/\+/ /g;
$a =~ s/%([A-Fa-f\d]{2})/chr hex $1/eg;
return $a;
}
sub urlencode {
my ($a) = @_;
$a =~ s/([^A-Za-z0-9])/sprintf("%%%02X", ord($1))/seg;
return $a;
}
sub parse_post() {
my $POST_STRING = <>;
my @POST = split(/[&=]/, $POST_STRING);
my %POST_PARAMETERS = ();
for (my $i = 0; $i < $#POST; $i += 2) {
if (!defined $POST_PARAMETERS{$POST[$i]}) {
$POST_PARAMETERS{$POST[$i]} = $POST[$i+1];
} else {
$POST_PARAMETERS{$POST[$i]} = $POST_PARAMETERS{$POST[$i]} . "," . urldecode ($POST[$i+1]);
}
}
return \%POST_PARAMETERS;
}
sub check_equivalence {
my ($string1,$string2) = @_;
$string1 = (urldecode $string1) =~ s/^\s+|\s+$//rg;
$string2 = (urldecode $string2) =~ s/^\s+|\s+$//rg;
return $string1 =~ /^\s*$string2\s*$/i
}
print "Content-Type: text/html\n\n";
print "<!DOCTYPE html>";
print "<html>";
print <<EOF;
<head>
<title>Amino Acid Practice</title>
<meta name="viewport" content="width=device-width, initial-scale=1.0">
<link rel="stylesheet" href="https://cdn.simplecss.org/simple.min.css">
<style>
.green {
color: green;
}
.red {
color: red;
}
</style>
</head>
<body>
EOF
print "<h1> Amino Acids </h1>";
print "<article>";
our @amino = (
["Phenylalanine", "Phe", "F", "F.png", "Nonpolar" ],
["Leucine", "Leu", "L", "L.png", "Nonpolar" ],
["Isoleucine", "Ile", "I", "I.png", "Nonpolar" ],
["Methionine", "Met", "M", "M.png", "Nonpolar" ],
["Valine", "Val", "V", "V.png", "Nonpolar" ],
["Proline", "Pro", "P", "P.png", "Nonpolar" ],
["Alanine", "Ala", "A", "A.png", "Nonpolar" ],
["Tryptophan", "Trp", "W", "W.png", "Nonpolar" ],
["Glycine", "Gly", "G", "G.png", "Nonpolar" ],
["Serine", "Ser", "S", "S.png", "Polar" ],
["Threonine", "Thr", "T", "T.png", "Polar" ],
["Tyrosine", "Tyr", "Y", "Y.png", "Polar" ],
["Glutamine", "Gln", "Q", "Q.png", "Polar" ],
["Asparagine", "Asn", "N", "N.png", "Polar" ],
["Cysteine", "Cys", "C", "C.png", "Polar" ],
["Aspartate", "Asp", "D", "D.png", "Acidic" ],
["Glutamate", "Glu", "E", "E.png", "Acidic" ],
["Histidine", "His", "H", "H.png", "Basic" ],
["Lysine", "Lys", "K", "K.png", "Basic" ],
["Arginine", "Arg", "R", "R.png", "Basic" ]
);
our @abbreviations = ("full name", "3-letter abbreviation", "1-letter abbreviation", "image");
our @properties = ("Polar", "Nonpolar", "Acidic", "Basic");
sub answer_choices {
my %found = (); for(0..($#amino-1)) {$found{$_} = 1;};
my @res;
for((1..5)) {
my $choice;
do {
$choice = int(rand $#amino);
} while ($found{$choice} == 0);
$found{$choice} = 0;
push @res, $choice;
}
my $correct = $res[int(rand $#res)];
return \@res, $correct;
}
sub to_image {
my ($query) = @_;
return $query =~ s/([^\s]*?).png/<img src='.\/images\/$1.png'>/r;
}
sub decode_question {
my ($choices_idx, $correct_idx) = answer_choices();
# generate a question type
my %type_hash = (0 => 1, 1 => 1, 2 => 1, 3 => 1);
my @types = ();
for (1..2) {my $cur; do {$cur = int(rand 4);} while($type_hash{$cur} == 0); push @types, $cur; $type_hash{$cur} = 0;};
my $question = "What is the " . $abbreviations[$types[1]] . " for " . $amino[$correct_idx]->[$types[0]] . "?";
my $answer = $amino[$correct_idx]->[$types[1]];
my @options = (); for(@$choices_idx) { push @options, $amino[$_]->[$types[1]] }
if (rand() < 0.3 && $types[1] != 3) {
return $question, $answer, [];
}
return $question, $answer, \@options;
}
sub properties_question {
my ($choices_idx, $correct_idx) = answer_choices();
my $question = "Property of the amino acid " . $amino[$correct_idx]->[int(rand 4)];
return $question, $amino[$correct_idx]->[4], \@properties;
}
sub construct_form {
my ($question, $answer, $options) = @_;
$answer = $answer;
$question = urldecode $question;
my $question_label = to_image $question;
print "<form action='' method='POST'>";
print "<label for='response'>" . $question_label . "</label><br>";
print "<input type='hidden' name='question' value='$question'>";
if (scalar @$options) {
print "<div>";
for (my $i = 0; $i < scalar @$options; $i++) {
my $opt = $options->[$i];
my $lbl = to_image($options->[$i]);
print "<input type='radio' name='response' value='$opt' id='$i'>";
print "<label for='$i'>$lbl</label>";
print "<input type='hidden' name='options' value=\"$opt\">";
print "<br>";
}
print "</div>";
} else {
print "<input name='response' type='text'>";
}
print "<input type='hidden' name='answer' value='$answer'>";
print "<br><input type='submit'/>";
print "</form>";
}
if ($ENV{'REQUEST_METHOD'} =~ /POST/i) {
my $parameters = parse_post();
our $response = ($parameters->{'response'} // '');
our $answer = ($parameters->{'answer'} // 'wrong');
our $question = ($parameters->{'question'} // '');
our @options = split(',', $parameters->{'options'} // '');
# answer and response should have the same elements.
our $correct = check_equivalence $answer, $response;
construct_form($question, $answer, \@options);
if ($correct) {
print "<p class='green'>Correct!</p>";
} else {
print "<p class='red'> Incorrect! </p>";
}
} else {
if (int(rand(2)) == 0) {
construct_form(properties_question());
} else {
construct_form(decode_question());
}
}
print "<hr>";
print "<button onclick='window.location.href = window.location.href'>Next</button>";
print "</article>";
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
$year += 1900;
print "<p>&copy; Juni Kim 2022-$year</p>";
print"</body></html>";