Move display mangling to templates, add read API
authorMarius Gavrilescu <marius@ieval.ro>
Sun, 23 Feb 2014 09:47:46 +0000 (11:47 +0200)
committerMarius Gavrilescu <marius@ieval.ro>
Sun, 23 Feb 2014 09:47:46 +0000 (11:47 +0200)
lib/Gruntmaster/Page/Base.pm
lib/Gruntmaster/Page/Generic.pm
lib/Plack/App/Gruntmaster.pm
tmpl/ct.en
tmpl/ct_entry.en
tmpl/log_entry.en

index cffb656564e21c835ede46c38866335c3e21e52f..84d74510638108fd11117d166353bb883270dda0 100644 (file)
@@ -86,7 +86,7 @@ sub import {
 sub generate{
        my ($self, $lang, @args) = @_;
 
-       my $htc = HTML::Template::Compiled->new(scalarref => \$templates{$self}{$lang}, default_escape => 'HTML',);
+       my $htc = HTML::Template::Compiled->new(scalarref => \$templates{$self}{$lang}, default_escape => 'HTML', use_perl => 1);
        $self->_generate($htc, $lang, @args);
        my $out = $htc->output;
        utf8::downgrade($out);
index 9e097c052737e053f6a980a5972e7d3cc9e41d31..95d1cd8cac6f791d0a73a49ea9f507a6850bcd9c 100644 (file)
@@ -30,49 +30,48 @@ sub makepkg {
        1
 }
 
-sub make_generate {
-       my %thing = @_;
-       sub {
-               my ($self, $htc, $lang, $env, $ct) = @_;
-               undef $ct unless $thing{contest};
-               debug $env => "Contest is $ct";
-               local $Gruntmaster::Data::contest = $ct if $ct;
-               my @thing = hgetall $thing{hash};
-               @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};
-               my %params;
-               $thing{group} //= sub { $thing{id} };
-               for (@thing) {
-                       my $group = $thing{group}->();
-                       $params{$group} //= [];
-                       push $params{$group}, $_
-               }
-               $htc->param(%params);
+sub list {
+       my ($thing, $lang, $env, $ct) = @_;
+       my %thing = %$thing;
+       undef $ct unless $thing{contest};
+       debug $env => "Contest is $ct";
+       local $Gruntmaster::Data::contest = $ct if $ct;
+       my @thing = hgetall $thing{hash};
+       @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};
+       my %params;
+       $thing{group} //= sub { $thing{id} };
+       for (@thing) {
+               my $group = $thing{group}->();
+               $params{$group} //= [];
+               push $params{$group}, $_
        }
+       wantarray ? %params : \%params
 }
 
-sub make_entry_generate{
-       my %thing = @_;
-       sub {
-               my ($self, $htc, $lang, $env, $id, $ct) = @_;
-               ($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";
-               $thing{mangle}->(local $_ = \%params) if exists $thing{mangle};
-               %params = (%params, $thing{hook}->(local $_ = \%params)) if exists $thing{hook};
-               $htc->param(%params);
-       }
+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";
+       $thing{mangle}->(local $_ = \%params) if exists $thing{mangle};
+       wantarray ? %params : \%params
 }
 
+sub headers ($) { ['Content-Type' => 'application/json', 'Cache-Control' => 'max-age=' . $_[0]->max_age] }
+
 sub create_thing {
        my %thing = @_;
        my $ucid = ucfirst $thing{id};
        my $pkg = "Gruntmaster::Page::$ucid";
 
-       putsym "${pkg}::_generate", make_generate %thing if makepkg $pkg, @thing{qw/id title/};
-       putsym "${pkg}::Entry::_generate", make_entry_generate %thing if makepkg "${pkg}::Entry", "$thing{id}_entry", '<tmpl_var name>';
+       putsym "${pkg}::_generate", sub { $_[1]->param(list \%thing, @_[2..$#_]) } if makepkg $pkg, @thing{qw/id title/};
+       putsym "${pkg}::Entry::_generate",  sub { $_[1]->param(entry \%thing, @_[2..$#_]) } if makepkg "${pkg}::Entry", "$thing{id}_entry", '<tmpl_var name>';
+       putsym "${pkg}::Read::generate", sub { [200, headers shift, [encode_json list \%thing, @_]] } if makepkg "${pkg}::Read";
+       putsym "${pkg}::Entry::Read::generate", sub { [200, headers shift, [encode_json entry \%thing, @_]] } if makepkg "${pkg}::Entry::Read";
 }
 
 sub params;
@@ -81,7 +80,6 @@ sub choose (&);
 sub sortby (&);
 sub group  (&);
 sub mangle (&);
-sub hook   (&);
 
 sub thing (&){
        my %thing;
@@ -92,7 +90,6 @@ sub thing (&){
        local *{"mangle"} = sub { $thing{mangle} = shift };
        local *{"group"} = sub { $thing{group} = shift };
        local *{"contest"} = sub { $thing{contest} = 1 };
-       local *{"hook"} = sub { $thing{hook} = shift };
        use strict 'refs';
 
        shift->();
@@ -116,22 +113,15 @@ thing {
 
 thing {
        params qw/ct contest Contests/;
-       mangle {
-               $_->{start} = strftime '%c', localtime $_->{start};
-               $_->{end} = strftime '%c', localtime $_->{end};
-       };
        sortby { $a->{start} <=> $b->{start} };
        group { time < $_->{start} ? 'pending' : time > $_->{end} ? 'finished' : 'running' };
-       hook { started => time >= $_->{start} };
+       mangle { $_->{started} = time >= $_->{start} };
 };
 
 thing {
        params qw/log job/, 'Job log';
        contest;
-       mangle {
-               $_->{results} &&= decode_json $_->{results};
-               $_->{time} = sprintf "%.4fs", $_->{time} for values ($_->{results} // [])
-       }
+       mangle { $_->{results} &&= decode_json $_->{results}; }
 };
 
 1
index 131b7542bcf99f7ded495590527392bcdf6dff5f..f3da5719fe584be22e0c3600ae9307ffe29e0e8a 100644 (file)
@@ -61,20 +61,33 @@ BEGIN{
        my $word = qr,(\w+),a;
        my $ct = qr,(?:\/ct/$word)?,a;
 
+       sub generic {
+               my ($thing, $ct, $fs) = @_;
+               $ct //= '', $fs //= '';
+               my $pkg = ucfirst $thing;
+               get qr,$ct/$thing/, => $pkg;
+               get qr,$ct/$thing/$word$fs, => "${pkg}::Entry";
+
+               get  qr,$ct/$thing/read,         => "${pkg}::Read";
+#              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";
+       }
+
        get qr,/css/$word\.css, => 'CSS';
        get qr,/js\.js, => 'JS';
 
-       get qr,/ct/, => 'Ct';
-       get qr,/ct/$word/, => 'Ct::Entry';
-       get qr,/us/, => 'Us';
-       get qr,/us/$word, => 'Us::Entry';
+       generic 'us';
+       generic ct => '', '/';
+       generic pb => $ct;
+       #generic log => $ct;
 
        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';
-       get qr,$ct/pb/, => 'Pb';
-       get qr,$ct/pb/$word, => 'Pb::Entry';
        post qr,$ct/pb/$word/submit, => 'Submit';
 
        post qr,/action/register, => 'Register';
index ab10185f323703859f27c4eca5500d4aeebc206c..045bf741e6653794ec120c048d67a969b5595834 100644 (file)
@@ -5,8 +5,8 @@
 <tr><th>Name<th>Start date<th>End date<th>Owner
 <tbody>
 <tmpl_loop running><tr><td><a href="<tmpl_var id>/"><tmpl_var name></a>
-<td><tmpl_var start>
-<td><tmpl_var end>
+<td><%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{start}; %>
+<td><%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{end};   %>
 <td><tmpl_var owner>
 </tmpl_loop>
 </table>
@@ -19,8 +19,8 @@
 <tr><th>Name<th>Start date<th>End date<th>Owner
 <tbody>
 <tmpl_loop pending><tr><td><a href="<tmpl_var id>/"><tmpl_var name></a>
-<td><tmpl_var start>
-<td><tmpl_var end>
+<td><%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{start}; %>
+<td><%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{end};   %>
 <td><tmpl_var owner>
 </tmpl_loop>
 </table>
@@ -33,8 +33,8 @@
 <tr><th>Name<th>Start date<th>End date<th>Owner
 <tbody>
 <tmpl_loop finished><tr><td><a href="<tmpl_var id>/"><tmpl_var name></a>
-<td><tmpl_var start>
-<td><tmpl_var end>
+<td><%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{start}; %>
+<td><%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{end};   %>
 <td><tmpl_var owner>
 </tmpl_loop>
 </table>
index 14ac48e608fd2f985abebb17b6930435ba86300c..f95f345ad12b43eb32f501308aa272b6eccc6bd9 100644 (file)
@@ -1,5 +1,5 @@
-Contest start time: <tmpl_var start><br>
-Contest end time: <tmpl_var end><p>
+Contest start time: <%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{start}; %><br>
+Contest end time:   <%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{end};   %><p>
 
 <tmpl_if started><a href="pb/">Problems</a><br>
 <a href="log/">Job log</a><br>
index 35725c7feb0f0c08b5eca57dfb019898f5557905..adf6bfde3df7f1e85d98fc314bd19b23f178e7c7 100644 (file)
@@ -9,7 +9,7 @@
 <thead>
 <tr><th>Test number<th>Result<th>Time
 <tbody>
-<tmpl_loop results><tr><td><tmpl_var id><td class="r<tmpl_var result>"><tmpl_var result_text><td><tmpl_var time>
+<tmpl_loop results><tr><td><tmpl_var id><td class="r<tmpl_var result>"><tmpl_var result_text><td><%perl __OUT__ sprintf "%.4fs", __CURRENT__->{time}; %>
 </tmpl_loop>
 </table>
 </tmpl_if>
\ No newline at end of file
This page took 0.018435 seconds and 4 git commands to generate.