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 CONTEST_PUBLIC_COLUMNS
=> [qw
/id name description start stop owner/];
29 use constant PROBLEM_PUBLIC_COLUMNS
=> [qw
/id author writer level name owner private timeout olimit value/];
30 use constant USER_PUBLIC_COLUMNS
=> [qw
/id admin name town university country level/];
31 use constant JOBS_PER_PAGE
=> 10;
34 our ($name, $sub) = @_;
35 no strict
'refs'; ## no critic (Strict)
36 *$name = subname
$name => $sub
40 for my $rs (qw
/contest contest_problem job open limit problem user problem_status contest_status/) {
41 my $rsname = ucfirst $rs;
42 $rsname =~ s/_([a-z])/\u$1/gs;
43 dynsub PL_N
($rs) => sub { $_[0]->resultset($rsname) };
44 dynsub
$rs => sub { $_[0]->resultset($rsname)->find($_[1]) };
50 my $rs = $self->users->search(undef, {columns
=> USER_PUBLIC_COLUMNS
} );
51 my (%solved, %attempted, %contests);
53 for my $row ($self->problem_statuses->all) {
54 $solved {$row->rawowner}++ if $row->solved;
55 $attempted{$row->rawowner}++ unless $row->solved;
57 $contests{$_->rawowner}++ for $self->contest_statuses->all;
59 [ sort { $b->{solved
} <=> $a->{solved
} or $b->{attempted
} <=> $a->{attempted
} } ## no critic (ProhibitReverseSort)
60 grep { $_->{solved
} || $_->{attempted
} } map {
63 solved
=> ($solved{$id} // 0),
64 attempted
=> ($attempted{$id} // 0),
65 contests
=> ($contests{$id} // 0) }
71 my $user = $self->users->find($id, {columns
=> USER_PUBLIC_COLUMNS
, prefetch
=> [qw
/problem_statuses contest_statuses/]});
72 my @problems = map { {problem
=> $_->get_column('problem'), solved
=> $_->solved} } $user->problem_statuses->search(undef, {order_by
=> 'problem'});
73 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'});
74 +{ $user->get_columns, problems
=> \
@problems, contests
=> \
@contests }
78 my ($self, %args) = @_;
79 my @columns = @
{PROBLEM_PUBLIC_COLUMNS
()};
80 push @columns, 'solution' if $args{solution
} && $args{contest
} && !$self->contest($args{contest
})->is_running;
81 my $rs = $self->problems->search(undef, {order_by
=> 'me.name', columns
=> \
@columns, prefetch
=> 'owner'});
82 $rs = $rs->search({'private' => 0}) unless $args{contest
} || $args{private
};
83 $rs = $rs->search({'contest_problems.contest' => $args{contest
}}, {join => 'contest_problems'}) if $args{contest
};
84 $rs = $rs->search({'me.owner' => $args{owner
}}) if $args{owner
};
86 $params{contest
} = $args{contest
} if $args{contest
} && $self->contest($args{contest
})->is_running;
88 $params{$_->level} //= [];
89 push @
{$params{$_->level}}, {$_->get_columns, owner_name
=> $_->owner->name} ;
95 my ($self, $id, $contest, $user) = @_;
96 my $running = $contest && $self->contest($contest)->is_running;
97 my @columns = @
{PROBLEM_PUBLIC_COLUMNS
()};
98 push @columns, 'statement';
99 push @columns, 'solution' unless $running;
100 my $pb = $self->problems->find($id, {columns
=> \
@columns, prefetch
=> 'owner'});
101 my @limits = map { +{
102 format
=> $_->format,
103 timeout
=> $_->timeout,
104 } } $self->limits->search({problem
=> $id});
106 $open = $self->opens->find_or_create({
112 $contest &&= $self->contest($contest);
115 @limits ?
(limits
=> \
@limits) : (),
116 owner_name
=> $pb->owner->name,
117 cansubmit
=> !$contest || !$contest->is_finished,
119 contest_start
=> $contest->start,
120 contest_stop
=> $contest->stop,
121 open_time
=> $open->time
127 my ($self, %args) = @_;
128 my $rs = $self->contests->search(undef, {columns
=> CONTEST_PUBLIC_COLUMNS
, order_by
=> {-desc
=> 'start'}, prefetch
=> 'owner'});
129 $rs = $rs->search({owner
=> $args{owner
}}) if $args{owner
};
132 my $state = $_->is_pending ?
'pending' : $_->is_running ?
'running' : 'finished';
133 $params{$state} //= [];
134 push @
{$params{$state}}, { $_->get_columns, owner_name
=> $_->owner->name };
140 my ($self, $id) = @_;
141 my $ct = $self->contests->find($id,{columns
=> CONTEST_PUBLIC_COLUMNS
});
142 +{ $ct->get_columns, started
=> !$ct->is_pending, finished
=> $ct->is_finished, owner_name
=> $ct->owner->name }
146 my ($self, %args) = @_;
148 my $rs = $self->jobs->search(undef, {order_by
=> {-desc
=> 'me.id'}, prefetch
=> ['problem', 'owner', 'contest'], rows
=> JOBS_PER_PAGE
, page
=> $args{page
}});
149 $rs = $rs->search({contest
=> $args{contest
} || undef}) if exists $args{contest
};
150 $rs = $rs->search({'me.private'=> 0}) unless $args{private
};
151 $rs = $rs->search({'me.owner' => $args{owner
}}) if $args{owner
};
152 $rs = $rs->search({problem
=> $args{problem
}}) if $args{problem
};
153 $rs = $rs->search({result
=> $args{result
}}) if defined $args{result
};
156 my %params = $_->get_columns;
157 $params{owner_name
} = $_->owner->name;
158 $params{problem_name
} = $_->problem->name;
159 $params{contest_name
} = $_->contest->name if $params{contest
};
160 $params{results
} &&= decode_json
$params{results
};
161 $params{size
} = length $params{source
};
162 delete $params{source
};
165 current_page
=> $rs->pager->current_page,
166 maybe previous_page
=> $rs->pager->previous_page,
167 maybe next_page
=> $rs->pager->next_page,
168 maybe last_page
=> $rs->pager->last_page,
173 my ($self, $id) = @_;
174 my $job = $self->jobs->find($id, {prefetch
=> ['problem', 'owner', 'contest']});
175 my %params = $job->get_columns;
176 $params{owner_name
} = $job->owner->name;
177 $params{problem_name
} = $job->problem->name;
178 $params{contest_name
} = $job->contest->name if $params{contest
};
179 $params{results
} &&= decode_json
$params{results
};
180 $params{size
} = length $params{source
};
181 delete $params{source
};
187 my @jobs = $self->jobs->search({'me.private' => 0}, {cache
=> 1, prefetch
=> 'problem', order_by
=> 'me.id'})->all;
192 my $pb = $_->get_column('problem');
193 $private{$pb} //= $_->problem->private;
194 next if $private{$pb};
195 $hash{$pb, $_->get_column('owner')} = [$_->id, $_->result ?
0 : 1];
198 my @problem_statuses = map { [split ($;), @
{$hash{$_}} ] } keys %hash;
200 my @contest_statuses = map {
201 my $contest = $_->id;
202 map { [$contest, $_->{user
}, $_->{score
}, $_->{rank
}] } $_->standings
203 } $self->contests->all;
206 $self->problem_statuses->delete;
207 $self->problem_statuses->populate([[qw
/problem owner job solved/], @problem_statuses]);
208 $self->contest_statuses->delete;
209 $self->contest_statuses->populate([[qw
/contest owner score rank/], @contest_statuses]);
215 my @PURGE_HOSTS = exists $ENV{PURGE_HOSTS
} ?
split ' ', $ENV{PURGE_HOSTS
} : ();
216 my $ht = HTTP
::Tiny
->new;
219 $ht->request(PURGE
=> "http://$_$_[0]") for @PURGE_HOSTS;
230 Gruntmaster::Data - Gruntmaster 6000 Online Judge -- database interface and tools
234 my $db = Gruntmaster::Data->connect('dbi:Pg:');
236 my $problem = $db->problem('my_problem');
237 $problem->update({timeout => 2.5}); # Set time limit to 2.5 seconds
238 $problem->rerun; # And rerun all jobs for this problem
242 my $contest = $db->contests->create({ # Create a new contest
244 name => 'My Awesome Contest',
248 $db->contest_problems->create({ # Add a problem to the contest
249 contest => 'my_contest',
250 problem => 'my_problem',
253 say 'The contest has not started yet' if $contest->is_pending;
257 my @jobs = $db->jobs->search({contest => 'my_contest', owner => 'MGV'})->all;
258 $_->rerun for @jobs; # Rerun all jobs sent by MGV in my_contest
262 Gruntmaster::Data is the interface to the Gruntmaster 6000 database. Read the L<DBIx::Class> documentation for usage information.
264 In addition to the typical DBIx::Class::Schema methods, this module contains several convenience methods:
270 Equivalent to C<< $schema->resultset('Contest') >>
272 =item contest_problems
274 Equivalent to C<< $schema->resultset('ContestProblem') >>
278 Equivalent to C<< $schema->resultset('Job') >>
282 Equivalent to C<< $schema->resultset('Problem') >>
286 Equivalent to C<< $schema->resultset('User') >>
290 Equivalent to C<< $schema->resultset('Contest')->find($id) >>
294 Equivalent to C<< $schema->resultset('Job')->find($id) >>
298 Equivalent to C<< $schema->resultset('Problem')->find($id) >>
302 Equivalent to C<< $schema->resultset('User')->find($id) >>
306 Returns a list of users as an arrayref containing hashrefs.
308 =item user_entry($id)
310 Returns a hashref with information about the user $id.
312 =item problem_list([%args])
314 Returns a list of problems grouped by level. A hashref with levels as keys.
316 Takes the following arguments:
322 Only show problems owned by this user
326 Only show problems in this contest
330 =item problem_entry($id, [$contest, $user])
332 Returns a hashref with information about the problem $id. If $contest and $user are present, problem open data is updated.
334 =item contest_list([%args])
336 Returns a list of contests grouped by state. A hashref with the following keys:
342 An arrayref of hashrefs representing pending contests
346 An arrayref of hashrefs representing running contests
350 An arrayref of hashrefs representing finished contests
354 Takes the following arguments:
360 Only show contests owned by this user.
364 =item contest_entry($id)
366 Returns a hashref with information about the contest $id.
368 =item job_list([%args])
370 Returns a list of jobs as an arrayref containing hashrefs. Takes the following arguments:
376 Only show jobs submitted by this user.
380 Only show jobs submitted in this contest.
384 Only show jobs submitted for this problem.
388 Show this page of results. Defaults to 1. Pages have 10 entries, and the first page has the most recent jobs.
394 Returns a hashref with information about the job $id.
400 Marius Gavrilescu E<lt>marius@ieval.roE<gt>
402 =head1 COPYRIGHT AND LICENSE
404 Copyright (C) 2014 by Marius Gavrilescu
406 This library is free software; you can redistribute it and/or modify
407 it under the same terms as Perl itself, either Perl version 5.18.1 or,
408 at your option, any later version of Perl 5 you may have available.