From 491e82eb192b76e7e8eece5aaf43b7aebb81a12d Mon Sep 17 00:00:00 2001 From: Marius Gavrilescu Date: Wed, 19 Mar 2014 14:36:08 +0200 Subject: [PATCH] From Redis to Postgres - Part 2 (Better routes) --- app.psgi | 18 ++++++++++++++++ lib/Gruntmaster/Page/Generic.pm | 36 ++++++++++++++++++++----------- lib/Plack/App/Gruntmaster.pm | 38 ++++++++++++++------------------- tmpl/ct.en | 6 +++--- tmpl/ct_entry.en | 6 +++--- tmpl/log.en | 6 +++--- tmpl/pb.en | 8 +++---- tmpl/pb_entry.en | 6 ++++-- tmpl/st.en | 2 +- tmpl/us.en | 4 ++-- tmpl/us_entry.en | 3 +++ 11 files changed, 80 insertions(+), 53 deletions(-) diff --git a/app.psgi b/app.psgi index b657a9a..2e3f640 100644 --- a/app.psgi +++ b/app.psgi @@ -1,5 +1,6 @@ #!/usr/bin/perl -w use v5.14; +no if $] >= 5.017011, warnings => 'experimental::smartmatch'; use Apache2::Authen::Passphrase qw/pwcheck/; use Apache2::AuthzCaps qw/hascaps/; @@ -49,6 +50,22 @@ sub require_admin { } } +sub mangle_request { + my $app = $_[0]; + sub { + local *__ANON__ = 'mangle_request_middleware'; + my $env = $_[0]; + my ($number, $word) = (qr,(\d+),a, qr,(\w+),a); + for ($env->{PATH_INFO}) { + $env->{'gruntmaster.page'} = $1 if s,/page/$number$,/,; + $env->{'gruntmaster.problem'} = $1 if s,^/pb/$word/,/,; + $env->{'gruntmaster.contest'} = $1 if s,^/ct/$word/,/,; + $env->{'gruntmaster.user'} = $1 if s,^/us/$word/,/,; + } + $app->($env); + } +} + my %authen_cache; sub authenticate { @@ -84,6 +101,7 @@ builder { enable 'Log4perl', category => 'plack'; enable \&require_admin; enable_if \&some_auth_required, 'Auth::Basic', authenticator => \&authenticate, realm => 'Gruntmaster 6000'; + enable \&mangle_request; enable sub { my $app = $_[0]; sub { $_[0]->{'gruntmaster.dbic'} = $db; $app->($_[0]) } }; Plack::App::Gruntmaster->to_app } diff --git a/lib/Gruntmaster/Page/Generic.pm b/lib/Gruntmaster/Page/Generic.pm index 2cb82d9..256add6 100644 --- a/lib/Gruntmaster/Page/Generic.pm +++ b/lib/Gruntmaster/Page/Generic.pm @@ -29,13 +29,13 @@ sub makepkg { } sub list { - my ($thing, $lang, $env, $ct) = @_; + my ($thing, $lang, $env) = @_; my %thing = %$thing; - my $req = Plack::Request->new($env); - debug $env => "Contest is $ct"; - $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')) { + #debug $env => "Contest is $ct"; + $thing{makers} //= sub { db(shift)->resultset($thing{rsname}) }; + my $rs = $thing{makers}->($env); + $rs = $rs->search(undef, {order_by => 'me.id'}) unless $rs->is_ordered; + if (my $page = $env->{'gruntmaster.page'}) { my $pages = $rs->count / PAGE_SIZE; $rs = $rs->search(undef, {offset => ($page - 1) * PAGE_SIZE, ($page == $pages ? () : (rows => PAGE_SIZE))}); } @@ -55,13 +55,11 @@ sub list { } sub entry { - my ($thing, $lang, $env, $id, $ct) = @_; + my ($thing, $lang, $env, $id) = @_; my %thing = %$thing; - ($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{makers} //= sub { db(shift)->resultset($thing{rsname}) }; + my %params = map {+ rs => $_, $_->get_columns } $thing{makers}->($env)->find($id); $thing{mangle}->(local $_ = \%params) if exists $thing{mangle}; wantarray ? %params : \%params } @@ -114,7 +112,13 @@ thing { thing { params qw/pb Problem Problems/; prefetch 'owner'; - makers { my ($db, $ct) = @_; $ct ? $db->contest($ct)->problems : $db->problems->search({private => 0}) }; + makers { + my $env = $_[0]; + my $db = db $env; + return $db->contest($env->{'gruntmaster.contest'})->problems->search(undef, {order_by => 'problem.id'}) if exists $env->{'gruntmaster.contest'}; + return $db->problems->search({owner => $env->{'gruntmaster.user'}}) if exists $env->{'gruntmaster.user'}; + $db->problems->search({private => 0}); + }; sortby { $a->{name} cmp $b->{name}}; group { $_->{level} }; mangle { @@ -142,7 +146,13 @@ thing { thing { params qw/log Job/, 'Job log'; prefetch 'owner', 'problem'; - makers { shift->jobs->search({contest => shift}) }; + makers { + my $env = $_[0]; + my $db = db $env; + return $db->jobs->search({'me.owner' => $env->{'gruntmaster.user'}}) if exists $env->{'gruntmaster.user'}; + return $db->jobs->search({problem => $env->{'gruntmaster.problem'}}) if exists $env->{'gruntmaster.problem'}; + $db->jobs->search({contest => $env->{'gruntmaster.contest'}}) + }; sortby { $b->{id} <=> $a->{id}}; mangle { $_->{results} &&= decode_json $_->{results}; diff --git a/lib/Plack/App/Gruntmaster.pm b/lib/Plack/App/Gruntmaster.pm index 99ce498..5b5f660 100644 --- a/lib/Plack/App/Gruntmaster.pm +++ b/lib/Plack/App/Gruntmaster.pm @@ -56,36 +56,30 @@ sub post { } BEGIN{ - my $word = qr,(\w+),a; - my $ct = qr,(?:\/ct/$word)?,a; + my $word = qr,(\w+),a; + my $number = qr,(\d+),a; sub generic { - my ($thing, $ct, $fs) = @_; - $ct //= '', $fs //= ''; - my $pkg = ucfirst $thing; - get qr,$ct/$thing/, => $pkg; - get qr,$ct/$thing/read, => "${pkg}::Read"; - get qr,$ct/$thing/$word$fs, => "${pkg}::Entry"; -# post qr,$ct/$thing/$word/create, => "${pkg}::Entry::Create"; - get qr,$ct/$thing/$word/read, => "${pkg}::Entry::Read"; -# post qr,$ct/$thing/$word/update, => "${pkg}::Entry::Update"; -# post qr,$ct/$thing/$word/delete, => "${pkg}::Entry::Delete"; + for my $thing (@_) { + my $pkg = ucfirst $thing; + get qr,/$thing/, => $pkg; + get qr,/$thing/read, => "${pkg}::Read"; + get qr,/$thing/$word, => "${pkg}::Entry"; +# post qr,/$thing/$word/create, => "${pkg}::Entry::Create"; + get qr,/$thing/$word/read, => "${pkg}::Entry::Read"; +# post qr,/$thing/$word/update, => "${pkg}::Entry::Update"; +# post qr,/$thing/$word/delete, => "${pkg}::Entry::Delete"; + } } get qr,/css/$word\.css, => 'CSS'; get qr,/js\.js, => 'JS'; - generic 'us'; - generic ct => '', '/'; - generic pb => $ct; - #generic log => $ct; + generic qw/us ct pb log/; - get qr,$ct/log/(\d+)?, => 'Log'; - get qr,$ct/log/st, => 'St'; - get qr,$ct/log/job/$word, => 'Log::Entry'; - get qr,$ct/log/job/$word/read, => 'Log::Entry::Read'; - get qr,$ct/log/src/$word\.$word, => 'Src'; - post qr,$ct/pb/$word/submit, => 'Submit'; + get qr,/log/st, => 'St'; + get qr,/log/src/$number\.$word, => 'Src'; + post qr,/pb/$word/submit, => 'Submit'; post qr,/action/register, => 'Register'; post qr,/action/passwd, => 'Passwd'; diff --git a/tmpl/ct.en b/tmpl/ct.en index 457f3d7..038fef0 100644 --- a/tmpl/ct.en +++ b/tmpl/ct.en @@ -4,7 +4,7 @@ NameStart dateStop dateOwner - + <%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{start}; %> <%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{stop}; %> @@ -18,7 +18,7 @@ NameStart dateStop dateOwner - + <%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{start}; %> <%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{stop}; %> @@ -32,7 +32,7 @@ NameStart dateStop dateOwner - + <%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{start}; %> <%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{stop}; %> diff --git a/tmpl/ct_entry.en b/tmpl/ct_entry.en index af533d6..0ad32c9 100644 --- a/tmpl/ct_entry.en +++ b/tmpl/ct_entry.en @@ -3,6 +3,6 @@ Contest stop time: <%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__-> -Problems
-Job log
-Standings
+Problems
+Job log
+Standings
diff --git a/tmpl/log.en b/tmpl/log.en index 75bb328..1e5b488 100644 --- a/tmpl/log.en +++ b/tmpl/log.en @@ -2,10 +2,10 @@ IDProblemDateSizeUserResult - - + + <%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{date}; %> - data-private><%perl __OUT__ sprintf '%.2fKB', __CURRENT__->{size}/1024; %> + data-private><%perl __OUT__ sprintf '%.2fKB', __CURRENT__->{size}/1024; %> diff --git a/tmpl/pb.en b/tmpl/pb.en index 35cfbd4..fcb23b0 100644 --- a/tmpl/pb.en +++ b/tmpl/pb.en @@ -3,7 +3,7 @@ -
NameAuthorOwner
+
@@ -13,7 +13,7 @@ -
NameAuthorOwner
+
@@ -23,7 +23,7 @@ -
NameAuthorOwner
+
@@ -33,7 +33,7 @@ -
NameAuthorOwner
+
diff --git a/tmpl/pb_entry.en b/tmpl/pb_entry.en index 5656ad9..c707952 100644 --- a/tmpl/pb_entry.en +++ b/tmpl/pb_entry.en @@ -9,9 +9,11 @@
Owner
+Job log +

Submit solution

-
+ @@ -30,4 +32,4 @@
- \ No newline at end of file + diff --git a/tmpl/st.en b/tmpl/st.en index 1b18005..6417f48 100644 --- a/tmpl/st.en +++ b/tmpl/st.en @@ -1,6 +1,6 @@ -
RankUserTotal +
RankUserTotal
RankUserScore diff --git a/tmpl/us.en b/tmpl/us.en index 72c72c3..2b77d08 100644 --- a/tmpl/us.en +++ b/tmpl/us.en @@ -1,2 +1,2 @@ -
- +
+
diff --git a/tmpl/us_entry.en b/tmpl/us_entry.en index 4588e24..69d95da 100644 --- a/tmpl/us_entry.en +++ b/tmpl/us_entry.en @@ -3,3 +3,6 @@
University
Level
+ +Job log
+Owned problems -- 2.39.2