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/) {
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 +{ $self->users->find($id, {columns
=> USER_PUBLIC_COLUMNS
})->get_columns }
103 my ($self, %args) = @_;
104 my $rs = $self->problems->search(undef, {order_by
=> 'me.name', columns
=> PROBLEM_PUBLIC_COLUMNS
, prefetch
=> 'owner'});
105 $rs = $rs->search({-or => ['contest_problems.contest' => undef, 'contest.stop' => {'<=', time}], 'me.private' => 0}, {join => {'contest_problems' => 'contest'}, distinct
=> 1}) unless $args{contest
};
106 $rs = $rs->search({'contest_problems.contest' => $args{contest
}}, {join => 'contest_problems'}) if $args{contest
};
107 $rs = $rs->search({'me.owner' => $args{owner
}}) if $args{owner
};
109 $params{contest
} = $args{contest
} if $args{contest
};
111 $params{$_->level} //= [];
112 push @
{$params{$_->level}}, {$_->get_columns, owner_name
=> $_->owner->name} ;
118 my ($self, $id, $contest, $user) = @_;
119 my $running = $contest && $self->contest($contest)->is_running;
120 my $columns = PROBLEM_PUBLIC_COLUMNS
;
121 push @
$columns, 'solution' unless $running;
122 my $pb = $self->problems->find($id, {columns
=> $columns, prefetch
=> 'owner'});
123 eval { ## no critic (RequireCheckingReturnValueOfEval)
124 $self->opens->create({
131 $contest &&= $self->contest($contest);
132 +{ $pb->get_columns, owner_name
=> $pb->owner->name, cansubmit
=> $contest ?
$running : 1, $running ?
(contest_start
=> $contest->start, contest_stop
=> $contest->stop) : () }
136 my ($self, %args) = @_;
137 my $rs = $self->contests->search(undef, {order_by
=> {-desc
=> 'start'}, prefetch
=> 'owner'});
138 $rs = $rs->search({owner
=> $args{owner
}}) if $args{owner
};
141 my $state = $_->is_pending ?
'pending' : $_->is_running ?
'running' : 'finished';
142 $params{$state} //= [];
143 push @
{$params{$state}}, { $_->get_columns, started
=> !$_->is_pending, owner_name
=> $_->owner->name };
149 my ($self, $id) = @_;
150 my $ct = $self->contest($id);
151 +{ $ct->get_columns, started
=> !$ct->is_pending, owner_name
=> $ct->owner->name }
155 my ($self, %args) = @_;
157 my $rs = $self->jobs->search(undef, {order_by
=> {-desc
=> 'me.id'}, prefetch
=> ['problem', 'owner'], rows
=> JOBS_PER_PAGE
, page
=> $args{page
}});
158 $rs = $rs->search({'me.owner' => $args{owner
}}) if $args{owner
};
159 $rs = $rs->search({contest
=> $args{contest
}}) if $args{contest
};
160 $rs = $rs->search({problem
=> $args{problem
}}) if $args{problem
};
163 my %params = $_->get_columns;
164 $params{owner_name
} = $_->owner->name;
165 $params{problem_name
} = $_->problem->name;
166 $params{results
} &&= decode_json
$params{results
};
167 $params{size
} = length $params{source
};
168 delete $params{source
};
171 current_page
=> $rs->pager->current_page,
172 maybe previous_page
=> $rs->pager->previous_page,
173 maybe next_page
=> $rs->pager->next_page,
174 maybe last_page
=> $rs->pager->last_page,
179 my ($self, $id) = @_;
180 my $job = $self->jobs->find($id, {prefetch
=> ['problem', 'owner']});
181 my %params = $job->get_columns;
182 $params{owner_name
} = $job->owner->name;
183 $params{problem_name
} = $job->problem->name;
184 $params{results
} &&= decode_json
$params{results
};
185 $params{size
} = length $params{source
};
186 delete $params{source
};
198 Gruntmaster::Data - Gruntmaster 6000 Online Judge -- database interface and tools
202 my $db = Gruntmaster::Data->connect('dbi:Pg:');
204 my $problem = $db->problem('my_problem');
205 $problem->update({timeout => 2.5}); # Set time limit to 2.5 seconds
206 $problem->rerun; # And rerun all jobs for this problem
210 my $contest = $db->contests->create({ # Create a new contest
212 name => 'My Awesome Contest',
216 $db->contest_problems->create({ # Add a problem to the contest
217 contest => 'my_contest',
218 problem => 'my_problem',
221 say 'The contest has not started yet' if $contest->is_pending;
225 my @jobs = $db->jobs->search({contest => 'my_contest', owner => 'MGV'})->all;
226 $_->rerun for @jobs; # Rerun all jobs sent by MGV in my_contest
230 Gruntmaster::Data is the interface to the Gruntmaster 6000 database. Read the L<DBIx::Class> documentation for usage information.
232 In addition to the typical DBIx::Class::Schema methods, this module contains several convenience methods:
238 Equivalent to C<< $schema->resultset('Contest') >>
240 =item contest_problems
242 Equivalent to C<< $schema->resultset('ContestProblem') >>
246 Equivalent to C<< $schema->resultset('Job') >>
250 Equivalent to C<< $schema->resultset('Problem') >>
254 Equivalent to C<< $schema->resultset('User') >>
258 Equivalent to C<< $schema->resultset('Contest')->find($id) >>
262 Equivalent to C<< $schema->resultset('Job')->find($id) >>
266 Equivalent to C<< $schema->resultset('Problem')->find($id) >>
270 Equivalent to C<< $schema->resultset('User')->find($id) >>
274 Returns a list of users as an arrayref containing hashrefs.
276 =item user_entry($id)
278 Returns a hashref with information about the user $id.
280 =item problem_list([%args])
282 Returns a list of problems grouped by level. A hashref with levels as keys.
284 Takes the following arguments:
290 Only show problems owned by this user
294 Only show problems in this contest
298 =item problem_entry($id, [$contest, $user])
300 Returns a hashref with information about the problem $id. If $contest and $user are present, problem open data is updated.
302 =item contest_list([%args])
304 Returns a list of contests grouped by state. A hashref with the following keys:
310 An arrayref of hashrefs representing pending contests
314 An arrayref of hashrefs representing running contests
318 An arrayref of hashrefs representing finished contests
322 Takes the following arguments:
328 Only show contests owned by this user.
332 =item contest_entry($id)
334 Returns a hashref with information about the contest $id.
336 =item job_list([%args])
338 Returns a list of jobs as an arrayref containing hashrefs. Takes the following arguments:
344 Only show jobs submitted by this user.
348 Only show jobs submitted in this contest.
352 Only show jobs submitted for this problem.
356 Show this page of results. Defaults to 1. Pages have 10 entries, and the first page has the most recent jobs.
362 Returns a hashref with information about the job $id.
368 Marius Gavrilescu E<lt>marius@ieval.roE<gt>
370 =head1 COPYRIGHT AND LICENSE
372 Copyright (C) 2014 by Marius Gavrilescu
374 This library is free software; you can redistribute it and/or modify
375 it under the same terms as Perl itself, either Perl version 5.18.1 or,
376 at your option, any later version of Perl 5 you may have available.