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 timeout olimit value/];
29 use constant USER_PUBLIC_COLUMNS
=> [qw
/id admin name town university country 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 @columns = @
{PROBLEM_PUBLIC_COLUMNS
()};
78 push @columns, 'solution' if $args{solution
} && $args{contest
} && !$self->contest($args{contest
})->is_running;
79 my $rs = $self->problems->search(undef, {order_by
=> 'me.name', columns
=> \
@columns, prefetch
=> 'owner'});
80 $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
};
81 $rs = $rs->search({'contest_problems.contest' => $args{contest
}}, {join => 'contest_problems'}) if $args{contest
};
82 $rs = $rs->search({'me.owner' => $args{owner
}}) if $args{owner
};
84 $params{contest
} = $args{contest
} if $args{contest
};
86 $params{$_->level} //= [];
87 push @
{$params{$_->level}}, {$_->get_columns, owner_name
=> $_->owner->name} ;
93 my ($self, $id, $contest, $user) = @_;
94 my $running = $contest && $self->contest($contest)->is_running;
95 my @columns = @
{PROBLEM_PUBLIC_COLUMNS
()};
96 push @columns, 'statement';
97 push @columns, 'solution' unless $running;
98 my $pb = $self->problems->find($id, {columns
=> \
@columns, prefetch
=> 'owner'});
100 $open = $self->opens->find_or_create({
106 $contest &&= $self->contest($contest);
109 owner_name
=> $pb->owner->name,
110 cansubmit
=> !$contest || !$contest->is_finished,
112 contest_start
=> $contest->start,
113 contest_stop
=> $contest->stop,
114 open_time
=> $open->time
120 my ($self, %args) = @_;
121 my $rs = $self->contests->search(undef, {order_by
=> {-desc
=> 'start'}, prefetch
=> 'owner'});
122 $rs = $rs->search({owner
=> $args{owner
}}) if $args{owner
};
125 my $state = $_->is_pending ?
'pending' : $_->is_running ?
'running' : 'finished';
126 $params{$state} //= [];
127 push @
{$params{$state}}, { $_->get_columns, owner_name
=> $_->owner->name };
133 my ($self, $id) = @_;
134 my $ct = $self->contest($id);
135 +{ $ct->get_columns, started
=> !$ct->is_pending, finished
=> $ct->is_finished, owner_name
=> $ct->owner->name }
139 my ($self, %args) = @_;
141 my $rs = $self->jobs->search(undef, {order_by
=> {-desc
=> 'me.id'}, prefetch
=> ['problem', 'owner'], rows
=> JOBS_PER_PAGE
, page
=> $args{page
}});
142 $rs = $rs->search({contest
=> $args{contest
} || undef}) if exists $args{contest
};
143 $rs = $rs->search({'me.private'=> 0}) unless $args{private
};
144 $rs = $rs->search({'me.owner' => $args{owner
}}) if $args{owner
};
145 $rs = $rs->search({problem
=> $args{problem
}}) if $args{problem
};
148 my %params = $_->get_columns;
149 $params{owner_name
} = $_->owner->name;
150 $params{problem_name
} = $_->problem->name;
151 $params{results
} &&= decode_json
$params{results
};
152 $params{size
} = length $params{source
};
153 delete $params{source
};
156 current_page
=> $rs->pager->current_page,
157 maybe previous_page
=> $rs->pager->previous_page,
158 maybe next_page
=> $rs->pager->next_page,
159 maybe last_page
=> $rs->pager->last_page,
164 my ($self, $id) = @_;
165 my $job = $self->jobs->find($id, {prefetch
=> ['problem', 'owner', 'contest']});
166 my %params = $job->get_columns;
167 $params{owner_name
} = $job->owner->name;
168 $params{problem_name
} = $job->problem->name;
169 $params{contest_name
} = $job->contest->name if $params{contest
};
170 $params{results
} &&= decode_json
$params{results
};
171 $params{size
} = length $params{source
};
172 delete $params{source
};
178 my @jobs = $self->jobs->search({'me.private' => 0}, {cache
=> 1, prefetch
=> 'problem'})->all;
183 my $pb = $_->get_column('problem');
184 $private{$pb} //= $_->problem->is_private;
185 next if $private{$pb};
186 $hash{$pb, $_->get_column('owner')} = [$_->id, $_->result ?
0 : 1];
189 my @problem_statuses = map { [split ($;), @
{$hash{$_}} ] } keys %hash;
191 my @contest_statuses = map {
192 my $contest = $_->id;
193 map { [$contest, $_->{user
}, $_->{score
}, $_->{rank
}] } $_->standings
194 } $self->contests->all;
197 $self->problem_statuses->delete;
198 $self->problem_statuses->populate([[qw
/problem owner job solved/], @problem_statuses]);
199 $self->contest_statuses->delete;
200 $self->contest_statuses->populate([[qw
/contest owner score rank/], @contest_statuses]);
206 my @PURGE_HOSTS = exists $ENV{PURGE_HOSTS
} ?
split ' ', $ENV{PURGE_HOSTS
} : ();
207 my $ht = HTTP
::Tiny
->new;
210 $ht->request(PURGE
=> "http://$_$_[0]") for @PURGE_HOSTS;
221 Gruntmaster::Data - Gruntmaster 6000 Online Judge -- database interface and tools
225 my $db = Gruntmaster::Data->connect('dbi:Pg:');
227 my $problem = $db->problem('my_problem');
228 $problem->update({timeout => 2.5}); # Set time limit to 2.5 seconds
229 $problem->rerun; # And rerun all jobs for this problem
233 my $contest = $db->contests->create({ # Create a new contest
235 name => 'My Awesome Contest',
239 $db->contest_problems->create({ # Add a problem to the contest
240 contest => 'my_contest',
241 problem => 'my_problem',
244 say 'The contest has not started yet' if $contest->is_pending;
248 my @jobs = $db->jobs->search({contest => 'my_contest', owner => 'MGV'})->all;
249 $_->rerun for @jobs; # Rerun all jobs sent by MGV in my_contest
253 Gruntmaster::Data is the interface to the Gruntmaster 6000 database. Read the L<DBIx::Class> documentation for usage information.
255 In addition to the typical DBIx::Class::Schema methods, this module contains several convenience methods:
261 Equivalent to C<< $schema->resultset('Contest') >>
263 =item contest_problems
265 Equivalent to C<< $schema->resultset('ContestProblem') >>
269 Equivalent to C<< $schema->resultset('Job') >>
273 Equivalent to C<< $schema->resultset('Problem') >>
277 Equivalent to C<< $schema->resultset('User') >>
281 Equivalent to C<< $schema->resultset('Contest')->find($id) >>
285 Equivalent to C<< $schema->resultset('Job')->find($id) >>
289 Equivalent to C<< $schema->resultset('Problem')->find($id) >>
293 Equivalent to C<< $schema->resultset('User')->find($id) >>
297 Returns a list of users as an arrayref containing hashrefs.
299 =item user_entry($id)
301 Returns a hashref with information about the user $id.
303 =item problem_list([%args])
305 Returns a list of problems grouped by level. A hashref with levels as keys.
307 Takes the following arguments:
313 Only show problems owned by this user
317 Only show problems in this contest
321 =item problem_entry($id, [$contest, $user])
323 Returns a hashref with information about the problem $id. If $contest and $user are present, problem open data is updated.
325 =item contest_list([%args])
327 Returns a list of contests grouped by state. A hashref with the following keys:
333 An arrayref of hashrefs representing pending contests
337 An arrayref of hashrefs representing running contests
341 An arrayref of hashrefs representing finished contests
345 Takes the following arguments:
351 Only show contests owned by this user.
355 =item contest_entry($id)
357 Returns a hashref with information about the contest $id.
359 =item job_list([%args])
361 Returns a list of jobs as an arrayref containing hashrefs. Takes the following arguments:
367 Only show jobs submitted by this user.
371 Only show jobs submitted in this contest.
375 Only show jobs submitted for this problem.
379 Show this page of results. Defaults to 1. Pages have 10 entries, and the first page has the most recent jobs.
385 Returns a hashref with information about the job $id.
391 Marius Gavrilescu E<lt>marius@ieval.roE<gt>
393 =head1 COPYRIGHT AND LICENSE
395 Copyright (C) 2014 by Marius Gavrilescu
397 This library is free software; you can redistribute it and/or modify
398 it under the same terms as Perl itself, either Perl version 5.18.1 or,
399 at your option, any later version of Perl 5 you may have available.