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'});
97 $open = $self->opens->find_or_create({
103 $contest &&= $self->contest($contest);
106 owner_name
=> $pb->owner->name,
107 cansubmit
=> !$contest || !$contest->is_finished,
109 contest_start
=> $contest->start,
110 contest_stop
=> $contest->stop,
111 open_time
=> $open->time
117 my ($self, %args) = @_;
118 my $rs = $self->contests->search(undef, {order_by
=> {-desc
=> 'start'}, prefetch
=> 'owner'});
119 $rs = $rs->search({owner
=> $args{owner
}}) if $args{owner
};
122 my $state = $_->is_pending ?
'pending' : $_->is_running ?
'running' : 'finished';
123 $params{$state} //= [];
124 push @
{$params{$state}}, { $_->get_columns, started
=> !$_->is_pending, owner_name
=> $_->owner->name };
130 my ($self, $id) = @_;
131 my $ct = $self->contest($id);
132 +{ $ct->get_columns, started
=> !$ct->is_pending, owner_name
=> $ct->owner->name }
136 my ($self, %args) = @_;
138 my $rs = $self->jobs->search({contest
=> $args{contest
}}, {order_by
=> {-desc
=> 'me.id'}, prefetch
=> ['problem', 'owner'], rows
=> JOBS_PER_PAGE
, page
=> $args{page
}});
139 $rs = $rs->search({'me.private'=> 0}) unless $args{private
};
140 $rs = $rs->search({'me.owner' => $args{owner
}}) if $args{owner
};
141 $rs = $rs->search({problem
=> $args{problem
}}) if $args{problem
};
144 my %params = $_->get_columns;
145 $params{owner_name
} = $_->owner->name;
146 $params{problem_name
} = $_->problem->name;
147 $params{results
} &&= decode_json
$params{results
};
148 $params{size
} = length $params{source
};
149 delete $params{source
};
152 current_page
=> $rs->pager->current_page,
153 maybe previous_page
=> $rs->pager->previous_page,
154 maybe next_page
=> $rs->pager->next_page,
155 maybe last_page
=> $rs->pager->last_page,
160 my ($self, $id) = @_;
161 my $job = $self->jobs->find($id, {prefetch
=> ['problem', 'owner', 'contest']});
162 my %params = $job->get_columns;
163 $params{owner_name
} = $job->owner->name;
164 $params{problem_name
} = $job->problem->name;
165 $params{contest_name
} = $job->contest->name if $params{contest
};
166 $params{results
} &&= decode_json
$params{results
};
167 $params{size
} = length $params{source
};
168 delete $params{source
};
174 my @jobs = $self->jobs->search(undef, {cache
=> 1})->all;
177 $hash{$_->get_column('problem'), $_->get_column('owner')} = [$_->id, $_->result ?
0 : 1] for @jobs;
178 my @problem_statuses = map { [split ($;), @
{$hash{$_}} ] } keys %hash;
180 my @contest_statuses = map {
181 my $contest = $_->id;
182 map { [$contest, $_->{user
}, $_->{score
}, $_->{rank
}] } $_->standings
183 } $self->contests->all;
186 $self->problem_statuses->delete;
187 $self->problem_statuses->populate([[qw
/problem owner job solved/], @problem_statuses]);
188 $self->contest_statuses->delete;
189 $self->contest_statuses->populate([[qw
/contest owner score rank/], @contest_statuses]);
195 my @PURGE_HOSTS = exists $ENV{PURGE_HOSTS
} ?
split ' ', $ENV{PURGE_HOSTS
} : ();
196 my $ht = HTTP
::Tiny
->new;
199 $ht->request(PURGE
=> "http://$_$_[0]") for @PURGE_HOSTS;
210 Gruntmaster::Data - Gruntmaster 6000 Online Judge -- database interface and tools
214 my $db = Gruntmaster::Data->connect('dbi:Pg:');
216 my $problem = $db->problem('my_problem');
217 $problem->update({timeout => 2.5}); # Set time limit to 2.5 seconds
218 $problem->rerun; # And rerun all jobs for this problem
222 my $contest = $db->contests->create({ # Create a new contest
224 name => 'My Awesome Contest',
228 $db->contest_problems->create({ # Add a problem to the contest
229 contest => 'my_contest',
230 problem => 'my_problem',
233 say 'The contest has not started yet' if $contest->is_pending;
237 my @jobs = $db->jobs->search({contest => 'my_contest', owner => 'MGV'})->all;
238 $_->rerun for @jobs; # Rerun all jobs sent by MGV in my_contest
242 Gruntmaster::Data is the interface to the Gruntmaster 6000 database. Read the L<DBIx::Class> documentation for usage information.
244 In addition to the typical DBIx::Class::Schema methods, this module contains several convenience methods:
250 Equivalent to C<< $schema->resultset('Contest') >>
252 =item contest_problems
254 Equivalent to C<< $schema->resultset('ContestProblem') >>
258 Equivalent to C<< $schema->resultset('Job') >>
262 Equivalent to C<< $schema->resultset('Problem') >>
266 Equivalent to C<< $schema->resultset('User') >>
270 Equivalent to C<< $schema->resultset('Contest')->find($id) >>
274 Equivalent to C<< $schema->resultset('Job')->find($id) >>
278 Equivalent to C<< $schema->resultset('Problem')->find($id) >>
282 Equivalent to C<< $schema->resultset('User')->find($id) >>
286 Returns a list of users as an arrayref containing hashrefs.
288 =item user_entry($id)
290 Returns a hashref with information about the user $id.
292 =item problem_list([%args])
294 Returns a list of problems grouped by level. A hashref with levels as keys.
296 Takes the following arguments:
302 Only show problems owned by this user
306 Only show problems in this contest
310 =item problem_entry($id, [$contest, $user])
312 Returns a hashref with information about the problem $id. If $contest and $user are present, problem open data is updated.
314 =item contest_list([%args])
316 Returns a list of contests grouped by state. A hashref with the following keys:
322 An arrayref of hashrefs representing pending contests
326 An arrayref of hashrefs representing running contests
330 An arrayref of hashrefs representing finished contests
334 Takes the following arguments:
340 Only show contests owned by this user.
344 =item contest_entry($id)
346 Returns a hashref with information about the contest $id.
348 =item job_list([%args])
350 Returns a list of jobs as an arrayref containing hashrefs. Takes the following arguments:
356 Only show jobs submitted by this user.
360 Only show jobs submitted in this contest.
364 Only show jobs submitted for this problem.
368 Show this page of results. Defaults to 1. Pages have 10 entries, and the first page has the most recent jobs.
374 Returns a hashref with information about the job $id.
380 Marius Gavrilescu E<lt>marius@ieval.roE<gt>
382 =head1 COPYRIGHT AND LICENSE
384 Copyright (C) 2014 by Marius Gavrilescu
386 This library is free software; you can redistribute it and/or modify
387 it under the same terms as Perl itself, either Perl version 5.18.1 or,
388 at your option, any later version of Perl 5 you may have available.