From: Marius Gavrilescu Date: Tue, 18 Mar 2014 21:39:03 +0000 (+0200) Subject: From Redis to Postgres - Part 1 (Getting started) X-Git-Url: http://git.ieval.ro/?a=commitdiff_plain;h=d3200993969efcd4d9c0ce6a5666a012815ad2d5;p=plack-app-gruntmaster.git From Redis to Postgres - Part 1 (Getting started) --- diff --git a/app.psgi b/app.psgi index 4f4526b..b657a9a 100644 --- a/app.psgi +++ b/app.psgi @@ -15,6 +15,7 @@ use constant CONTENT_SECURITY_POLICY => q,default-src 'none'; script-src 'self' $Apache2::AuthzCaps::rootdir = $Apache2::Authen::Passphrase::rootdir; my $word = qr,(\w+),a; +my $db = Gruntmaster::Data->connect('dbi:Pg:'); sub debug { local $Log::Log4perl::caller_depth = $Log::Log4perl::caller_depth + 1; @@ -24,20 +25,17 @@ sub debug { sub some_auth_required { my $r = Plack::Request->new($_[0]); return 1 if $_[0]->{'gruntmaster.reqadmin'} || $r->path eq '/action/passwd' || $r->path =~ m,/pb/$word/submit$,; - return 1 if $r->path =~ m,^/ct/$word/pb/$word, && time < contest_end $1; - 0 + return 1 if $r->path =~ m,^/ct/$word/pb/$word, && time < $db->contest($1)->stop; + '' } sub admin_required { local $_ = $_[0]; - return problem_owner $1 if m,^/pb/$word, && problem_private $1; - return job_user $1 if m,^/log/(?:job|src)/$word, && job_private $1; - return contest_owner $1 if m,^/ct/$word/(?:pb|log), && time < contest_start $1; - if (m,^/ct/$word/log/(?:job|src)/$word, && time < contest_end $1){ - local $Gruntmaster::Data::contest = $1; - return job_user $2; - } - 0 + return $db->problem($1)->owner if m,^/pb/$word, && $db->problem($1)->private; + return $db->job ($1)->owner if m,^/log/(?:job|src)/$word, && $db->job($1)->private; + return $db->contest($1)->owner if m,^/ct/$word/(?:pb|log), && time < $db->contest($1)->start; + return $db->job ($2)->owner if m,^/ct/$word/log/(?:job|src)/$word, && time < $db->contest($1)->stop; + '' } sub require_admin { @@ -86,5 +84,6 @@ builder { enable 'Log4perl', category => 'plack'; enable \&require_admin; enable_if \&some_auth_required, 'Auth::Basic', authenticator => \&authenticate, realm => 'Gruntmaster 6000'; + enable sub { my $app = $_[0]; sub { $_[0]->{'gruntmaster.dbic'} = $db; $app->($_[0]) } }; Plack::App::Gruntmaster->to_app } diff --git a/lib/Gruntmaster/Page/Base.pm b/lib/Gruntmaster/Page/Base.pm index 4ba905b..0cae932 100644 --- a/lib/Gruntmaster/Page/Base.pm +++ b/lib/Gruntmaster/Page/Base.pm @@ -32,7 +32,6 @@ sub footer{ ################################################## use POSIX (); -use Gruntmaster::Data (); use List::Util (); use LWP::UserAgent; use Plack::Request (); @@ -50,7 +49,6 @@ sub import_to { feature->import(':5.14'); warnings->import; File::Slurp->export_to_level(1, $caller, qw/read_file/); - Gruntmaster::Data->export_to_level(1, $caller); List::Util->export_to_level(1, $caller, qw/sum/); no strict 'refs'; @@ -61,6 +59,7 @@ sub import_to { local $Log::Log4perl::caller_depth = $Log::Log4perl::caller_depth + 1; $_[0]->{'psgix.logger'}->({qw/level debug message/ => $_[1]}) }; + *{"${caller}::db"} = sub { $_[0]->{'gruntmaster.dbic'} }; *{"${caller}::reply"} = sub { [200, ['Content-Type' => 'text/plain', 'Cache-Control' => 'no-cache'], [ @_ ] ] }; *{"${caller}::purge"} = sub { return unless $ENV{PURGE_HOST}; diff --git a/lib/Gruntmaster/Page/Generic.pm b/lib/Gruntmaster/Page/Generic.pm index e31740d..2cb82d9 100644 --- a/lib/Gruntmaster/Page/Generic.pm +++ b/lib/Gruntmaster/Page/Generic.pm @@ -5,19 +5,17 @@ use strict; use warnings; our $VERSION = '5999.000_001'; -use Gruntmaster::Data; use Gruntmaster::Page::Base; use JSON qw/encode_json decode_json/; +use Plack::Request; +use Sub::Name qw/subname/; -sub hgetall { - my $hash = shift; - my $cp = $Gruntmaster::Data::contest ? "contest.$Gruntmaster::Data::contest." : ''; - map { { id => $_, HGETALL "$cp$hash.$_" } } SMEMBERS "$cp$hash" -} +use constant PAGE_SIZE => 10; sub putsym { my ($key, $value) = @_; no strict 'refs'; + subname $key => $value if ref $value eq 'CODE'; *{"$key"} = $value; } @@ -33,10 +31,16 @@ sub makepkg { sub list { my ($thing, $lang, $env, $ct) = @_; my %thing = %$thing; - undef $ct unless $thing{contest}; + my $req = Plack::Request->new($env); debug $env => "Contest is $ct"; - local $Gruntmaster::Data::contest = $ct if $ct; - my @thing = hgetall $thing{hash}; + $thing{makers} //= sub { shift->resultset($thing{rsname}) }; + my $rs = $thing{makers}->(db $env)->search(undef, {order_by => 'me.id'}); + if (my $page = $req->param('page')) { + my $pages = $rs->count / PAGE_SIZE; + $rs = $rs->search(undef, {offset => ($page - 1) * PAGE_SIZE, ($page == $pages ? () : (rows => PAGE_SIZE))}); + } + $rs = $rs->search(undef, {prefetch => $thing{prefetch}}) if exists $thing{prefetch}; + my @thing = map +{rs => $_, $_->get_columns}, $rs->all; @thing = map { $thing{mangle}->(); $_ } @thing if exists $thing{mangle}; @thing = grep { $thing{choose}->() } @thing if exists $thing{choose}; @thing = sort { $thing{sortby}->() } @thing if exists $thing{sortby}; @@ -53,10 +57,11 @@ sub list { sub entry { my ($thing, $lang, $env, $id, $ct) = @_; my %thing = %$thing; - ($id, $ct) = ($ct, $id) if $thing{contest}; - local $Gruntmaster::Data::contest = $ct if $ct; - debug $env => "Hash is $thing{hash} and id is $id"; - my %params = HGETALL "$thing{hash}.$id"; + ($id, $ct) = ($ct, $id) if $ct; + debug $env => "Rsname is $thing{rsname} and id is $id"; + $thing{makers} //= sub { shift->resultset($thing{rsname}) }; + my %params = map {+ rs => $_, $_->get_columns } $thing{makers}->(db $env)->find($id); + $params{contest} = $ct if $ct; $thing{mangle}->(local $_ = \%params) if exists $thing{mangle}; wantarray ? %params : \%params } @@ -75,21 +80,23 @@ sub create_thing { } sub params; -sub contest; +sub makers (&); sub choose (&); sub sortby (&); sub group (&); sub mangle (&); +sub prefetch; sub thing (&){ my %thing; no strict 'refs'; - local *{"params"} = sub { @thing{qw/id hash title/} = @_ }; + local *{"params"} = sub { @thing{qw/id rsname title/} = @_ }; local *{"choose"} = sub { $thing{choose} = shift }; local *{"sortby"} = sub { $thing{sortby} = shift }; local *{"mangle"} = sub { $thing{mangle} = shift }; local *{"group"} = sub { $thing{group} = shift }; - local *{"contest"} = sub { $thing{contest} = 1 }; + local *{"makers"} = sub { $thing{makers} = shift }; + local *{"prefetch"} = sub { $thing{prefetch} = \@_ }; use strict 'refs'; shift->(); @@ -99,30 +106,54 @@ sub thing (&){ ################################################## thing { - params qw/us user Users/; + params qw/us User Users/; choose { $_->{name} =~ /\w/ }; sortby { lc $a->{name} cmp lc $b->{name} }; }; thing { - params qw/pb problem Problems/; - contest; - sortby { $a->{name} cmp $b->{name} }; + params qw/pb Problem Problems/; + prefetch 'owner'; + makers { my ($db, $ct) = @_; $ct ? $db->contest($ct)->problems : $db->problems->search({private => 0}) }; + sortby { $a->{name} cmp $b->{name}}; group { $_->{level} }; - mangle { $_->{owner_name} = do { local $Gruntmaster::Data::contest; user_name $_->{owner} } } + mangle { + my $env = shift; + $_->{owner_name} = $_->{rs}->owner->name; + $_->{cansubmit} = $_->{contest} ? time < $_->{rs}->contest->stop : 1; + eval { + db($env)->open->create({ + contest => $_->{contest}, + problem => $_->{id}, + owner => $env->{REMOTE_USER}, + }) + } if $_->{contest} && time >= $_->{rs}->contest->start; + }; }; thing { - params qw/ct contest Contests/; + params qw/ct Contest Contests/; + prefetch 'owner'; sortby { $b->{start} <=> $a->{start} }; - group { time < $_->{start} ? 'pending' : time > $_->{end} ? 'finished' : 'running' }; - mangle { $_->{started} = time >= $_->{start}; $_->{owner_name} = do { local $Gruntmaster::Data::contest; user_name $_->{owner} } }; + group { time < $_->{start} ? 'pending' : time > $_->{stop} ? 'finished' : 'running' }; + mangle { $_->{started} = time >= $_->{start}; $_->{owner_name} = $_->{rs}->owner->name }; }; thing { - params qw/log job/, 'Job log'; - contest; - mangle { $_->{results} &&= decode_json $_->{results}; $_->{user_name} = do { local $Gruntmaster::Data::contest; user_name $_->{user} } } + params qw/log Job/, 'Job log'; + prefetch 'owner', 'problem'; + makers { shift->jobs->search({contest => shift}) }; + sortby { $b->{id} <=> $a->{id}}; + mangle { + $_->{results} &&= decode_json $_->{results}; + $_->{owner_name} = $_->{rs}->owner->name; + $_->{problem_name} = $_->{rs}->problem->name; + $_->{size} = length $_->{source}; + delete $_->{source}; + } }; +putsym 'Gruntmaster::Page::Pb::Entry::vary', sub { 'Authorization' }; +putsym 'Gruntmaster::Page::Pb::Entry::max_age', sub { 600 }; + 1 diff --git a/lib/Gruntmaster/Page/Log.pm b/lib/Gruntmaster/Page/Log.pm deleted file mode 100644 index 6848bcf..0000000 --- a/lib/Gruntmaster/Page/Log.pm +++ /dev/null @@ -1,35 +0,0 @@ -package Gruntmaster::Page::Log; - -use Gruntmaster::Page::Base log => 'Job log'; - -use constant PAGE_SIZE => 10; - -sub _generate{ - my ($self, $htc, $lang, $env, $ct, $page) = @_; - debug $env => "language is '$lang', contest is '$ct' and page is '$page'"; - local $Gruntmaster::Data::contest = $ct if $ct; - - my $pages = POSIX::floor (jobcard / PAGE_SIZE); - $pages ||= 1; - $page ||= $pages; - - my @log = sort { $b->{id} <=> $a->{id} } map +{ - id => $_, - (job_private() ? (private => job_private) : ()), - date => (job_date() ? strftime ('%c' => localtime job_date) : '?'), - extension => job_extension, - name => problem_name job_problem, - problem => job_problem, - result => job_result, - result_text => job_result_text, - size => sprintf ("%.2f KiB", job_filesize() / 1024), - user => job_user}, ($page - 1) * PAGE_SIZE + 1 .. ($page == $pages ? jobcard : $page * PAGE_SIZE); - $_->{user_name} = do { local $Gruntmaster::Data::contest; user_name $_->{user} } for @log; - $htc->param(log => \@log); - $htc->param(next => $page + 1) unless $page == $pages; - $htc->param(prev => $page - 1) unless $page == 1; -} - -sub max_age { 5 } - -1 diff --git a/lib/Gruntmaster/Page/Pb/Entry.pm b/lib/Gruntmaster/Page/Pb/Entry.pm deleted file mode 100644 index 12f5e74..0000000 --- a/lib/Gruntmaster/Page/Pb/Entry.pm +++ /dev/null @@ -1,35 +0,0 @@ -package Gruntmaster::Page::Pb::Entry; - -use Gruntmaster::Page::Base pb_entry => ''; - -use constant FORMATS => [qw/C CPP JAVA PERL PYTHON/]; - -sub _generate{ - my ($self, $htc, $lang, $env, $contest, $id) = @_; - debug $env => "language is '$lang', contest is '$contest', id is '$id'"; - my $user = $env->{REMOTE_USER}; - if ($contest && $user && time >= contest_start $contest) { - local $Gruntmaster::Data::contest = $contest; - mark_open $id, $user; - debug $env => "Marking problem $id of contest $contest open by $user"; - } - - $htc->param(cansubmit => 1); - if ($contest) { - $htc->param(cansubmit => time <= contest_end $contest); - $htc->param(contest => $contest); - } - $htc->param(formats => FORMATS); - $htc->param(id => $id); - local $Gruntmaster::Data::contest = $contest if $contest; - $htc->param(name => problem_name $id); - $htc->param(author => problem_author $id); - $htc->param(owner => problem_owner $id); - $htc->param(owner_name => do{ local $Gruntmaster::Data::contest; user_name $htc->param('owner')} ); - $htc->param(statement => problem_statement $id); -} - -sub vary { 'Authorization' } -sub max_age { 600 } - -1 diff --git a/lib/Gruntmaster/Page/Register.pm b/lib/Gruntmaster/Page/Register.pm index be1d4be..ed25660 100644 --- a/lib/Gruntmaster/Page/Register.pm +++ b/lib/Gruntmaster/Page/Register.pm @@ -14,7 +14,7 @@ sub generate{ return reply 'All fields are required' if grep { !length } $username, $password, $confirm_password, $name, $email, $phone, $town, $university, $level; pwset $username, $password; - insert_user $username, name => $name, email => $email, phone => $phone, town => $town, university => $university, level => $level; + db($env)->create({id => $username, name => $name, email => $email, phone => $phone, town => $town, university => $university, level => $level}); purge "/us/"; reply 'Registered successfully'; diff --git a/lib/Gruntmaster/Page/Src.pm b/lib/Gruntmaster/Page/Src.pm index 8f9ab1b..e54e79f 100644 --- a/lib/Gruntmaster/Page/Src.pm +++ b/lib/Gruntmaster/Page/Src.pm @@ -15,9 +15,8 @@ use constant CONTENT_TYPES => +{ sub generate{ my ($self, $format, $env, $ct, $job, $ext) = @_; debug $env => "Contest is $ct, job is $job and extension is $ext"; - local $Gruntmaster::Data::contest = $ct if $ct; - [200, ['Content-Type' => CONTENT_TYPES->{$ext}, 'Cache-Control' => 'max-age=604800', 'X-Forever' => 1], [job_inmeta($job)->{files}{prog}{content}] ] + [200, ['Content-Type' => CONTENT_TYPES->{$ext}, 'Cache-Control' => 'max-age=604800', 'X-Forever' => 1], [db($env)->job($job)->source] ] } 1 diff --git a/lib/Gruntmaster/Page/St.pm b/lib/Gruntmaster/Page/St.pm index 22d6e30..2d7b238 100644 --- a/lib/Gruntmaster/Page/St.pm +++ b/lib/Gruntmaster/Page/St.pm @@ -10,13 +10,11 @@ use constant LEVEL_VALUES => { }; sub calc_score{ - my ($user, $problem, $date, $tries, $totaltime) = @_; - my $mxscore = LEVEL_VALUES->{problem_level($problem)}; + my ($mxscore, $time, $tries, $totaltime) = @_; my $score = $mxscore; - my $timetaken = $date - get_open($problem, $user); - $timetaken = 0 if $timetaken < 0; - $timetaken = 300 if $timetaken > $totaltime; - $score = ($totaltime - $timetaken) / $totaltime * $score; + $time = 0 if $time < 0; + $time = 300 if $time > $totaltime; + $score = ($totaltime - $time) / $totaltime * $score; $score -= $tries / 10 * $mxscore; $score = $mxscore * 3 / 10 if $score < $mxscore * 3 / 10; int $score + 0.5 @@ -25,45 +23,38 @@ sub calc_score{ sub _generate{ my ($self, $htc, $lang, $env, $ct) = @_; debug $env => "language is '$lang' and contest is '$ct'"; - my ($totaltime, $start); - local $Gruntmaster::Data::contest; - if ($ct) { - $start = contest_start ($ct); - $totaltime = contest_end ($ct) - $start; - $Gruntmaster::Data::contest = $ct; - } + $ct &&= db($env)->contest($ct); - my @problems = problems; - @problems = sort @problems; + my @problems = map { $_->problem } db($env)->contest_problems->search({contest => $ct->id}, {qw/join problem order_by problem.level/}); my (%scores, %tries); - for (1 .. jobcard) { - next unless defined job_user && defined job_problem && defined job_result; - next if $Gruntmaster::Data::contest && job_date() < $start; - - if ($Gruntmaster::Data::contest) { - $scores{job_user()}{job_problem()} = job_result() ? 0 : calc_score (job_user(), job_problem(), job_date(), $tries{job_user()}{job_problem()}, $totaltime); - $tries{job_user()}{job_problem()}++; + for my $job (db($env)->jobs->search({contest => $ct->id})) { + + if ($ct) { + my $time = $job->date - $ct->start; + next if $time < 0; + my $value = $job->problem->value // LEVEL_VALUES->{$job->problem->level}; + $scores{$job->owner->id}{$job->problem->id} = $job->result ? 0 : calc_score ($value, $time, $tries{$job->owner}{$job->problem}, $ct->stop - $ct->start); + $tries{$job->owner->id}{$job->problem->id}++; } else { no warnings 'numeric'; - $scores{job_user()}{job_problem()} = 0 + job_result_text() || (job_result() ? 0 : 100) + $scores{$job->owner->id}{$job->problem->id} = 0 + $job->result_text || ($job->result ? 0 : 100) } } my @st = sort { $b->{score} <=> $a->{score} or $a->{user} cmp $b->{user}} map { my $user = $_; +{ - user => $user, - name => do {local $Gruntmaster::Data::contest; user_name $user}, + user => db($env)->user($user), score => sum (values $scores{$user}), - scores => [map { $scores{$user}{$_} // '-'} @problems], - problems => $Gruntmaster::Data::contest, + scores => [map { $scores{$user}{$_->id} // '-'} @problems], + problems => $ct, } } keys %scores; $st[0]->{rank} = 1; $st[$_]->{rank} = $st[$_ - 1]->{rank} + ($st[$_]->{score} < $st[$_ - 1]->{score}) for 1 .. $#st; - $htc->param(problems => [map { problem_name } @problems ]) if $Gruntmaster::Data::contest; + $htc->param(problems => \@problems) if $ct; $htc->param(st => \@st); } diff --git a/lib/Gruntmaster/Page/Submit.pm b/lib/Gruntmaster/Page/Submit.pm index 535a536..5eed07c 100644 --- a/lib/Gruntmaster/Page/Submit.pm +++ b/lib/Gruntmaster/Page/Submit.pm @@ -22,36 +22,25 @@ sub generate{ $prog = $temp if $temp } die if defined $contest && $contest !~ /^\w+$/ ; - die if defined $contest && (time > contest_end $contest); + die if defined $contest && (time > db($env)->contest($contest)->stop); return reply 'A required parameter was not supplied' if grep { !defined } $problem, $format, $prog; return reply 'Maximum source size is 10KB' if length $prog > 25 * 1024; - return reply 'You must wait 30 seconds between jobs' unless time > user_lastjob ($r->user) + 30; - set_user_lastjob $r->user, time; + return reply 'You must wait 30 seconds between jobs' unless time > db($env)->user($r->user)->lastjob + 30; + db($env)->user($r->user)->lastjob(time)->update; - local $Gruntmaster::Data::contest = $contest if $contest; - - my $job = push_job ( + db($env)->jobs->create({ + defined $contest ? (contest => $contest) : (), date => time, - problem => $problem, - user => $r->user, - defined $private ? (private => $private) : (), - defined $contest ? (contest => $contest, private => 1) : (), - filesize => length $prog, extension => FORMAT_EXTENSION->{$format}, - ); - - set_job_inmeta $job, { - files => { - prog => { - format => $format, - name => 'prog.' . FORMAT_EXTENSION->{$format}, - content => $prog, - } - } - }; + format => $format, + defined $private ? (private => $private) : (), + probem => $problem, + source => $prog, + user => $r->user + }); $contest //= ''; - PUBLISH 'jobs', "$contest.$job"; + #PUBLISH 'jobs', "$contest.$job"; [303, [Location => $r->path =~ s,/pb/\w+/submit$,/log/,r], ['']] } diff --git a/lib/Plack/App/Gruntmaster.pm b/lib/Plack/App/Gruntmaster.pm index eae9a06..99ce498 100644 --- a/lib/Plack/App/Gruntmaster.pm +++ b/lib/Plack/App/Gruntmaster.pm @@ -10,8 +10,6 @@ our $VERSION = '5999.000_001'; use File::Slurp qw/read_file/; use HTTP::Negotiate qw/choose/; use Plack::Request; -use Gruntmaster::Page::Log; -use Gruntmaster::Page::Pb::Entry; use Gruntmaster::Page::Generic; my %handlers; diff --git a/tmpl/ct.en b/tmpl/ct.en index 55e8392..457f3d7 100644 --- a/tmpl/ct.en +++ b/tmpl/ct.en @@ -2,25 +2,25 @@

Running contests

-
NameStart dateEnd dateOwner +
NameStart dateStop dateOwner
<%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{start}; %> -<%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{end}; %> +<%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{stop}; %>
- -

Pending contests

+ +

Pstoping contests

- -
NameStart dateEnd dateOwner +
NameStart dateStop dateOwner
+
<%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{start}; %> -<%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{end}; %> +<%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{stop}; %>
@@ -30,11 +30,11 @@

Finished contests

-
NameStart dateEnd dateOwner +
NameStart dateStop dateOwner
<%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{start}; %> -<%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{end}; %> +<%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{stop}; %>
diff --git a/tmpl/ct_entry.en b/tmpl/ct_entry.en index a53bf41..af533d6 100644 --- a/tmpl/ct_entry.en +++ b/tmpl/ct_entry.en @@ -1,5 +1,5 @@ Contest start time: <%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{start}; %>
-Contest end time: <%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{end}; %>

+Contest stop time: <%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{stop}; %>

diff --git a/tmpl/log.en b/tmpl/log.en index 2179172..75bb328 100644 --- a/tmpl/log.en +++ b/tmpl/log.en @@ -3,10 +3,11 @@ IDProblemDateSizeUserResult - - - data-private> - + +<%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{date}; %> + data-private><%perl __OUT__ sprintf '%.2fKB', __CURRENT__->{size}/1024; %> + + diff --git a/tmpl/pb_entry.en b/tmpl/pb_entry.en index cccb33a..5656ad9 100644 --- a/tmpl/pb_entry.en +++ b/tmpl/pb_entry.en @@ -18,8 +18,13 @@

+ + + + + + + diff --git a/tmpl/st.en b/tmpl/st.en index 2b531c1..1b18005 100644 --- a/tmpl/st.en +++ b/tmpl/st.en @@ -1,11 +1,11 @@ - -
RankUserTotal +
RankUserTotal
RankUserScore
+