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 my $ctobj = $self->contest($ct);
60 my @problems = map { $_->rawproblem } $self->contest_problems->search({contest
=> $ct}, {qw
/join problem order_by problem.level/});
61 my (%scores, %tries, %opens);
62 $opens{$_->rawproblem, $_->rawowner} = $_ for $self->opens->search({contest
=> $ct});
63 for my $job ($self->jobs->search({contest
=> $ct}, {qw
/order_by me.id prefetch/ => [qw
/problem/]})) {
64 my $open = $opens{$job->rawproblem, $job->rawowner};
65 my $time = $job->date - ($open ?
$open->time : $ctobj->start);
67 my $value = $job->problem->value;
68 my $factor = $job->result ?
0 : 1;
69 $factor = $1 / 100 if $job->result_text =~ /^(\d
+ )/s
;
70 $scores{$job->rawowner}{$job->rawproblem} = int ($factor * calc_score
($value, $time, $tries{$job->rawowner}{$job->rawproblem}++, $ctobj->stop - $ctobj->start));
73 my %user_to_name = map { $_ => $_->name } $self->users->all;
75 my @st = sort { $b->{score
} <=> $a->{score
} or $a->{user
} cmp $b->{user
} } map { ## no critic (ProhibitReverseSortBlock)
79 user_name
=> $user_to_name{$user},
80 score
=> sum
(values %{$scores{$user}}),
81 scores
=> [map { $scores{$user}{$_} // '-'} @problems],
86 $st[$_]->{rank
} = $st[$_ - 1]->{rank
} + ($st[$_]->{score
} < $st[$_ - 1]->{score
}) for 1 .. $#st;
91 my $rs = $_[0]->users->search(undef, {order_by
=> 'name', columns
=> USER_PUBLIC_COLUMNS
});
92 [ map { { $_->get_columns } } $rs->all ]
97 my $user = $self->users->find($id, {columns
=> USER_PUBLIC_COLUMNS
, prefetch
=> [qw
/problem_statuses contest_statuses/]});
98 my @problems = map { {problem
=> $_->get_column('problem'), solved
=> $_->solved} } $user->problem_statuses;
99 my @contests = map { {contest
=> $_->contest->id, contest_name
=> $_->contest->name, rank
=> $_->rank, score
=> $_->score} } $user->contest_statuses->search(undef, {prefetch
=> 'contest'});
100 +{ $user->get_columns, problems
=> \
@problems, contests
=> \
@contests }
104 my ($self, %args) = @_;
105 my $rs = $self->problems->search(undef, {order_by
=> 'me.name', columns
=> PROBLEM_PUBLIC_COLUMNS
, prefetch
=> 'owner'});
106 $rs = $rs->search({-or => ['contest_problems.contest' => undef, 'contest.stop' => {'<=', time}], 'me.private' => 0}, {join => {'contest_problems' => 'contest'}, distinct
=> 1}) unless $args{contest
};
107 $rs = $rs->search({'contest_problems.contest' => $args{contest
}}, {join => 'contest_problems'}) if $args{contest
};
108 $rs = $rs->search({'me.owner' => $args{owner
}}) if $args{owner
};
110 $params{contest
} = $args{contest
} if $args{contest
};
112 $params{$_->level} //= [];
113 push @
{$params{$_->level}}, {$_->get_columns, owner_name
=> $_->owner->name} ;
119 my ($self, $id, $contest, $user) = @_;
120 my $running = $contest && $self->contest($contest)->is_running;
121 my $columns = PROBLEM_PUBLIC_COLUMNS
;
122 push @
$columns, 'solution' unless $running;
123 my $pb = $self->problems->find($id, {columns
=> $columns, prefetch
=> 'owner'});
124 eval { ## no critic (RequireCheckingReturnValueOfEval)
125 $self->opens->create({
132 $contest &&= $self->contest($contest);
133 +{ $pb->get_columns, owner_name
=> $pb->owner->name, cansubmit
=> $contest ?
$running : 1, $running ?
(contest_start
=> $contest->start, contest_stop
=> $contest->stop) : () }
137 my ($self, %args) = @_;
138 my $rs = $self->contests->search(undef, {order_by
=> {-desc
=> 'start'}, prefetch
=> 'owner'});
139 $rs = $rs->search({owner
=> $args{owner
}}) if $args{owner
};
142 my $state = $_->is_pending ?
'pending' : $_->is_running ?
'running' : 'finished';
143 $params{$state} //= [];
144 push @
{$params{$state}}, { $_->get_columns, started
=> !$_->is_pending, owner_name
=> $_->owner->name };
150 my ($self, $id) = @_;
151 my $ct = $self->contest($id);
152 +{ $ct->get_columns, started
=> !$ct->is_pending, owner_name
=> $ct->owner->name }
156 my ($self, %args) = @_;
158 my $rs = $self->jobs->search(undef, {order_by
=> {-desc
=> 'me.id'}, prefetch
=> ['problem', 'owner'], rows
=> JOBS_PER_PAGE
, page
=> $args{page
}});
159 $rs = $rs->search({'me.owner' => $args{owner
}}) if $args{owner
};
160 $rs = $rs->search({contest
=> $args{contest
}}) if $args{contest
};
161 $rs = $rs->search({problem
=> $args{problem
}}) if $args{problem
};
164 my %params = $_->get_columns;
165 $params{owner_name
} = $_->owner->name;
166 $params{problem_name
} = $_->problem->name;
167 $params{results
} &&= decode_json
$params{results
};
168 $params{size
} = length $params{source
};
169 delete $params{source
};
172 current_page
=> $rs->pager->current_page,
173 maybe previous_page
=> $rs->pager->previous_page,
174 maybe next_page
=> $rs->pager->next_page,
175 maybe last_page
=> $rs->pager->last_page,
180 my ($self, $id) = @_;
181 my $job = $self->jobs->find($id, {prefetch
=> ['problem', 'owner']});
182 my %params = $job->get_columns;
183 $params{owner_name
} = $job->owner->name;
184 $params{problem_name
} = $job->problem->name;
185 $params{results
} &&= decode_json
$params{results
};
186 $params{size
} = length $params{source
};
187 delete $params{source
};
193 my @jobs = $self->jobs->search(undef, {cache
=> 1})->all;
196 $hash{$_->get_column('problem'), $_->get_column('owner')} = [$_->id, $_->result ?
0 : 1] for @jobs;
197 my @problem_statuses = map { [split ($;), @
{$hash{$_}} ] } keys %hash;
199 my @contest_statuses = map {
200 my $contest = $_->id;
201 my @standings = $self->standings($contest);
202 map { [$contest, $_->{user
}, $_->{score
}, $_->{rank
}] } @standings;
203 } $self->contests->all;
206 $self->problem_statuses->delete;
207 $self->problem_statuses->populate([[qw
/problem owner job solved/], @problem_statuses]);
208 $self->contest_statuses->delete;
209 $self->contest_statuses->populate([[qw
/contest owner score rank/], @contest_statuses]);
223 Gruntmaster::Data - Gruntmaster 6000 Online Judge -- database interface and tools
227 my $db = Gruntmaster::Data->connect('dbi:Pg:');
229 my $problem = $db->problem('my_problem');
230 $problem->update({timeout => 2.5}); # Set time limit to 2.5 seconds
231 $problem->rerun; # And rerun all jobs for this problem
235 my $contest = $db->contests->create({ # Create a new contest
237 name => 'My Awesome Contest',
241 $db->contest_problems->create({ # Add a problem to the contest
242 contest => 'my_contest',
243 problem => 'my_problem',
246 say 'The contest has not started yet' if $contest->is_pending;
250 my @jobs = $db->jobs->search({contest => 'my_contest', owner => 'MGV'})->all;
251 $_->rerun for @jobs; # Rerun all jobs sent by MGV in my_contest
255 Gruntmaster::Data is the interface to the Gruntmaster 6000 database. Read the L<DBIx::Class> documentation for usage information.
257 In addition to the typical DBIx::Class::Schema methods, this module contains several convenience methods:
263 Equivalent to C<< $schema->resultset('Contest') >>
265 =item contest_problems
267 Equivalent to C<< $schema->resultset('ContestProblem') >>
271 Equivalent to C<< $schema->resultset('Job') >>
275 Equivalent to C<< $schema->resultset('Problem') >>
279 Equivalent to C<< $schema->resultset('User') >>
283 Equivalent to C<< $schema->resultset('Contest')->find($id) >>
287 Equivalent to C<< $schema->resultset('Job')->find($id) >>
291 Equivalent to C<< $schema->resultset('Problem')->find($id) >>
295 Equivalent to C<< $schema->resultset('User')->find($id) >>
299 Returns a list of users as an arrayref containing hashrefs.
301 =item user_entry($id)
303 Returns a hashref with information about the user $id.
305 =item problem_list([%args])
307 Returns a list of problems grouped by level. A hashref with levels as keys.
309 Takes the following arguments:
315 Only show problems owned by this user
319 Only show problems in this contest
323 =item problem_entry($id, [$contest, $user])
325 Returns a hashref with information about the problem $id. If $contest and $user are present, problem open data is updated.
327 =item contest_list([%args])
329 Returns a list of contests grouped by state. A hashref with the following keys:
335 An arrayref of hashrefs representing pending contests
339 An arrayref of hashrefs representing running contests
343 An arrayref of hashrefs representing finished contests
347 Takes the following arguments:
353 Only show contests owned by this user.
357 =item contest_entry($id)
359 Returns a hashref with information about the contest $id.
361 =item job_list([%args])
363 Returns a list of jobs as an arrayref containing hashrefs. Takes the following arguments:
369 Only show jobs submitted by this user.
373 Only show jobs submitted in this contest.
377 Only show jobs submitted for this problem.
381 Show this page of results. Defaults to 1. Pages have 10 entries, and the first page has the most recent jobs.
387 Returns a hashref with information about the job $id.
393 Marius Gavrilescu E<lt>marius@ieval.roE<gt>
395 =head1 COPYRIGHT AND LICENSE
397 Copyright (C) 2014 by Marius Gavrilescu
399 This library is free software; you can redistribute it and/or modify
400 it under the same terms as Perl itself, either Perl version 5.18.1 or,
401 at your option, any later version of Perl 5 you may have available.