server/check.pl

127 lines
2.6 KiB
Perl
Raw Normal View History

2013-12-11 17:10:39 +00:00
#!/usr/bin/env perl
use v5.10.1;
use strict;
use warnings;
use DBI;
2013-12-13 17:45:25 +00:00
use File::Basename;
2013-12-11 17:10:39 +00:00
2013-12-13 17:45:25 +00:00
#Return number of good solutions
my $exit = 0;
my $root = dirname(__FILE__);
chdir($root);
2013-12-11 17:10:39 +00:00
# First, read PHP configuration to extract some settings
my $profile;
my $submission_dir;
2013-12-13 17:45:25 +00:00
open my $conf, "<", "$root/onyx/config/root.xml";
2013-12-11 17:10:39 +00:00
for my $p (<$conf>)
{
if ($p =~ /<(?:option|var) name="(.*)">(.*)<\/(?:option|var)>/)
{
$profile = $2 if ($1 eq "profile");
$submission_dir = $2 if ($1 eq "submission_dir");
}
}
close $conf;
die("No DB profile found") if ! $profile;
die("submission_dir is not a directory") if ! $submission_dir || ! -d $submission_dir;
# Read db settings
my %db_settings;
2013-12-13 17:45:25 +00:00
open my $dbprof, "<", "$root/onyx/db/$profile.profile.php";
2013-12-11 17:10:39 +00:00
while (<$dbprof>)
{
if (/\$___profile\[['"](.+)['"]\] = ['"](.+)['"]/)
{
$db_settings{$1} = $2;
}
}
close $dbprof;
my $dbh;
# List all files to treat
opendir(my $dh, $submission_dir) || die "Can't opendir submission_dir: $!";
for my $f (readdir $dh)
{
2013-12-13 17:45:25 +00:00
if ($f =~ /^([0-9]+)-([0-9]+)-([a-zA-Z0-9_]+)$/)
2013-12-11 17:10:39 +00:00
{
2013-12-13 17:45:25 +00:00
my $good = -1;
2013-12-11 17:10:39 +00:00
my $team = $1;
my $theme = $2;
my $exercice = $3;
open my $fh, "<", "$submission_dir/$f";
my $solution = <$fh>;
close $fh;
$dbh = DBI->connect("DBI:mysql:database=$db_settings{db};host=$db_settings{host};port=3306",
$db_settings{user}, $db_settings{pass},
{'RaiseError' => 1, 'PrintError' => 1})
or die $DBI::errstr if !$dbh;
2013-12-13 17:45:25 +00:00
my $sth = query($dbh, "SELECT format, value FROM exercice_keys WHERE id_exercice = '$exercice';");
2013-12-11 17:10:39 +00:00
2013-12-13 17:45:25 +00:00
# Check solutions
2013-12-11 17:10:39 +00:00
while (my $row = get_row($sth))
{
2013-12-13 17:45:25 +00:00
$good = 1 if ($good == -1);
my $type = @$row[0];
my $sol = @$row[1];
if ($type eq "raw" && $sol ne $solution) {
$good = 0;
last;
}
elsif ($type ne "raw") {
$good = 0;
warn "$type not implemented";
last;
}
}
# Register solve
if ($good == -1) {
say "Exercice $exercice doesn't exist ; given by team $team in theme $theme.";
2013-12-11 17:10:39 +00:00
}
2013-12-13 17:45:25 +00:00
elsif ($good == 1)
{
say "Team $team solve exercice $exercice in $theme at ".localtime();
query($dbh, "INSERT INTO solved (id_team, id_exercice, time) VALUES ($team, '$exercice', CURRENT_TIMESTAMP);");
$exit++;
}
else {
say "Team $team didn't give the correct answer for exercice $exercice.";
}
# Remove the file
unlink("$submission_dir/$f");
2013-12-11 17:10:39 +00:00
}
}
closedir $dh;
$dbh->disconnect() if $dbh;
2013-12-13 17:45:25 +00:00
exit( $exit > 126 ? 126 : $exit );
2013-12-11 17:10:39 +00:00
sub query
{
my $sth = $_[0]->prepare($_[1]);
$sth->execute();
die($_[0]->errstr) if (!$sth);
return $sth;
}
2013-12-13 17:45:25 +00:00
sub get_row
{
return $_[0]->fetchrow_arrayref();
}