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 my @users = sort { $b->{solved
} <=> $a->{solved
} or $b->{attempted
} <=> $a->{attempted
} } ## no critic (ProhibitReverseSort)
63 solved
=> ($solved{$id} // 0),
64 attempted
=> ($attempted{$id} // 0),
65 contests
=> ($contests{$id} // 0) }
67 @users = @users[0 .. 199] if @users > 200;
73 my $user = $self->users->find($id, {columns
=> USER_PUBLIC_COLUMNS
, prefetch
=> [qw
/problem_statuses contest_statuses/]});
74 my @problems = map { {problem
=> $_->get_column('problem'), solved
=> $_->solved} } $user->problem_statuses->search(undef, {order_by
=> 'problem'});
75 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'});
76 +{ $user->get_columns, problems
=> \
@problems, contests
=> \
@contests }
80 my ($self, %args) = @_;
81 my @columns = @
{PROBLEM_PUBLIC_COLUMNS
()};
82 push @columns, 'solution' if $args{solution
} && $args{contest
} && !$self->contest($args{contest
})->is_running;
83 my $rs = $self->problems->search(undef, {order_by
=> 'me.name', columns
=> \
@columns, prefetch
=> 'owner'});
84 $rs = $rs->search({'private' => 0}) unless $args{contest
} || $args{private
};
85 $rs = $rs->search({'contest_problems.contest' => $args{contest
}}, {join => 'contest_problems'}) if $args{contest
};
86 $rs = $rs->search({'me.owner' => $args{owner
}}) if $args{owner
};
88 $params{contest
} = $args{contest
} if $args{contest
} && $self->contest($args{contest
})->is_running;
90 $params{$_->level} //= [];
91 push @
{$params{$_->level}}, {$_->get_columns, owner_name
=> $_->owner->name} ;
97 my ($self, $id, $contest, $user) = @_;
98 my $running = $contest && $self->contest($contest)->is_running;
99 my @columns = @
{PROBLEM_PUBLIC_COLUMNS
()};
100 push @columns, 'statement';
101 push @columns, 'solution' unless $running;
102 my $pb = $self->problems->find($id, {columns
=> \
@columns, prefetch
=> 'owner'});
103 my @limits = map { +{
104 format
=> $_->format,
105 timeout
=> $_->timeout,
106 } } $self->limits->search({problem
=> $id});
108 $open = $self->opens->find_or_create({
114 $contest &&= $self->contest($contest);
117 @limits ?
(limits
=> \
@limits) : (),
118 owner_name
=> $pb->owner->name,
119 cansubmit
=> !$contest || !$contest->is_finished,
121 contest_start
=> $contest->start,
122 contest_stop
=> $contest->stop,
123 open_time
=> $open->time
129 my ($self, %args) = @_;
130 my $rs = $self->contests->search(undef, {columns
=> CONTEST_PUBLIC_COLUMNS
, order_by
=> {-desc
=> 'start'}, prefetch
=> 'owner'});
131 $rs = $rs->search({owner
=> $args{owner
}}) if $args{owner
};
134 my $state = $_->is_pending ?
'pending' : $_->is_running ?
'running' : 'finished';
135 $params{$state} //= [];
136 push @
{$params{$state}}, { $_->get_columns, owner_name
=> $_->owner->name };
142 my ($self, $id) = @_;
143 my $ct = $self->contests->find($id,{columns
=> CONTEST_PUBLIC_COLUMNS
});
144 +{ $ct->get_columns, started
=> !$ct->is_pending, finished
=> $ct->is_finished, owner_name
=> $ct->owner->name }
148 my ($self, %args) = @_;
150 my $rs = $self->jobs->search(undef, {order_by
=> {-desc
=> 'me.id'}, prefetch
=> ['problem', 'owner', 'contest'], rows
=> JOBS_PER_PAGE
, page
=> $args{page
}});
151 $rs = $rs->search({contest
=> $args{contest
} || undef}) if exists $args{contest
};
152 $rs = $rs->search({'me.private'=> 0}) unless $args{private
};
153 $rs = $rs->search({'me.owner' => $args{owner
}}) if $args{owner
};
154 $rs = $rs->search({problem
=> $args{problem
}}) if $args{problem
};
155 $rs = $rs->search({result
=> $args{result
}}) if defined $args{result
};
158 my %params = $_->get_columns;
159 $params{owner_name
} = $_->owner->name;
160 $params{problem_name
} = $_->problem->name;
161 $params{contest_name
} = $_->contest->name if $params{contest
};
162 $params{results
} &&= decode_json
$params{results
};
163 $params{size
} = length $params{source
};
164 delete $params{source
};
167 current_page
=> $rs->pager->current_page,
168 maybe previous_page
=> $rs->pager->previous_page,
169 maybe next_page
=> $rs->pager->next_page,
170 maybe last_page
=> $rs->pager->last_page,
175 my ($self, $id) = @_;
176 my $job = $self->jobs->find($id, {prefetch
=> ['problem', 'owner', 'contest']});
177 my %params = $job->get_columns;
178 $params{owner_name
} = $job->owner->name;
179 $params{problem_name
} = $job->problem->name;
180 $params{contest_name
} = $job->contest->name if $params{contest
};
181 $params{results
} &&= decode_json
$params{results
};
182 $params{size
} = length $params{source
};
183 delete $params{source
};
189 my @jobs = $self->jobs->search({'me.private' => 0}, {cache
=> 1, prefetch
=> 'problem', order_by
=> 'me.id'})->all;
194 my $pb = $_->get_column('problem');
195 $private{$pb} //= $_->problem->private;
196 next if $private{$pb};
197 $hash{$pb, $_->get_column('owner')} = [$_->id, $_->result ?
0 : 1];
200 my @problem_statuses = map { [split ($;), @
{$hash{$_}} ] } keys %hash;
202 my @contest_statuses = map {
203 my $contest = $_->id;
204 map { [$contest, $_->{user
}, $_->{score
}, $_->{rank
}] } $_->standings
205 } $self->contests->all;
208 $self->problem_statuses->delete;
209 $self->problem_statuses->populate([[qw
/problem owner job solved/], @problem_statuses]);
210 $self->contest_statuses->delete;
211 $self->contest_statuses->populate([[qw
/contest owner score rank/], @contest_statuses]);
217 my @PURGE_HOSTS = exists $ENV{PURGE_HOSTS
} ?
split ' ', $ENV{PURGE_HOSTS
} : ();
218 my $ht = HTTP
::Tiny
->new;
221 $ht->request(PURGE
=> "http://$_$_[0]") for @PURGE_HOSTS;
232 Gruntmaster::Data - Gruntmaster 6000 Online Judge -- database interface and tools
236 my $db = Gruntmaster::Data->connect('dbi:Pg:');
238 my $problem = $db->problem('my_problem');
239 $problem->update({timeout => 2.5}); # Set time limit to 2.5 seconds
240 $problem->rerun; # And rerun all jobs for this problem
244 my $contest = $db->contests->create({ # Create a new contest
246 name => 'My Awesome Contest',
250 $db->contest_problems->create({ # Add a problem to the contest
251 contest => 'my_contest',
252 problem => 'my_problem',
255 say 'The contest has not started yet' if $contest->is_pending;
259 my @jobs = $db->jobs->search({contest => 'my_contest', owner => 'MGV'})->all;
260 $_->rerun for @jobs; # Rerun all jobs sent by MGV in my_contest
264 Gruntmaster::Data is the interface to the Gruntmaster 6000 database. Read the L<DBIx::Class> documentation for usage information.
266 In addition to the typical DBIx::Class::Schema methods, this module contains several convenience methods:
272 Equivalent to C<< $schema->resultset('Contest') >>
274 =item contest_problems
276 Equivalent to C<< $schema->resultset('ContestProblem') >>
280 Equivalent to C<< $schema->resultset('Job') >>
284 Equivalent to C<< $schema->resultset('Problem') >>
288 Equivalent to C<< $schema->resultset('User') >>
292 Equivalent to C<< $schema->resultset('Contest')->find($id) >>
296 Equivalent to C<< $schema->resultset('Job')->find($id) >>
300 Equivalent to C<< $schema->resultset('Problem')->find($id) >>
304 Equivalent to C<< $schema->resultset('User')->find($id) >>
308 Returns a list of users as an arrayref containing hashrefs.
310 =item user_entry($id)
312 Returns a hashref with information about the user $id.
314 =item problem_list([%args])
316 Returns a list of problems grouped by level. A hashref with levels as keys.
318 Takes the following arguments:
324 Only show problems owned by this user
328 Only show problems in this contest
332 =item problem_entry($id, [$contest, $user])
334 Returns a hashref with information about the problem $id. If $contest and $user are present, problem open data is updated.
336 =item contest_list([%args])
338 Returns a list of contests grouped by state. A hashref with the following keys:
344 An arrayref of hashrefs representing pending contests
348 An arrayref of hashrefs representing running contests
352 An arrayref of hashrefs representing finished contests
356 Takes the following arguments:
362 Only show contests owned by this user.
366 =item contest_entry($id)
368 Returns a hashref with information about the contest $id.
370 =item job_list([%args])
372 Returns a list of jobs as an arrayref containing hashrefs. Takes the following arguments:
378 Only show jobs submitted by this user.
382 Only show jobs submitted in this contest.
386 Only show jobs submitted for this problem.
390 Show this page of results. Defaults to 1. Pages have 10 entries, and the first page has the most recent jobs.
396 Returns a hashref with information about the job $id.
402 Marius Gavrilescu E<lt>marius@ieval.roE<gt>
404 =head1 COPYRIGHT AND LICENSE
406 Copyright (C) 2014 by Marius Gavrilescu
408 This library is free software; you can redistribute it and/or modify
409 it under the same terms as Perl itself, either Perl version 5.18.1 or,
410 at your option, any later version of Perl 5 you may have available.