gruntmaster-problem
lib/Gruntmaster/Data.pm
Makefile.PL
+make_test_db.sh
MANIFEST
README
+testdata.sql
+t/00-compile.t
t/Gruntmaster-Data.t
t/tools.t
t/perlcritic.t
SQL::Abstract 0/,
},
BUILD_REQUIRES => {
- qw/DBD::SQLite 0
- SQL::Translator 0/,
+ qw/Test::Deep 0/,
},
META_MERGE => {
dynamic_config => 0,
sub query {
my ($stat, @extra) = @_;
- $db->query($statements{$stat} // $stat, @extra)
+ $db->query($statements{$stat}, @extra)
}
my (%name_cache, %name_cache_time);
sub problem_entry {
my ($id, $contest) = @_;
- $contest &&= contest_entry ($contest);
+ $contest = contest_entry ($contest) if $contest;
my $ret = add_names query(problem_entry_sth => $id)->hash;
my $limits = query(limits_sth => $id)->hashes;
$ret->{limits} = $limits if @$limits;
sub job_entry {
my ($id) = @_;
my $ret = add_names query(job_entry_sth => $id)->hash;
- $ret->{results} &&= decode_json $ret->{results};
+ $ret->{results} = decode_json $ret->{results} if $ret->{results};
$ret
}
sub calc_score {
my ($mxscore, $time, $tries, $totaltime) = @_;
my $score = $mxscore;
- $time = 0 if $time < 0;
- $time = 300 if $time > $totaltime;
+ $time = 300 if $time > $totaltime; # uncoverable branch true does not happen anymore (only possible if opens are broken)
$score = ($totaltime - $time) / $totaltime * $score;
$score -= $tries / 10 * $mxscore;
$score = $mxscore * 3 / 10 if $score < $mxscore * 3 / 10;
while (my $job = $jobs->hash) {
my $open = $opens{$job->{problem}, $job->{owner}} // $ct->{start};
my $time = $job->{date} - $open;
- next if $time < 0;
+ next if $time < 0; # uncoverable branch true job sent before contest is deprecated
my $value = $values{$job->{problem}};
my $factor = $job->{result} ? 0 : 1;
$factor = $1 / 100 if $job->{result_text} =~ /^(\d+ )/s;
--- /dev/null
+#!/bin/sh
+dropdb gmtest
+createdb gmtest
+psql gmtest -f db.sql
+psql gmtest -f testdata.sql
--- /dev/null
+#!/usr/bin/perl
+use v5.14;
+use warnings;
+
+use Test::More tests => 1;
+
+BEGIN { use_ok('Gruntmaster::Data') };
-#!/usr/bin/perl -w
+#!/usr/bin/perl
use v5.14;
+use warnings;
-use Test::More tests => 1;
+use Gruntmaster::Data;
+use Test::Deep;
+use Test::More;
-BEGIN { use_ok('Gruntmaster::Data') };
+BEGIN {
+ eval {
+ Gruntmaster::Data::init 'dbi:Pg:dbname=gmtest'; 1;
+ } or plan skip_all => 'Cannot connect to test database. Create it by running make_test_db.sh before running this test. '. "Error: $@";
+ plan tests => 37;
+}
+
+note 'Running update_status';
+update_status;
+
+my $x = user_list->{us};
+is @$x, 2, 'user_list has two elements';
+is_deeply $x->[0], {id => 'nobody', admin => 0, name => undef, town => undef, university => undef, country => undef, level => undef, lastjob => undef, contests => 1, solved => 2, attempted => 0}, 'user_list first element is correct';
+is $x->[1]{admin}, 1, 'user_list second user is admin';
+
+$x = user_entry 'nobody';
+cmp_bag $x->{problems}, [
+ {problem => 'arc', problem_name => 'Problem in archive', solved => bool 1},
+ {problem => 'fca', problem_name => 'FC problem A', solved => bool 1},
+], 'user_entry problems';
+
+is_deeply $x->{contests}, [
+ {contest => 'fc', contest_name => 'Finished contest', rank => 2, score => 40},
+], 'user_entry contests';
+
+sub pbids { [map { $_->{id} } @{$x->{beginner}}] }
+
+$x = problem_list;
+cmp_bag pbids, [qw/arc fca/], 'problem_list';
+
+$x = problem_list private => 1;
+cmp_bag pbids, [qw/arc fca rca pca prv/], 'problem_list private => 1';
+
+$x = problem_list contest => 'rc';
+cmp_bag pbids, [qw/rca/], q/problem_list contest => 'rc'/;
+
+$x = problem_list contest => 'rc', solution => 1;
+ok exists $x->{beginner}[0]{solution}, q/problem_list contest => 'rc', solution => 1 has solution/;
+
+$x = problem_list owner => 'nobody';
+cmp_bag pbids, [], q/problem_list owner => 'nobody'/;
+
+$x = problem_entry 'arc';
+cmp_bag $x->{limits}, [{format => 'C', timeout => 0.1}, {format => 'CPP', timeout => 0.1}], 'problem_entry limits';
+is $x->{solution}, 'Sample Text', 'problem_entry has solution';
+
+$x = problem_entry 'rca', 'rc';
+ok !exists $x->{solution}, 'problem_entry during contest does not have solution';
+ok exists $x->{contest_start}, 'problem_entry during contest has contest_start ';
+
+$x = contest_list;
+is $x->{finished}[0]{id}, 'fc', 'contest_list fc is finished';
+is $x->{running}[0]{id}, 'rc', 'contest_list rc is running';
+is $x->{pending}[0]{id}, 'pc', 'contest_list pc is pending';
+
+$x = contest_entry 'fc';
+cmp_deeply $x, {id => 'fc', name => 'Finished contest', start => ignore, stop => ignore, owner => 'MGV', owner_name => undef, finished => bool (1), started => bool (1), description => undef}, 'contest_entry fc';
+
+$x = contest_full 'fc';
+ok exists $x->{editorial}, 'contest_full fc has editorial';
+
+ok contest_has_problem('rc', 'rca'), 'contest rc has problem rca';
+ok contest_has_problem('rc', 'arc'), 'contest rc does not have problem arc';
+
+sub jobids { [ map { $_->{id} } @{$x->{log}} ] }
+
+$x = job_list;
+cmp_bag jobids, [1..5], 'job_list';
+is $x->{current_page}, 1, 'current page is 1';
+is $x->{last_page}, 1, 'last page is 1';
+ok !exists $x->{previous_page}, 'there is no previous page';
+ok !exists $x->{next_page}, 'there is no next page';
+
+$x = job_list private => 1;
+cmp_bag jobids, [1..7], 'job_list private => 1';
+
+$x = job_list contest => 'fc';
+cmp_bag jobids, [1..3], 'job_list contest => fc';
+
+$x = job_list owner => 'MGV';
+cmp_bag jobids, [1], 'job_ids owner => MGV';
+
+$x = job_list problem => 'fca';
+cmp_bag jobids, [1..4], 'job_ids problem => fca';
+
+$x = job_list problem => 'fca', result => 1;
+cmp_bag jobids, [2], 'job_ids problem => fca, result => 1';
+
+$x = job_entry 1;
+is $x->{size}, 21, 'job_entry size';
+ok !exists $x->{source}, 'job_entry does not have source';
+is_deeply $x->{results}, [], 'job_entry results';
+
+$x = job_entry 7;
+ok !defined $x->{result}, 'job_entry 7 has NULL result';
+
+$x = job_full 1;
+ok exists $x->{source}, 'job_full has source';
+
+$x = standings 'fc';
+is_deeply $x, {
+ problems => [[fca => 'FC problem A']],
+ st => [
+ {rank => 1, user => 'MGV', user_name => undef, score => 50, scores => [50]},
+ {rank => 2, user => 'nobody', user_name => undef, score => 40, scores => [40]},
+ ]
+}, 'standings fc';
#!/usr/bin/perl -w
use v5.14;
+use Test::More skip_all => 'These tests are badly outdated and broken';
+
use Test::More tests => 13;
use File::Temp qw/tempdir/;
use Config;
--- /dev/null
+CREATE FUNCTION tm() RETURNS BIGINT IMMUTABLE LANGUAGE SQL AS $$
+ SELECT EXTRACT(epoch FROM NOW())::bigint
+$$;
+
+-- USERS
+
+INSERT INTO users (id, admin) VALUES ('MGV', TRUE);
+INSERT INTO users (id, admin) VALUES ('nobody', FALSE);
+
+-- CONTESTS
+
+ALTER TABLE contests ALTER owner SET DEFAULT 'MGV';
+
+INSERT INTO contests (id, start, stop, name) VALUES ('fc', tm() - 2000, tm() - 1000, 'Finished contest');
+INSERT INTO contests (id, start, stop, name) VALUES ('rc', tm() - 1000, tm() + 1000, 'Running contest');
+INSERT INTO contests (id, start, stop, name) VALUES ('pc', tm() + 1000, tm() + 2000, 'Pending contest');
+
+-- PROBLEMS
+
+ALTER TABLE problems ALTER generator SET DEFAULT 'Undef',
+ ALTER runner SET DEFAULT 'File',
+ ALTER judge SET DEFAULT 'Absolute',
+ ALTER level SET DEFAULT 'beginner',
+ ALTER value SET DEFAULT 100,
+ ALTER owner SET DEFAULT 'MGV',
+ ALTER statement SET DEFAULT 'Sample Text',
+ ALTER solution SET DEFAULT 'Sample Text',
+ ALTER testcnt SET DEFAULT 1,
+ ALTER timeout SET DEFAULT 1;
+
+INSERT INTO problems (id, name, private) VALUES ('fca', 'FC problem A', FALSE);
+INSERT INTO problems (id, name, private) VALUES ('rca', 'RC problem A', TRUE);
+INSERT INTO problems (id, name, private) VALUES ('pca', 'PC problem A', TRUE);
+INSERT INTO problems (id, name, private) VALUES ('arc', 'Problem in archive', FALSE);
+INSERT INTO problems (id, name, private) VALUES ('prv', 'Private problem', TRUE);
+
+INSERT INTO contest_problems (contest, problem) VALUES ('fc', 'fca');
+INSERT INTO contest_problems (contest, problem) VALUES ('rc', 'rca');
+INSERT INTO contest_problems (contest, problem) VALUES ('pc', 'pca');
+
+INSERT INTO limits (problem, format, timeout) VALUES ('arc', 'C', 0.1);
+INSERT INTO limits (problem, format, timeout) VALUES ('arc', 'CPP', 0.1);
+
+-- JOBS
+
+ALTER TABLE jobs ALTER date SET DEFAULT tm() - 1500,
+ ALTER errors SET DEFAULT 'Errors here',
+ ALTER extension SET DEFAULT 'pl',
+ ALTER format SET DEFAULT 'PERL',
+ ALTER result SET DEFAULT 0,
+ ALTER result_text SET DEFAULT 'Accepted',
+ ALTER results SET DEFAULT '[]',
+ ALTER source SET DEFAULT 'print "Hello, world!"',
+ ALTER owner SET DEFAULT 'nobody';
+
+INSERT INTO jobs (contest, problem, owner) VALUES ('fc', 'fca', 'MGV');
+INSERT INTO jobs (contest, problem, result, result_text, date) VALUES ('fc', 'fca', 1, 'Wrong Answer', tm() - 1600);
+INSERT INTO jobs (contest, problem) VALUES ('fc', 'fca');
+INSERT INTO jobs (problem, date) VALUES ('fca', tm() - 500);
+INSERT INTO jobs (problem, date) VALUES ('arc', tm() - 100);
+INSERT INTO jobs (problem, private, owner) VALUES ('pca', TRUE, 'MGV');
+INSERT INTO jobs (problem, private, owner, result, result_text, results) VALUES ('prv', TRUE, 'MGV', NULL, NULL, NULL);