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 $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, 'statement';
95 push @
$columns, 'solution' unless $running;
96 my $pb = $self->problems->find($id, {columns
=> $columns, prefetch
=> 'owner'});
98 $open = $self->opens->find_or_create({
104 $contest &&= $self->contest($contest);
107 owner_name
=> $pb->owner->name,
108 cansubmit
=> !$contest || !$contest->is_finished,
110 contest_start
=> $contest->start,
111 contest_stop
=> $contest->stop,
112 open_time
=> $open->time
118 my ($self, %args) = @_;
119 my $rs = $self->contests->search(undef, {order_by
=> {-desc
=> 'start'}, prefetch
=> 'owner'});
120 $rs = $rs->search({owner
=> $args{owner
}}) if $args{owner
};
123 my $state = $_->is_pending ?
'pending' : $_->is_running ?
'running' : 'finished';
124 $params{$state} //= [];
125 push @
{$params{$state}}, { $_->get_columns, owner_name
=> $_->owner->name };
131 my ($self, $id) = @_;
132 my $ct = $self->contest($id);
133 +{ $ct->get_columns, started
=> !$ct->is_pending, owner_name
=> $ct->owner->name }
137 my ($self, %args) = @_;
139 my $rs = $self->jobs->search({contest
=> $args{contest
}}, {order_by
=> {-desc
=> 'me.id'}, prefetch
=> ['problem', 'owner'], rows
=> JOBS_PER_PAGE
, page
=> $args{page
}});
140 $rs = $rs->search({'me.private'=> 0}) unless $args{private
};
141 $rs = $rs->search({'me.owner' => $args{owner
}}) if $args{owner
};
142 $rs = $rs->search({problem
=> $args{problem
}}) if $args{problem
};
145 my %params = $_->get_columns;
146 $params{owner_name
} = $_->owner->name;
147 $params{problem_name
} = $_->problem->name;
148 $params{results
} &&= decode_json
$params{results
};
149 $params{size
} = length $params{source
};
150 delete $params{source
};
153 current_page
=> $rs->pager->current_page,
154 maybe previous_page
=> $rs->pager->previous_page,
155 maybe next_page
=> $rs->pager->next_page,
156 maybe last_page
=> $rs->pager->last_page,
161 my ($self, $id) = @_;
162 my $job = $self->jobs->find($id, {prefetch
=> ['problem', 'owner', 'contest']});
163 my %params = $job->get_columns;
164 $params{owner_name
} = $job->owner->name;
165 $params{problem_name
} = $job->problem->name;
166 $params{contest_name
} = $job->contest->name if $params{contest
};
167 $params{results
} &&= decode_json
$params{results
};
168 $params{size
} = length $params{source
};
169 delete $params{source
};
175 my @jobs = $self->jobs->search(undef, {cache
=> 1})->all;
178 $hash{$_->get_column('problem'), $_->get_column('owner')} = [$_->id, $_->result ?
0 : 1] for @jobs;
179 my @problem_statuses = map { [split ($;), @
{$hash{$_}} ] } keys %hash;
181 my @contest_statuses = map {
182 my $contest = $_->id;
183 map { [$contest, $_->{user
}, $_->{score
}, $_->{rank
}] } $_->standings
184 } $self->contests->all;
187 $self->problem_statuses->delete;
188 $self->problem_statuses->populate([[qw
/problem owner job solved/], @problem_statuses]);
189 $self->contest_statuses->delete;
190 $self->contest_statuses->populate([[qw
/contest owner score rank/], @contest_statuses]);
196 my @PURGE_HOSTS = exists $ENV{PURGE_HOSTS
} ?
split ' ', $ENV{PURGE_HOSTS
} : ();
197 my $ht = HTTP
::Tiny
->new;
200 $ht->request(PURGE
=> "http://$_$_[0]") for @PURGE_HOSTS;
211 Gruntmaster::Data - Gruntmaster 6000 Online Judge -- database interface and tools
215 my $db = Gruntmaster::Data->connect('dbi:Pg:');
217 my $problem = $db->problem('my_problem');
218 $problem->update({timeout => 2.5}); # Set time limit to 2.5 seconds
219 $problem->rerun; # And rerun all jobs for this problem
223 my $contest = $db->contests->create({ # Create a new contest
225 name => 'My Awesome Contest',
229 $db->contest_problems->create({ # Add a problem to the contest
230 contest => 'my_contest',
231 problem => 'my_problem',
234 say 'The contest has not started yet' if $contest->is_pending;
238 my @jobs = $db->jobs->search({contest => 'my_contest', owner => 'MGV'})->all;
239 $_->rerun for @jobs; # Rerun all jobs sent by MGV in my_contest
243 Gruntmaster::Data is the interface to the Gruntmaster 6000 database. Read the L<DBIx::Class> documentation for usage information.
245 In addition to the typical DBIx::Class::Schema methods, this module contains several convenience methods:
251 Equivalent to C<< $schema->resultset('Contest') >>
253 =item contest_problems
255 Equivalent to C<< $schema->resultset('ContestProblem') >>
259 Equivalent to C<< $schema->resultset('Job') >>
263 Equivalent to C<< $schema->resultset('Problem') >>
267 Equivalent to C<< $schema->resultset('User') >>
271 Equivalent to C<< $schema->resultset('Contest')->find($id) >>
275 Equivalent to C<< $schema->resultset('Job')->find($id) >>
279 Equivalent to C<< $schema->resultset('Problem')->find($id) >>
283 Equivalent to C<< $schema->resultset('User')->find($id) >>
287 Returns a list of users as an arrayref containing hashrefs.
289 =item user_entry($id)
291 Returns a hashref with information about the user $id.
293 =item problem_list([%args])
295 Returns a list of problems grouped by level. A hashref with levels as keys.
297 Takes the following arguments:
303 Only show problems owned by this user
307 Only show problems in this contest
311 =item problem_entry($id, [$contest, $user])
313 Returns a hashref with information about the problem $id. If $contest and $user are present, problem open data is updated.
315 =item contest_list([%args])
317 Returns a list of contests grouped by state. A hashref with the following keys:
323 An arrayref of hashrefs representing pending contests
327 An arrayref of hashrefs representing running contests
331 An arrayref of hashrefs representing finished contests
335 Takes the following arguments:
341 Only show contests owned by this user.
345 =item contest_entry($id)
347 Returns a hashref with information about the contest $id.
349 =item job_list([%args])
351 Returns a list of jobs as an arrayref containing hashrefs. Takes the following arguments:
357 Only show jobs submitted by this user.
361 Only show jobs submitted in this contest.
365 Only show jobs submitted for this problem.
369 Show this page of results. Defaults to 1. Pages have 10 entries, and the first page has the most recent jobs.
375 Returns a hashref with information about the job $id.
381 Marius Gavrilescu E<lt>marius@ieval.roE<gt>
383 =head1 COPYRIGHT AND LICENSE
385 Copyright (C) 2014 by Marius Gavrilescu
387 This library is free software; you can redistribute it and/or modify
388 it under the same terms as Perl itself, either Perl version 5.18.1 or,
389 at your option, any later version of Perl 5 you may have available.