2 package Gruntmaster
::Data
;
4 # Created by DBIx::Class::Schema::Loader
5 # DO NOT MODIFY THE FIRST PART OF THIS FILE
10 use base
'DBIx::Class::Schema';
12 __PACKAGE__
->load_namespaces;
15 # Created by DBIx::Class::Schema::Loader v0.07039 @ 2014-03-05 13:11:39
16 # DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:dAEmtAexvUaNXLgYz2rNEg
18 our $VERSION = '5999.000_011';
20 use Lingua
::EN
::Inflect qw
/PL_N/;
21 use JSON
::MaybeXS qw
/decode_json/;
22 use List
::Util qw
/sum/;
23 use PerlX
::Maybe qw
/maybe/;
24 use Sub
::Name qw
/subname/;
26 use constant PROBLEM_PUBLIC_COLUMNS
=> [qw
/id author writer level name owner private statement timeout olimit value/];
27 use constant USER_PUBLIC_COLUMNS
=> [qw
/id admin name town university level/];
28 use constant JOBS_PER_PAGE
=> 10;
31 our ($name, $sub) = @_;
32 no strict
'refs'; ## no critic (Strict)
33 *$name = subname
$name => $sub
37 for my $rs (qw
/contest contest_problem job open problem user problem_status contest_status/) {
38 my $rsname = ucfirst $rs;
39 $rsname =~ s/_([a-z])/\u$1/gs;
40 dynsub PL_N
($rs) => sub { $_[0]->resultset($rsname) };
41 dynsub
$rs => sub { $_[0]->resultset($rsname)->find($_[1]) };
46 my ($mxscore, $time, $tries, $totaltime) = @_;
48 $time = 0 if $time < 0;
49 $time = 300 if $time > $totaltime;
50 $score = ($totaltime - $time) / $totaltime * $score;
51 $score -= $tries / 10 * $mxscore;
52 $score = $mxscore * 3 / 10 if $score < $mxscore * 3 / 10;
58 $ct &&= $self->contest($ct);
60 my @problems = map { $_->rawproblem } $self->contest_problems->search({contest
=> $ct && $ct->id}, {qw
/join problem order_by problem.level/});
61 my (%scores, %tries, %opens);
62 $opens{$_->rawproblem, $_->rawowner} = $_ for $self->opens->search({contest
=> $ct && $ct->id});
63 for my $job ($self->jobs->search({contest
=> $ct && $ct->id}, {qw
/order_by me.id prefetch/ => [qw
/problem/]})) {
65 my $open = $opens{$job->rawproblem, $job->rawowner};
66 my $time = $job->date - ($open ?
$open->time : $ct->start);
68 my $value = $job->problem->value;
69 my $factor = $job->result ?
0 : 1;
70 $factor = $1 / 100 if $job->result_text =~ /^(\d
+ )/s
;
71 $scores{$job->rawowner}{$job->rawproblem} = int ($factor * calc_score
($value, $time, $tries{$job->rawowner}{$job->rawproblem}++, $ct->stop - $ct->start));
73 no warnings
'numeric'; ## no critic (ProhibitNoWarnings)
74 $scores{$job->rawowner}{$job->rawproblem} = 0 + $job->result_text || ($job->result ?
0 : 100)
78 my %user_to_name = map { $_ => $_->name } $self->users->all;
80 my @st = sort { $b->{score
} <=> $a->{score
} or $a->{user
} cmp $b->{user
} } map { ## no critic (ProhibitReverseSortBlock)
84 user_name
=> $user_to_name{$user},
85 score
=> sum
(values %{$scores{$user}}),
86 scores
=> [map { $scores{$user}{$_} // '-'} @problems],
92 $st[$_]->{rank
} = $st[$_ - 1]->{rank
} + ($st[$_]->{score
} < $st[$_ - 1]->{score
}) for 1 .. $#st;
97 my $rs = $_[0]->users->search(undef, {order_by
=> 'name', columns
=> USER_PUBLIC_COLUMNS
});
98 [ map { { $_->get_columns } } $rs->all ]
102 my ($self, $id) = @_;
103 my $user = $self->users->find($id, {columns
=> USER_PUBLIC_COLUMNS
, prefetch
=> [qw
/problem_statuses contest_statuses/]});
104 my @problems = map { {problem
=> $_->get_column('problem'), solved
=> $_->solved} } $user->problem_statuses;
105 my @contests = map { {contest
=> $_->contest->id, contest_name
=> $_->contest->name, rank
=> $_->rank, score
=> $_->score} } $user->contest_statuses->search(undef, {prefetch
=> 'contest'});
106 +{ $user->get_columns, problems
=> \
@problems, contests
=> \
@contests }
110 my ($self, %args) = @_;
111 my $rs = $self->problems->search(undef, {order_by
=> 'me.name', columns
=> PROBLEM_PUBLIC_COLUMNS
, prefetch
=> 'owner'});
112 $rs = $rs->search({-or => ['contest_problems.contest' => undef, 'contest.stop' => {'<=', time}], 'me.private' => 0}, {join => {'contest_problems' => 'contest'}, distinct
=> 1}) unless $args{contest
};
113 $rs = $rs->search({'contest_problems.contest' => $args{contest
}}, {join => 'contest_problems'}) if $args{contest
};
114 $rs = $rs->search({'me.owner' => $args{owner
}}) if $args{owner
};
116 $params{contest
} = $args{contest
} if $args{contest
};
118 $params{$_->level} //= [];
119 push @
{$params{$_->level}}, {$_->get_columns, owner_name
=> $_->owner->name} ;
125 my ($self, $id, $contest, $user) = @_;
126 my $running = $contest && $self->contest($contest)->is_running;
127 my $columns = PROBLEM_PUBLIC_COLUMNS
;
128 push @
$columns, 'solution' unless $running;
129 my $pb = $self->problems->find($id, {columns
=> $columns, prefetch
=> 'owner'});
130 eval { ## no critic (RequireCheckingReturnValueOfEval)
131 $self->opens->create({
138 $contest &&= $self->contest($contest);
139 +{ $pb->get_columns, owner_name
=> $pb->owner->name, cansubmit
=> $contest ?
$running : 1, $running ?
(contest_start
=> $contest->start, contest_stop
=> $contest->stop) : () }
143 my ($self, %args) = @_;
144 my $rs = $self->contests->search(undef, {order_by
=> {-desc
=> 'start'}, prefetch
=> 'owner'});
145 $rs = $rs->search({owner
=> $args{owner
}}) if $args{owner
};
148 my $state = $_->is_pending ?
'pending' : $_->is_running ?
'running' : 'finished';
149 $params{$state} //= [];
150 push @
{$params{$state}}, { $_->get_columns, started
=> !$_->is_pending, owner_name
=> $_->owner->name };
156 my ($self, $id) = @_;
157 my $ct = $self->contest($id);
158 +{ $ct->get_columns, started
=> !$ct->is_pending, owner_name
=> $ct->owner->name }
162 my ($self, %args) = @_;
164 my $rs = $self->jobs->search(undef, {order_by
=> {-desc
=> 'me.id'}, prefetch
=> ['problem', 'owner'], rows
=> JOBS_PER_PAGE
, page
=> $args{page
}});
165 $rs = $rs->search({'me.owner' => $args{owner
}}) if $args{owner
};
166 $rs = $rs->search({contest
=> $args{contest
}}) if $args{contest
};
167 $rs = $rs->search({problem
=> $args{problem
}}) if $args{problem
};
170 my %params = $_->get_columns;
171 $params{owner_name
} = $_->owner->name;
172 $params{problem_name
} = $_->problem->name;
173 $params{results
} &&= decode_json
$params{results
};
174 $params{size
} = length $params{source
};
175 delete $params{source
};
178 current_page
=> $rs->pager->current_page,
179 maybe previous_page
=> $rs->pager->previous_page,
180 maybe next_page
=> $rs->pager->next_page,
181 maybe last_page
=> $rs->pager->last_page,
186 my ($self, $id) = @_;
187 my $job = $self->jobs->find($id, {prefetch
=> ['problem', 'owner']});
188 my %params = $job->get_columns;
189 $params{owner_name
} = $job->owner->name;
190 $params{problem_name
} = $job->problem->name;
191 $params{results
} &&= decode_json
$params{results
};
192 $params{size
} = length $params{source
};
193 delete $params{source
};
199 my @jobs = $self->jobs->search(undef, {cache
=> 1})->all;
202 $hash{$_->get_column('problem'), $_->get_column('owner')} = [$_->id, $_->result ?
0 : 1] for @jobs;
203 my @problem_statuses = map { [split ($;), @
{$hash{$_}} ] } keys %hash;
205 my @contest_statuses = map {
206 my $contest = $_->id;
207 my @standings = $self->standings($contest);
208 map { [$contest, $_->{user
}, $_->{score
}, $_->{rank
}] } @standings;
209 } $self->contests->all;
212 $self->problem_statuses->delete;
213 $self->problem_statuses->populate([[qw
/problem owner job solved/], @problem_statuses]);
214 $self->contest_statuses->delete;
215 $self->contest_statuses->populate([[qw
/contest owner score rank/], @contest_statuses]);
229 Gruntmaster::Data - Gruntmaster 6000 Online Judge -- database interface and tools
233 my $db = Gruntmaster::Data->connect('dbi:Pg:');
235 my $problem = $db->problem('my_problem');
236 $problem->update({timeout => 2.5}); # Set time limit to 2.5 seconds
237 $problem->rerun; # And rerun all jobs for this problem
241 my $contest = $db->contests->create({ # Create a new contest
243 name => 'My Awesome Contest',
247 $db->contest_problems->create({ # Add a problem to the contest
248 contest => 'my_contest',
249 problem => 'my_problem',
252 say 'The contest has not started yet' if $contest->is_pending;
256 my @jobs = $db->jobs->search({contest => 'my_contest', owner => 'MGV'})->all;
257 $_->rerun for @jobs; # Rerun all jobs sent by MGV in my_contest
261 Gruntmaster::Data is the interface to the Gruntmaster 6000 database. Read the L<DBIx::Class> documentation for usage information.
263 In addition to the typical DBIx::Class::Schema methods, this module contains several convenience methods:
269 Equivalent to C<< $schema->resultset('Contest') >>
271 =item contest_problems
273 Equivalent to C<< $schema->resultset('ContestProblem') >>
277 Equivalent to C<< $schema->resultset('Job') >>
281 Equivalent to C<< $schema->resultset('Problem') >>
285 Equivalent to C<< $schema->resultset('User') >>
289 Equivalent to C<< $schema->resultset('Contest')->find($id) >>
293 Equivalent to C<< $schema->resultset('Job')->find($id) >>
297 Equivalent to C<< $schema->resultset('Problem')->find($id) >>
301 Equivalent to C<< $schema->resultset('User')->find($id) >>
305 Returns a list of users as an arrayref containing hashrefs.
307 =item user_entry($id)
309 Returns a hashref with information about the user $id.
311 =item problem_list([%args])
313 Returns a list of problems grouped by level. A hashref with levels as keys.
315 Takes the following arguments:
321 Only show problems owned by this user
325 Only show problems in this contest
329 =item problem_entry($id, [$contest, $user])
331 Returns a hashref with information about the problem $id. If $contest and $user are present, problem open data is updated.
333 =item contest_list([%args])
335 Returns a list of contests grouped by state. A hashref with the following keys:
341 An arrayref of hashrefs representing pending contests
345 An arrayref of hashrefs representing running contests
349 An arrayref of hashrefs representing finished contests
353 Takes the following arguments:
359 Only show contests owned by this user.
363 =item contest_entry($id)
365 Returns a hashref with information about the contest $id.
367 =item job_list([%args])
369 Returns a list of jobs as an arrayref containing hashrefs. Takes the following arguments:
375 Only show jobs submitted by this user.
379 Only show jobs submitted in this contest.
383 Only show jobs submitted for this problem.
387 Show this page of results. Defaults to 1. Pages have 10 entries, and the first page has the most recent jobs.
393 Returns a hashref with information about the job $id.
399 Marius Gavrilescu E<lt>marius@ieval.roE<gt>
401 =head1 COPYRIGHT AND LICENSE
403 Copyright (C) 2014 by Marius Gavrilescu
405 This library is free software; you can redistribute it and/or modify
406 it under the same terms as Perl itself, either Perl version 5.18.1 or,
407 at your option, any later version of Perl 5 you may have available.