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', 'contest'], 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{contest_name
} = $_->contest->name if $params{contest
};
152 $params{results
} &&= decode_json
$params{results
};
153 $params{size
} = length $params{source
};
154 delete $params{source
};
157 current_page
=> $rs->pager->current_page,
158 maybe previous_page
=> $rs->pager->previous_page,
159 maybe next_page
=> $rs->pager->next_page,
160 maybe last_page
=> $rs->pager->last_page,
165 my ($self, $id) = @_;
166 my $job = $self->jobs->find($id, {prefetch
=> ['problem', 'owner', 'contest']});
167 my %params = $job->get_columns;
168 $params{owner_name
} = $job->owner->name;
169 $params{problem_name
} = $job->problem->name;
170 $params{contest_name
} = $job->contest->name if $params{contest
};
171 $params{results
} &&= decode_json
$params{results
};
172 $params{size
} = length $params{source
};
173 delete $params{source
};
179 my @jobs = $self->jobs->search({'me.private' => 0}, {cache
=> 1, prefetch
=> 'problem'})->all;
184 my $pb = $_->get_column('problem');
185 $private{$pb} //= $_->problem->is_private;
186 next if $private{$pb};
187 $hash{$pb, $_->get_column('owner')} = [$_->id, $_->result ?
0 : 1];
190 my @problem_statuses = map { [split ($;), @
{$hash{$_}} ] } keys %hash;
192 my @contest_statuses = map {
193 my $contest = $_->id;
194 map { [$contest, $_->{user
}, $_->{score
}, $_->{rank
}] } $_->standings
195 } $self->contests->all;
198 $self->problem_statuses->delete;
199 $self->problem_statuses->populate([[qw
/problem owner job solved/], @problem_statuses]);
200 $self->contest_statuses->delete;
201 $self->contest_statuses->populate([[qw
/contest owner score rank/], @contest_statuses]);
207 my @PURGE_HOSTS = exists $ENV{PURGE_HOSTS
} ?
split ' ', $ENV{PURGE_HOSTS
} : ();
208 my $ht = HTTP
::Tiny
->new;
211 $ht->request(PURGE
=> "http://$_$_[0]") for @PURGE_HOSTS;
222 Gruntmaster::Data - Gruntmaster 6000 Online Judge -- database interface and tools
226 my $db = Gruntmaster::Data->connect('dbi:Pg:');
228 my $problem = $db->problem('my_problem');
229 $problem->update({timeout => 2.5}); # Set time limit to 2.5 seconds
230 $problem->rerun; # And rerun all jobs for this problem
234 my $contest = $db->contests->create({ # Create a new contest
236 name => 'My Awesome Contest',
240 $db->contest_problems->create({ # Add a problem to the contest
241 contest => 'my_contest',
242 problem => 'my_problem',
245 say 'The contest has not started yet' if $contest->is_pending;
249 my @jobs = $db->jobs->search({contest => 'my_contest', owner => 'MGV'})->all;
250 $_->rerun for @jobs; # Rerun all jobs sent by MGV in my_contest
254 Gruntmaster::Data is the interface to the Gruntmaster 6000 database. Read the L<DBIx::Class> documentation for usage information.
256 In addition to the typical DBIx::Class::Schema methods, this module contains several convenience methods:
262 Equivalent to C<< $schema->resultset('Contest') >>
264 =item contest_problems
266 Equivalent to C<< $schema->resultset('ContestProblem') >>
270 Equivalent to C<< $schema->resultset('Job') >>
274 Equivalent to C<< $schema->resultset('Problem') >>
278 Equivalent to C<< $schema->resultset('User') >>
282 Equivalent to C<< $schema->resultset('Contest')->find($id) >>
286 Equivalent to C<< $schema->resultset('Job')->find($id) >>
290 Equivalent to C<< $schema->resultset('Problem')->find($id) >>
294 Equivalent to C<< $schema->resultset('User')->find($id) >>
298 Returns a list of users as an arrayref containing hashrefs.
300 =item user_entry($id)
302 Returns a hashref with information about the user $id.
304 =item problem_list([%args])
306 Returns a list of problems grouped by level. A hashref with levels as keys.
308 Takes the following arguments:
314 Only show problems owned by this user
318 Only show problems in this contest
322 =item problem_entry($id, [$contest, $user])
324 Returns a hashref with information about the problem $id. If $contest and $user are present, problem open data is updated.
326 =item contest_list([%args])
328 Returns a list of contests grouped by state. A hashref with the following keys:
334 An arrayref of hashrefs representing pending contests
338 An arrayref of hashrefs representing running contests
342 An arrayref of hashrefs representing finished contests
346 Takes the following arguments:
352 Only show contests owned by this user.
356 =item contest_entry($id)
358 Returns a hashref with information about the contest $id.
360 =item job_list([%args])
362 Returns a list of jobs as an arrayref containing hashrefs. Takes the following arguments:
368 Only show jobs submitted by this user.
372 Only show jobs submitted in this contest.
376 Only show jobs submitted for this problem.
380 Show this page of results. Defaults to 1. Pages have 10 entries, and the first page has the most recent jobs.
386 Returns a hashref with information about the job $id.
392 Marius Gavrilescu E<lt>marius@ieval.roE<gt>
394 =head1 COPYRIGHT AND LICENSE
396 Copyright (C) 2014 by Marius Gavrilescu
398 This library is free software; you can redistribute it and/or modify
399 it under the same terms as Perl itself, either Perl version 5.18.1 or,
400 at your option, any later version of Perl 5 you may have available.