#!/usr/bin/perl
if ($ENV{'REQUEST_METHOD'} eq 'GET') {
@pairs = split(/&/, $ENV{'QUERY_STRING'});
} elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
read (STDIN, $in, $ENV{'CONTENT_LENGTH'});
@pairs = split(/&/, $in);
} else {
print "Content-type: text/html\n\n";
print "Use Post or Get";
}
foreach $pair (@pairs) {
($name, $value) = split (/=/, $pair);
$name =~ s/\+/ /g;
$name =~ s/%(..)/pack("C", hex($1))/ge;
$value =~ s/\+/ /g;
$value =~ s/%(..)/pack("C", hex($1))/ge;
$value =~s///g;
if ($parseform{$name}) {
$parseform{$name} .= ", $value";
} else {
$parseform{$name} = $value;
}
}
print "Content-Type: text/html\n\n";
$about="
Programmed in PERL by Jose Carrasquel, AOL: josecarrasquel
";
$script=$ENV{'SCRIPT_NAME'};
if ($parseform{'action'} eq 'mono_complete'){&mono_complete;}
if ($parseform{'action'} eq 'mono_complete1'){&mono_complete1;}
if ($parseform{'action'} eq 'mono_compfinal'){&mono_compfinal;}
unless ($parseform{'action'}){&start;}
sub start {
print <<"EOF";
Genetic Problemms Solver
Solve Monhohybrid Crosses With Complete Dominance
$about
EOF
}
sub mono_complete {
print <<"EOF";
Solve Monohybrid Crosses with Complete Dominance!!!
$about
EOF
}
sub mono_complete1 {
my ($first) = ($parseform{'dominant'} =~ /([a-zA-Z])/);
$dominant=$first;
$recesive=$first;
$dominant=~ tr/a-z/A-Z/;
$recesive=~ tr/A-Z/a-z/;
print <<"EOF";
Solve Monohybrid Crosses with Complete Dominance!!!
$about
EOF
}
sub mono_compfinal {
($gene1_1,$gene1_2)=split (/,/,$parseform{'gamete1'},2);($gene2_1,$gene2_2)=split (/,/,$parseform{'gamete2'},2);
my ($first) = ($parseform{'dominant'} =~ /([a-zA-Z])/);
$dominant=$first;
$recesive=$first;
$dominant=~ tr/a-z/A-Z/;
$recesive=~ tr/A-Z/a-z/;
$patterna='[A-Z]+';
if ($gene2_1 =~ /[A-Z]/){$fetoa=($gene2_1.$gene1_1);}else{$fetoa=($gene1_1.$gene2_1);}
if ($gene2_1 =~ /[A-Z]/){$fetob=($gene2_1.$gene1_2);}else{$fetob=($gene1_2.$gene2_1);}
if ($gene2_2 =~ /[A-Z]/){$fetoc=($gene2_2.$gene1_1);}else{$fetoc=($gene1_1.$gene2_2);}
if ($gene2_2 =~ /[A-Z]/){$fetod=($gene2_2.$gene1_2);}else{$fetod=($gene1_2.$gene2_2);}
if ($fetoa =~ /$patterna/){$domicount++;}
if ($fetob =~ /$patterna/){$domicount++;}
if ($fetoc =~ /$patterna/){$domicount++;}
if ($fetod =~ /$patterna/){$domicount++;}
$domicount *=25;
$rececount=100-$domicount;
print <<"EOF";
Solve Monohybrid Crosses with Complete Dominance!!!
$gene1_1$gene1_2 x $gene2_1$gene2_2
"$dominant"=$parseform{'dominant'}
"$recesive"=$parseform{'recesive'}
F1
| | $gene1_1 | $gene1_2 |
| $gene2_1 | $fetoa | $fetob |
| $gene2_2 | $fetoc | $fetod |
Phenotype: $domicount\% $parseform{'dominant'} : $rececount\% $parseform{'recesive'}
$about
EOF
}