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 { $_->problem } $self->contest_problems->search({contest
=> $ct && $ct->id}, {qw
/join problem order_by problem.level/});
62 for my $job ($self->jobs->search({contest
=> $ct && $ct->id}, {order_by
=> 'id'})) {
64 my $open = $self->opens->find($ct->id, $job->problem->id, $job->owner->id);
65 my $time = $job->date - ($open ?
$open->time : $ct->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->owner->id}{$job->problem->id} = int ($factor * calc_score
($value, $time, $tries{$job->owner->id}{$job->problem->id}++, $ct->stop - $ct->start));
72 no warnings
'numeric'; ## no critic (ProhibitNoWarnings)
73 $scores{$job->owner->id}{$job->problem->id} = 0 + $job->result_text || ($job->result ?
0 : 100)
77 my @st = sort { $b->{score
} <=> $a->{score
} or $a->{user
}->id cmp $b->{user
}->id} map { ## no critic (ProhibitReverseSortBlock)
80 user
=> $self->user($user),
81 score
=> sum
(values %{$scores{$user}}),
82 scores
=> [map { $scores{$user}{$_->id} // '-'} @problems],
88 $st[$_]->{rank
} = $st[$_ - 1]->{rank
} + ($st[$_]->{score
} < $st[$_ - 1]->{score
}) for 1 .. $#st;
93 my $rs = $_[0]->users->search(undef, {order_by
=> 'name', columns
=> USER_PUBLIC_COLUMNS
});
94 [ map { { $_->get_columns } } $rs->all ]
99 my $user = $self->users->find($id, {columns
=> USER_PUBLIC_COLUMNS
, prefetch
=> [qw
/problem_statuses contest_statuses/]});
100 my @problems = map { {problem
=> $_->get_column('problem'), solved
=> $_->solved} } $user->problem_statuses;
101 my @contests = map { {contest
=> $_->get_column('contest'), rank
=> $_->rank, score
=> $_->score} } $user->contest_statuses;
102 +{ $user->get_columns, problems
=> \
@problems, contests
=> \
@contests }
106 my ($self, %args) = @_;
107 my $rs = $self->problems->search(undef, {order_by
=> 'me.name', columns
=> PROBLEM_PUBLIC_COLUMNS
, prefetch
=> 'owner'});
108 $rs = $rs->search({-or => ['contest_problems.contest' => undef, 'contest.stop' => {'<=', time}], 'me.private' => 0}, {join => {'contest_problems' => 'contest'}, distinct
=> 1}) unless $args{contest
};
109 $rs = $rs->search({'contest_problems.contest' => $args{contest
}}, {join => 'contest_problems'}) if $args{contest
};
110 $rs = $rs->search({'me.owner' => $args{owner
}}) if $args{owner
};
112 $params{contest
} = $args{contest
} if $args{contest
};
114 $params{$_->level} //= [];
115 push @
{$params{$_->level}}, {$_->get_columns, owner_name
=> $_->owner->name} ;
121 my ($self, $id, $contest, $user) = @_;
122 my $running = $contest && $self->contest($contest)->is_running;
123 my $columns = PROBLEM_PUBLIC_COLUMNS
;
124 push @
$columns, 'solution' unless $running;
125 my $pb = $self->problems->find($id, {columns
=> $columns, prefetch
=> 'owner'});
126 eval { ## no critic (RequireCheckingReturnValueOfEval)
127 $self->opens->create({
134 $contest &&= $self->contest($contest);
135 +{ $pb->get_columns, owner_name
=> $pb->owner->name, cansubmit
=> $contest ?
$running : 1, $running ?
(contest_start
=> $contest->start, contest_stop
=> $contest->stop) : () }
139 my ($self, %args) = @_;
140 my $rs = $self->contests->search(undef, {order_by
=> {-desc
=> 'start'}, prefetch
=> 'owner'});
141 $rs = $rs->search({owner
=> $args{owner
}}) if $args{owner
};
144 my $state = $_->is_pending ?
'pending' : $_->is_running ?
'running' : 'finished';
145 $params{$state} //= [];
146 push @
{$params{$state}}, { $_->get_columns, started
=> !$_->is_pending, owner_name
=> $_->owner->name };
152 my ($self, $id) = @_;
153 my $ct = $self->contest($id);
154 +{ $ct->get_columns, started
=> !$ct->is_pending, owner_name
=> $ct->owner->name }
158 my ($self, %args) = @_;
160 my $rs = $self->jobs->search(undef, {order_by
=> {-desc
=> 'me.id'}, prefetch
=> ['problem', 'owner'], rows
=> JOBS_PER_PAGE
, page
=> $args{page
}});
161 $rs = $rs->search({'me.owner' => $args{owner
}}) if $args{owner
};
162 $rs = $rs->search({contest
=> $args{contest
}}) if $args{contest
};
163 $rs = $rs->search({problem
=> $args{problem
}}) if $args{problem
};
166 my %params = $_->get_columns;
167 $params{owner_name
} = $_->owner->name;
168 $params{problem_name
} = $_->problem->name;
169 $params{results
} &&= decode_json
$params{results
};
170 $params{size
} = length $params{source
};
171 delete $params{source
};
174 current_page
=> $rs->pager->current_page,
175 maybe previous_page
=> $rs->pager->previous_page,
176 maybe next_page
=> $rs->pager->next_page,
177 maybe last_page
=> $rs->pager->last_page,
182 my ($self, $id) = @_;
183 my $job = $self->jobs->find($id, {prefetch
=> ['problem', 'owner']});
184 my %params = $job->get_columns;
185 $params{owner_name
} = $job->owner->name;
186 $params{problem_name
} = $job->problem->name;
187 $params{results
} &&= decode_json
$params{results
};
188 $params{size
} = length $params{source
};
189 delete $params{source
};
195 my @jobs = $self->jobs->search(undef, {cache
=> 1})->all;
197 $hash{$_->get_column('problem'), $_->get_column('owner')} = [$_, $_->result ?
1 : 0] for @jobs;
198 my @problem_statuses = map { [split ($;), @
{$hash{$_}} ] } keys %hash;
200 my @contest_statuses = map {
201 my $contest = $_->id;
202 my @standings = $self->standings($contest);
203 map { [$contest, $_->{user
}, $_->{score
}, $_->{rank
}] } @standings;
204 } $self->contests->all;
207 $self->problem_statuses->delete;
208 $self->problem_statuses->populate([[qw
/problem owner job solved/], @problem_statuses]);
209 $self->contest_statuses->delete;
210 $self->contest_statuses->populate([[qw
/contest owner score rank/], @contest_statuses]);
224 Gruntmaster::Data - Gruntmaster 6000 Online Judge -- database interface and tools
228 my $db = Gruntmaster::Data->connect('dbi:Pg:');
230 my $problem = $db->problem('my_problem');
231 $problem->update({timeout => 2.5}); # Set time limit to 2.5 seconds
232 $problem->rerun; # And rerun all jobs for this problem
236 my $contest = $db->contests->create({ # Create a new contest
238 name => 'My Awesome Contest',
242 $db->contest_problems->create({ # Add a problem to the contest
243 contest => 'my_contest',
244 problem => 'my_problem',
247 say 'The contest has not started yet' if $contest->is_pending;
251 my @jobs = $db->jobs->search({contest => 'my_contest', owner => 'MGV'})->all;
252 $_->rerun for @jobs; # Rerun all jobs sent by MGV in my_contest
256 Gruntmaster::Data is the interface to the Gruntmaster 6000 database. Read the L<DBIx::Class> documentation for usage information.
258 In addition to the typical DBIx::Class::Schema methods, this module contains several convenience methods:
264 Equivalent to C<< $schema->resultset('Contest') >>
266 =item contest_problems
268 Equivalent to C<< $schema->resultset('ContestProblem') >>
272 Equivalent to C<< $schema->resultset('Job') >>
276 Equivalent to C<< $schema->resultset('Problem') >>
280 Equivalent to C<< $schema->resultset('User') >>
284 Equivalent to C<< $schema->resultset('Contest')->find($id) >>
288 Equivalent to C<< $schema->resultset('Job')->find($id) >>
292 Equivalent to C<< $schema->resultset('Problem')->find($id) >>
296 Equivalent to C<< $schema->resultset('User')->find($id) >>
300 Returns a list of users as an arrayref containing hashrefs.
302 =item user_entry($id)
304 Returns a hashref with information about the user $id.
306 =item problem_list([%args])
308 Returns a list of problems grouped by level. A hashref with levels as keys.
310 Takes the following arguments:
316 Only show problems owned by this user
320 Only show problems in this contest
324 =item problem_entry($id, [$contest, $user])
326 Returns a hashref with information about the problem $id. If $contest and $user are present, problem open data is updated.
328 =item contest_list([%args])
330 Returns a list of contests grouped by state. A hashref with the following keys:
336 An arrayref of hashrefs representing pending contests
340 An arrayref of hashrefs representing running contests
344 An arrayref of hashrefs representing finished contests
348 Takes the following arguments:
354 Only show contests owned by this user.
358 =item contest_entry($id)
360 Returns a hashref with information about the contest $id.
362 =item job_list([%args])
364 Returns a list of jobs as an arrayref containing hashrefs. Takes the following arguments:
370 Only show jobs submitted by this user.
374 Only show jobs submitted in this contest.
378 Only show jobs submitted for this problem.
382 Show this page of results. Defaults to 1. Pages have 10 entries, and the first page has the most recent jobs.
388 Returns a hashref with information about the job $id.
394 Marius Gavrilescu E<lt>marius@ieval.roE<gt>
396 =head1 COPYRIGHT AND LICENSE
398 Copyright (C) 2014 by Marius Gavrilescu
400 This library is free software; you can redistribute it and/or modify
401 it under the same terms as Perl itself, either Perl version 5.18.1 or,
402 at your option, any later version of Perl 5 you may have available.