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_010';
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) = @_;
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/g;
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
+ )/;
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';
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 {
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 $pb = $self->problems->find($id, {columns
=> PROBLEM_PUBLIC_COLUMNS
, prefetch
=> 'owner'});
120 my $running = $contest && $self->contest($contest)->is_running;
122 $self->opens->create({
129 +{ $pb->get_columns, owner_name
=> $pb->owner->name, cansubmit
=> $contest ?
$running : 1 }
133 my ($self, %args) = @_;
134 my $rs = $self->contests->search(undef, {order_by
=> {-desc
=> 'start'}, prefetch
=> 'owner'});
135 $rs = $rs->search({owner
=> $args{owner
}}) if $args{owner
};
138 my $state = $_->is_pending ?
'pending' : $_->is_running ?
'running' : 'finished';
139 $params{$state} //= [];
140 push @
{$params{$state}}, { $_->get_columns, started
=> !$_->is_pending, owner_name
=> $_->owner->name };
146 my ($self, $id) = @_;
147 my $ct = $self->contest($id);
148 +{ $ct->get_columns, started
=> !$ct->is_pending, owner_name
=> $ct->owner->name }
152 my ($self, %args) = @_;
154 my $rs = $self->jobs->search(undef, {order_by
=> {-desc
=> 'me.id'}, prefetch
=> ['problem', 'owner'], rows
=> JOBS_PER_PAGE
, page
=> $args{page
}});
155 $rs = $rs->search({'me.owner' => $args{owner
}}) if $args{owner
};
156 $rs = $rs->search({contest
=> $args{contest
}}) if $args{contest
};
157 $rs = $rs->search({problem
=> $args{problem
}}) if $args{problem
};
160 my %params = $_->get_columns;
161 $params{owner_name
} = $_->owner->name;
162 $params{problem_name
} = $_->problem->name;
163 $params{results
} &&= decode_json
$params{results
};
164 $params{size
} = length $params{source
};
165 delete $params{source
};
168 current_page
=> $rs->pager->current_page,
169 maybe previous_page
=> $rs->pager->previous_page,
170 maybe next_page
=> $rs->pager->next_page,
171 maybe last_page
=> $rs->pager->last_page,
176 my ($self, $id) = @_;
177 my $job = $self->jobs->find($id, {prefetch
=> ['problem', 'owner']});
178 my %params = $job->get_columns;
179 $params{owner_name
} = $job->owner->name;
180 $params{problem_name
} = $job->problem->name;
181 $params{results
} &&= decode_json
$params{results
};
182 $params{size
} = length $params{source
};
183 delete $params{source
};
195 Gruntmaster::Data - Gruntmaster 6000 Online Judge -- database interface and tools
199 my $db = Gruntmaster::Data->connect('dbi:Pg:');
201 my $problem = $db->problem('my_problem');
202 $problem->update({timeout => 2.5}); # Set time limit to 2.5 seconds
203 $problem->rerun; # And rerun all jobs for this problem
207 my $contest = $db->contests->create({ # Create a new contest
209 name => 'My Awesome Contest',
213 $db->contest_problems->create({ # Add a problem to the contest
214 contest => 'my_contest',
215 problem => 'my_problem',
218 say 'The contest has not started yet' if $contest->is_pending;
222 my @jobs = $db->jobs->search({contest => 'my_contest', owner => 'MGV'})->all;
223 $_->rerun for @jobs; # Rerun all jobs sent by MGV in my_contest
227 Gruntmaster::Data is the interface to the Gruntmaster 6000 database. Read the L<DBIx::Class> documentation for usage information.
229 In addition to the typical DBIx::Class::Schema methods, this module contains several convenience methods:
235 Equivalent to C<< $schema->resultset('Contest') >>
237 =item contest_problems
239 Equivalent to C<< $schema->resultset('ContestProblem') >>
243 Equivalent to C<< $schema->resultset('Job') >>
247 Equivalent to C<< $schema->resultset('Problem') >>
251 Equivalent to C<< $schema->resultset('User') >>
255 Equivalent to C<< $schema->resultset('Contest')->find($id) >>
259 Equivalent to C<< $schema->resultset('Job')->find($id) >>
263 Equivalent to C<< $schema->resultset('Problem')->find($id) >>
267 Equivalent to C<< $schema->resultset('User')->find($id) >>
271 Returns a list of users as an arrayref containing hashrefs.
273 =item user_entry($id)
275 Returns a hashref with information about the user $id.
277 =item problem_list([%args])
279 Returns a list of problems grouped by level. A hashref with levels as keys.
281 Takes the following arguments:
287 Only show problems owned by this user
291 Only show problems in this contest
295 =item problem_entry($id, [$contest, $user])
297 Returns a hashref with information about the problem $id. If $contest and $user are present, problem open data is updated.
299 =item contest_list([%args])
301 Returns a list of contests grouped by state. A hashref with the following keys:
307 An arrayref of hashrefs representing pending contests
311 An arrayref of hashrefs representing running contests
315 An arrayref of hashrefs representing finished contests
319 Takes the following arguments:
325 Only show contests owned by this user.
329 =item contest_entry($id)
331 Returns a hashref with information about the contest $id.
333 =item job_list([%args])
335 Returns a list of jobs as an arrayref containing hashrefs. Takes the following arguments:
341 Only show jobs submitted by this user.
345 Only show jobs submitted in this contest.
349 Only show jobs submitted for this problem.
353 Show this page of results. Defaults to 1. Pages have 10 entries, and the first page has the most recent jobs.
359 Returns a hashref with information about the job $id.
365 Marius Gavrilescu E<lt>marius@ieval.roE<gt>
367 =head1 COPYRIGHT AND LICENSE
369 Copyright (C) 2014 by Marius Gavrilescu
371 This library is free software; you can redistribute it and/or modify
372 it under the same terms as Perl itself, either Perl version 5.18.1 or,
373 at your option, any later version of Perl 5 you may have available.