#!/usr/bin/perl -w #use strict; use CGI::Carp qw(fatalsToBrowser); # (c) NueDream Inc. 2000-2002 (www.nuedream.com) ############## GLOBAL CONSTANTS ############ my $file = "questions.db"; # This is the name of your questions file. my $quizname = "Тестирование знаний"; # This is what appears in the TITLE. my $spacer = '|'; # The delimeter used in the database. my $result1 = "Ваша оценка: неудовлетворительно." ; # Message Displayed when user gets below 50%. my $result2 = "Ваша оценка: удовлетворительно." ; # Message Displayed when user gets between 51%-80%. my $result3 = "Ваша оценка: хорошо."; # Message Displayed when user get above 80%. my $result4 = "Ваша оценка: отлично."; # Message Displayed when user get above 80%. my $cheater = "Cheating won't get you anywhere in life." ; # Message Displayed when user cheated. my $fontface = "verdana, tahoma, arial"; # Font Type. my $anticheat = 1; # Enables or disables the anti-cheating feature # (1-Enabled, 0-Disabled). ############## PROGRAM START ############ my @pairs = split( /&/, $ENV{'QUERY_STRING'} ); foreach my $pair (@pairs) { my ( $name, $value ) = split( /=/, $pair ); if ($value) { $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("c", hex($1))/eg; $value =~ s/\n/ /g; $value =~ s/\r//g; $value =~ s/\cM//g; } $GET{$name} = $value; } my $cookie = $ENV{'HTTP_COOKIE'}; my @cookies = $cookie ? split( /;/, $cookie ) : ""; my $content = $ENV{'QUERY_STRING'}; my ( $type, $question ) = split( /=/, $content ); $question = 1 unless $question; my $current = $question - 1; my $correct = 0; my $action = $GET{'action'}; unless ($action) { print < $quizname
Солнечная система
Солнечная система HEADER open( DATA, $file ) or dienice("Couldn't open $file :: $!\n"); #flock(DATA,0); # uncomment this line if using unix based server seek( DATA, 0, 0 ); my @data = ; close(DATA); # Calculating total number of questions. my $total = 0; foreach my $line (@data) { my ( $quiz, $num, $q, $ans, $a, $b, $c, $d, $e, $f, $reason ) = split( /\|/, $line ); if ( $quiz eq $type ) { $total++; } } $total++; # Printing Quiz results. if ( $question == $total ) { print "

Результат теста: "; foreach my $part (@cookies) { if ( $part =~ /$type/ ) { my ( $name, $value ) = split( /=/, $part ); my @answers = split( /-/, $value ); foreach my $a (@answers) { my ( $questionc, $answerc ) = split( /_/, $a ); foreach my $line (@data) { chomp($line); my ( $quiz, $num, $q, $ans, $a, $b, $c, $d, $e, $f, $reason ) = split( /\|/, $line ); ##################################################################### if ( $quiz eq $type && $questionc eq $num ) { if ( substr( $answerc, 0, 1 ) eq $ans ) { my $tempa = substr( $answerc, 0, 1 ); my $tempb = substr( $answerc, 1, 1 ); # print #"$questionc. $q
Ваш ответ: $tempa. Правильно!
    $reason
"; $correct++; } else { my $tempa = substr( $answerc, 0, 1 ); my $tempb = substr( $answerc, 1, 1 ); # print #"$questionc. $q
Ваш ответ: $tempa. Неправильно!
Правильный ответ: $tempb.
    $reason
"; } } } } } } # print ""; # print "
"; my $percent = $current ? ( $correct / $current ) * 100 : 0; # printf( "$correct / $current = %4.1f", # $percent, "%

" ); # print "%

"; printf( "%4.1f\%", $percent ); print "


"; print "

"; if ( ( $correct / $total ) <= 0.5 ) { print "$result1"; } elsif ( ( $correct / $total ) <= 0.75 ) { print "$result2"; } elsif ( ( $correct / $total ) <= 0.99 ) { print "$result3"; } elsif ( ( $correct / $total ) <= 1.0 ) { print "$result4"; } else { print "$cheater"; } print "

"; } else { foreach my $line (@data) { chomp($line); my ( $quiz, $num, $q, $ans, $a, $b, $c, $d, $e, $f, $reason ) = split( /\|/, $line ); if ( $quiz eq $type && $question eq $num ) { print "
\n"; print "
$q
"; if ( $a ne "" ) { print "1. $a
\n"; } if ( $b ne "" ) { print "2. $b
\n"; } if ( $c ne "" ) { print "3. $c
\n"; } if ( $d ne "" ) { print "4. $d
\n"; } if ( $e ne "" ) { print "5. $e
\n"; } if ( $f ne "" ) { print "6. $f
\n"; } print "
\n"; print "
\n"; print "\n
\n"; } } } print <

 

TAILER } elsif ( $GET{'action'} eq "check" ) { my $content = $ENV{'QUERY_STRING'}; my ( $temp, $temp2, $temp3 ) = split( /&/, $content ); my $answer; ( $question, $answer ) = split( /=/, $temp ); my ( $type, $question ) = split( /=/, $temp2 ); my ( $temp4, $act ) = split( /=/, $temp3 ); my $start = $question + 1; my $url = "quiz.cgi?$type=$start"; my $tempv = ""; my @cookies = split( /;/, $ENV{'HTTP_COOKIE'} ); foreach my $crum (@cookies) { my ( $name, $value ) = split( /=/, $crum ); if ( $name =~ /$type/ ) { $tempv = $value; last; } } open( DATA, $file ) or dienice("Couldn't open $file :: $!\n"); flock( DATA, 0 ); # uncomment this line if using unix based server seek( DATA, 0, 0 ); my @data = ; close(DATA); foreach my $line (@data) { chomp($line); my ( $quiz, $num, $q, $ans, $a, $b, $c, $d, $e, $f, $reason ) = split( /\|/, $line ); if ( $quiz eq $type && $question eq $num ) { if ( $tempv ne "" ) { if ( $tempv =~ /$question/ ) { if ( $anticheat == 1 ) { print "Content-type: text/html; charset=utf-8\n\n"; print "

$cheater

If you did not try to cheat, try again. This time do not double click the next button.
Click once and wait until the next question is fully displayed before clicking again.
"; } else { print "Location: $url\n\n"; } } else { my $tempcookie = "$tempv" . "-" . $question . "_" . $answer . $ans; print "Set-cookie: $type=$tempcookie\n"; print "Location: $url\n\n"; } } else { my $tempcookie = $question . "_" . $answer . $ans; print "Set-cookie: $type=$tempcookie\n"; print "Location: $url\n\n"; } } } } ############# DYING SUBROUTINE ############ sub dienice { my ($msg) = @_; print("

FATAL ERROR


\n"); print($msg); exit; }