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 use parent qw
/Exporter/;
19 our $VERSION = '5999.000_013';
20 our @EXPORT = qw
/purge/; ## no critic (ProhibitAutomaticExportation)
22 use Lingua
::EN
::Inflect qw
/PL_N/;
23 use JSON
::MaybeXS qw
/decode_json/;
25 use PerlX
::Maybe qw
/maybe/;
26 use Sub
::Name qw
/subname/;
28 use constant PROBLEM_PUBLIC_COLUMNS
=> [qw
/id author writer level name owner private statement timeout olimit value/];
29 use constant USER_PUBLIC_COLUMNS
=> [qw
/id admin name town university level/];
30 use constant JOBS_PER_PAGE
=> 10;
33 our ($name, $sub) = @_;
34 no strict
'refs'; ## no critic (Strict)
35 *$name = subname
$name => $sub
39 for my $rs (qw
/contest contest_problem job open problem user problem_status contest_status/) {
40 my $rsname = ucfirst $rs;
41 $rsname =~ s/_([a-z])/\u$1/gs;
42 dynsub PL_N
($rs) => sub { $_[0]->resultset($rsname) };
43 dynsub
$rs => sub { $_[0]->resultset($rsname)->find($_[1]) };
49 my $rs = $self->users->search(undef, {columns
=> USER_PUBLIC_COLUMNS
} );
50 my (%solved, %attempted, %contests);
52 for my $row ($self->problem_statuses->all) {
53 $solved {$row->rawowner}++ if $row->solved;
54 $attempted{$row->rawowner}++ unless $row->solved;
56 $contests{$_->rawowner}++ for $self->contest_statuses->all;
58 [ sort { $b->{solved
} <=> $a->{solved
} or $b->{attempted
} <=> $a->{attempted
} } map { ## no critic (ProhibitReverseSort)
61 solved
=> ($solved{$id} // 0),
62 attempted
=> ($attempted{$id} // 0),
63 contests
=> ($contests{$id} // 0) }
69 my $user = $self->users->find($id, {columns
=> USER_PUBLIC_COLUMNS
, prefetch
=> [qw
/problem_statuses contest_statuses/]});
70 my @problems = map { {problem
=> $_->get_column('problem'), solved
=> $_->solved} } $user->problem_statuses->search(undef, {order_by
=> 'problem'});
71 my @contests = map { {contest
=> $_->contest->id, contest_name
=> $_->contest->name, rank
=> $_->rank, score
=> $_->score} } $user->contest_statuses->search(undef, {prefetch
=> 'contest', order_by
=> 'contest.start DESC'});
72 +{ $user->get_columns, problems
=> \
@problems, contests
=> \
@contests }
76 my ($self, %args) = @_;
77 my $rs = $self->problems->search(undef, {order_by
=> 'me.name', columns
=> PROBLEM_PUBLIC_COLUMNS
, prefetch
=> 'owner'});
78 $rs = $rs->search({-or => ['contest_problems.contest' => undef, 'contest.stop' => {'<=', time}], 'me.private' => 0}, {join => {'contest_problems' => 'contest'}, distinct
=> 1}) unless $args{contest
} || $args{private
};
79 $rs = $rs->search({'contest_problems.contest' => $args{contest
}}, {join => 'contest_problems'}) if $args{contest
};
80 $rs = $rs->search({'me.owner' => $args{owner
}}) if $args{owner
};
82 $params{contest
} = $args{contest
} if $args{contest
};
84 $params{$_->level} //= [];
85 push @
{$params{$_->level}}, {$_->get_columns, owner_name
=> $_->owner->name} ;
91 my ($self, $id, $contest, $user) = @_;
92 my $running = $contest && $self->contest($contest)->is_running;
93 my $columns = PROBLEM_PUBLIC_COLUMNS
;
94 push @
$columns, 'solution' unless $running;
95 my $pb = $self->problems->find($id, {columns
=> $columns, prefetch
=> 'owner'});
96 eval { ## no critic (RequireCheckingReturnValueOfEval)
97 $self->opens->create({
104 $contest &&= $self->contest($contest);
105 +{ $pb->get_columns, owner_name
=> $pb->owner->name, cansubmit
=> $contest ?
$running : 1, $running ?
(contest_start
=> $contest->start, contest_stop
=> $contest->stop) : () }
109 my ($self, %args) = @_;
110 my $rs = $self->contests->search(undef, {order_by
=> {-desc
=> 'start'}, prefetch
=> 'owner'});
111 $rs = $rs->search({owner
=> $args{owner
}}) if $args{owner
};
114 my $state = $_->is_pending ?
'pending' : $_->is_running ?
'running' : 'finished';
115 $params{$state} //= [];
116 push @
{$params{$state}}, { $_->get_columns, started
=> !$_->is_pending, owner_name
=> $_->owner->name };
122 my ($self, $id) = @_;
123 my $ct = $self->contest($id);
124 +{ $ct->get_columns, started
=> !$ct->is_pending, owner_name
=> $ct->owner->name }
128 my ($self, %args) = @_;
130 my $rs = $self->jobs->search(undef, {order_by
=> {-desc
=> 'me.id'}, prefetch
=> ['problem', 'owner'], rows
=> JOBS_PER_PAGE
, page
=> $args{page
}});
131 $rs = $rs->search({'me.private'=> 0}) unless $args{private
};
132 $rs = $rs->search({'me.owner' => $args{owner
}}) if $args{owner
};
133 $rs = $rs->search({contest
=> $args{contest
}}) if $args{contest
};
134 $rs = $rs->search({problem
=> $args{problem
}}) if $args{problem
};
137 my %params = $_->get_columns;
138 $params{owner_name
} = $_->owner->name;
139 $params{problem_name
} = $_->problem->name;
140 $params{results
} &&= decode_json
$params{results
};
141 $params{size
} = length $params{source
};
142 delete $params{source
};
145 current_page
=> $rs->pager->current_page,
146 maybe previous_page
=> $rs->pager->previous_page,
147 maybe next_page
=> $rs->pager->next_page,
148 maybe last_page
=> $rs->pager->last_page,
153 my ($self, $id) = @_;
154 my $job = $self->jobs->find($id, {prefetch
=> ['problem', 'owner', 'contest']});
155 my %params = $job->get_columns;
156 $params{owner_name
} = $job->owner->name;
157 $params{problem_name
} = $job->problem->name;
158 $params{contest_name
} = $job->contest->name if $params{contest
};
159 $params{results
} &&= decode_json
$params{results
};
160 $params{size
} = length $params{source
};
161 delete $params{source
};
167 my @jobs = $self->jobs->search(undef, {cache
=> 1})->all;
170 $hash{$_->get_column('problem'), $_->get_column('owner')} = [$_->id, $_->result ?
0 : 1] for @jobs;
171 my @problem_statuses = map { [split ($;), @
{$hash{$_}} ] } keys %hash;
173 my @contest_statuses = map {
174 my $contest = $_->id;
175 map { [$contest, $_->{user
}, $_->{score
}, $_->{rank
}] } $_->standings
176 } $self->contests->all;
179 $self->problem_statuses->delete;
180 $self->problem_statuses->populate([[qw
/problem owner job solved/], @problem_statuses]);
181 $self->contest_statuses->delete;
182 $self->contest_statuses->populate([[qw
/contest owner score rank/], @contest_statuses]);
188 my @PURGE_HOSTS = exists $ENV{PURGE_HOSTS
} ?
split ' ', $ENV{PURGE_HOSTS
} : ();
189 my $ht = HTTP
::Tiny
->new;
192 $ht->request(PURGE
=> "http://$_$_[0]") for @PURGE_HOSTS;
203 Gruntmaster::Data - Gruntmaster 6000 Online Judge -- database interface and tools
207 my $db = Gruntmaster::Data->connect('dbi:Pg:');
209 my $problem = $db->problem('my_problem');
210 $problem->update({timeout => 2.5}); # Set time limit to 2.5 seconds
211 $problem->rerun; # And rerun all jobs for this problem
215 my $contest = $db->contests->create({ # Create a new contest
217 name => 'My Awesome Contest',
221 $db->contest_problems->create({ # Add a problem to the contest
222 contest => 'my_contest',
223 problem => 'my_problem',
226 say 'The contest has not started yet' if $contest->is_pending;
230 my @jobs = $db->jobs->search({contest => 'my_contest', owner => 'MGV'})->all;
231 $_->rerun for @jobs; # Rerun all jobs sent by MGV in my_contest
235 Gruntmaster::Data is the interface to the Gruntmaster 6000 database. Read the L<DBIx::Class> documentation for usage information.
237 In addition to the typical DBIx::Class::Schema methods, this module contains several convenience methods:
243 Equivalent to C<< $schema->resultset('Contest') >>
245 =item contest_problems
247 Equivalent to C<< $schema->resultset('ContestProblem') >>
251 Equivalent to C<< $schema->resultset('Job') >>
255 Equivalent to C<< $schema->resultset('Problem') >>
259 Equivalent to C<< $schema->resultset('User') >>
263 Equivalent to C<< $schema->resultset('Contest')->find($id) >>
267 Equivalent to C<< $schema->resultset('Job')->find($id) >>
271 Equivalent to C<< $schema->resultset('Problem')->find($id) >>
275 Equivalent to C<< $schema->resultset('User')->find($id) >>
279 Returns a list of users as an arrayref containing hashrefs.
281 =item user_entry($id)
283 Returns a hashref with information about the user $id.
285 =item problem_list([%args])
287 Returns a list of problems grouped by level. A hashref with levels as keys.
289 Takes the following arguments:
295 Only show problems owned by this user
299 Only show problems in this contest
303 =item problem_entry($id, [$contest, $user])
305 Returns a hashref with information about the problem $id. If $contest and $user are present, problem open data is updated.
307 =item contest_list([%args])
309 Returns a list of contests grouped by state. A hashref with the following keys:
315 An arrayref of hashrefs representing pending contests
319 An arrayref of hashrefs representing running contests
323 An arrayref of hashrefs representing finished contests
327 Takes the following arguments:
333 Only show contests owned by this user.
337 =item contest_entry($id)
339 Returns a hashref with information about the contest $id.
341 =item job_list([%args])
343 Returns a list of jobs as an arrayref containing hashrefs. Takes the following arguments:
349 Only show jobs submitted by this user.
353 Only show jobs submitted in this contest.
357 Only show jobs submitted for this problem.
361 Show this page of results. Defaults to 1. Pages have 10 entries, and the first page has the most recent jobs.
367 Returns a hashref with information about the job $id.
373 Marius Gavrilescu E<lt>marius@ieval.roE<gt>
375 =head1 COPYRIGHT AND LICENSE
377 Copyright (C) 2014 by Marius Gavrilescu
379 This library is free software; you can redistribute it and/or modify
380 it under the same terms as Perl itself, either Perl version 5.18.1 or,
381 at your option, any later version of Perl 5 you may have available.