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'});
102 $open = $self->opens->find_or_create({
108 $contest &&= $self->contest($contest);
111 owner_name
=> $pb->owner->name,
112 cansubmit
=> !$contest || !$contest->is_finished,
114 contest_start
=> $contest->start,
115 contest_stop
=> $contest->stop,
116 open_time
=> $open->time
122 my ($self, %args) = @_;
123 my $rs = $self->contests->search(undef, {columns
=> CONTEST_PUBLIC_COLUMNS
, order_by
=> {-desc
=> 'start'}, prefetch
=> 'owner'});
124 $rs = $rs->search({owner
=> $args{owner
}}) if $args{owner
};
127 my $state = $_->is_pending ?
'pending' : $_->is_running ?
'running' : 'finished';
128 $params{$state} //= [];
129 push @
{$params{$state}}, { $_->get_columns, owner_name
=> $_->owner->name };
135 my ($self, $id) = @_;
136 my $ct = $self->contests->find($id,{columns
=> CONTEST_PUBLIC_COLUMNS
});
137 +{ $ct->get_columns, started
=> !$ct->is_pending, finished
=> $ct->is_finished, owner_name
=> $ct->owner->name }
141 my ($self, %args) = @_;
143 my $rs = $self->jobs->search(undef, {order_by
=> {-desc
=> 'me.id'}, prefetch
=> ['problem', 'owner', 'contest'], rows
=> JOBS_PER_PAGE
, page
=> $args{page
}});
144 $rs = $rs->search({contest
=> $args{contest
} || undef}) if exists $args{contest
};
145 $rs = $rs->search({'me.private'=> 0}) unless $args{private
};
146 $rs = $rs->search({'me.owner' => $args{owner
}}) if $args{owner
};
147 $rs = $rs->search({problem
=> $args{problem
}}) if $args{problem
};
148 $rs = $rs->search({result
=> $args{result
}}) if defined $args{result
};
151 my %params = $_->get_columns;
152 $params{owner_name
} = $_->owner->name;
153 $params{problem_name
} = $_->problem->name;
154 $params{contest_name
} = $_->contest->name if $params{contest
};
155 $params{results
} &&= decode_json
$params{results
};
156 $params{size
} = length $params{source
};
157 delete $params{source
};
160 current_page
=> $rs->pager->current_page,
161 maybe previous_page
=> $rs->pager->previous_page,
162 maybe next_page
=> $rs->pager->next_page,
163 maybe last_page
=> $rs->pager->last_page,
168 my ($self, $id) = @_;
169 my $job = $self->jobs->find($id, {prefetch
=> ['problem', 'owner', 'contest']});
170 my %params = $job->get_columns;
171 $params{owner_name
} = $job->owner->name;
172 $params{problem_name
} = $job->problem->name;
173 $params{contest_name
} = $job->contest->name if $params{contest
};
174 $params{results
} &&= decode_json
$params{results
};
175 $params{size
} = length $params{source
};
176 delete $params{source
};
182 my @jobs = $self->jobs->search({'me.private' => 0}, {cache
=> 1, prefetch
=> 'problem', order_by
=> 'me.id'})->all;
187 my $pb = $_->get_column('problem');
188 $private{$pb} //= $_->problem->private;
189 next if $private{$pb};
190 $hash{$pb, $_->get_column('owner')} = [$_->id, $_->result ?
0 : 1];
193 my @problem_statuses = map { [split ($;), @
{$hash{$_}} ] } keys %hash;
195 my @contest_statuses = map {
196 my $contest = $_->id;
197 map { [$contest, $_->{user
}, $_->{score
}, $_->{rank
}] } $_->standings
198 } $self->contests->all;
201 $self->problem_statuses->delete;
202 $self->problem_statuses->populate([[qw
/problem owner job solved/], @problem_statuses]);
203 $self->contest_statuses->delete;
204 $self->contest_statuses->populate([[qw
/contest owner score rank/], @contest_statuses]);
210 my @PURGE_HOSTS = exists $ENV{PURGE_HOSTS
} ?
split ' ', $ENV{PURGE_HOSTS
} : ();
211 my $ht = HTTP
::Tiny
->new;
214 $ht->request(PURGE
=> "http://$_$_[0]") for @PURGE_HOSTS;
225 Gruntmaster::Data - Gruntmaster 6000 Online Judge -- database interface and tools
229 my $db = Gruntmaster::Data->connect('dbi:Pg:');
231 my $problem = $db->problem('my_problem');
232 $problem->update({timeout => 2.5}); # Set time limit to 2.5 seconds
233 $problem->rerun; # And rerun all jobs for this problem
237 my $contest = $db->contests->create({ # Create a new contest
239 name => 'My Awesome Contest',
243 $db->contest_problems->create({ # Add a problem to the contest
244 contest => 'my_contest',
245 problem => 'my_problem',
248 say 'The contest has not started yet' if $contest->is_pending;
252 my @jobs = $db->jobs->search({contest => 'my_contest', owner => 'MGV'})->all;
253 $_->rerun for @jobs; # Rerun all jobs sent by MGV in my_contest
257 Gruntmaster::Data is the interface to the Gruntmaster 6000 database. Read the L<DBIx::Class> documentation for usage information.
259 In addition to the typical DBIx::Class::Schema methods, this module contains several convenience methods:
265 Equivalent to C<< $schema->resultset('Contest') >>
267 =item contest_problems
269 Equivalent to C<< $schema->resultset('ContestProblem') >>
273 Equivalent to C<< $schema->resultset('Job') >>
277 Equivalent to C<< $schema->resultset('Problem') >>
281 Equivalent to C<< $schema->resultset('User') >>
285 Equivalent to C<< $schema->resultset('Contest')->find($id) >>
289 Equivalent to C<< $schema->resultset('Job')->find($id) >>
293 Equivalent to C<< $schema->resultset('Problem')->find($id) >>
297 Equivalent to C<< $schema->resultset('User')->find($id) >>
301 Returns a list of users as an arrayref containing hashrefs.
303 =item user_entry($id)
305 Returns a hashref with information about the user $id.
307 =item problem_list([%args])
309 Returns a list of problems grouped by level. A hashref with levels as keys.
311 Takes the following arguments:
317 Only show problems owned by this user
321 Only show problems in this contest
325 =item problem_entry($id, [$contest, $user])
327 Returns a hashref with information about the problem $id. If $contest and $user are present, problem open data is updated.
329 =item contest_list([%args])
331 Returns a list of contests grouped by state. A hashref with the following keys:
337 An arrayref of hashrefs representing pending contests
341 An arrayref of hashrefs representing running contests
345 An arrayref of hashrefs representing finished contests
349 Takes the following arguments:
355 Only show contests owned by this user.
359 =item contest_entry($id)
361 Returns a hashref with information about the contest $id.
363 =item job_list([%args])
365 Returns a list of jobs as an arrayref containing hashrefs. Takes the following arguments:
371 Only show jobs submitted by this user.
375 Only show jobs submitted in this contest.
379 Only show jobs submitted for this problem.
383 Show this page of results. Defaults to 1. Pages have 10 entries, and the first page has the most recent jobs.
389 Returns a hashref with information about the job $id.
395 Marius Gavrilescu E<lt>marius@ieval.roE<gt>
397 =head1 COPYRIGHT AND LICENSE
399 Copyright (C) 2014 by Marius Gavrilescu
401 This library is free software; you can redistribute it and/or modify
402 it under the same terms as Perl itself, either Perl version 5.18.1 or,
403 at your option, any later version of Perl 5 you may have available.