From 81cce380bd7f2ab58bb497ef748b7568968ea05d Mon Sep 17 00:00:00 2001 From: Marius Gavrilescu Date: Sun, 23 Feb 2014 11:47:46 +0200 Subject: [PATCH] Move display mangling to templates, add read API --- lib/Gruntmaster/Page/Base.pm | 2 +- lib/Gruntmaster/Page/Generic.pm | 78 ++++++++++++++------------------- lib/Plack/App/Gruntmaster.pm | 25 ++++++++--- tmpl/ct.en | 12 ++--- tmpl/ct_entry.en | 4 +- tmpl/log_entry.en | 2 +- 6 files changed, 63 insertions(+), 60 deletions(-) diff --git a/lib/Gruntmaster/Page/Base.pm b/lib/Gruntmaster/Page/Base.pm index cffb656..84d7451 100644 --- a/lib/Gruntmaster/Page/Base.pm +++ b/lib/Gruntmaster/Page/Base.pm @@ -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); diff --git a/lib/Gruntmaster/Page/Generic.pm b/lib/Gruntmaster/Page/Generic.pm index 9e097c0..95d1cd8 100644 --- a/lib/Gruntmaster/Page/Generic.pm +++ b/lib/Gruntmaster/Page/Generic.pm @@ -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", ''; + 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", ''; + 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 diff --git a/lib/Plack/App/Gruntmaster.pm b/lib/Plack/App/Gruntmaster.pm index 131b754..f3da571 100644 --- a/lib/Plack/App/Gruntmaster.pm +++ b/lib/Plack/App/Gruntmaster.pm @@ -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'; diff --git a/tmpl/ct.en b/tmpl/ct.en index ab10185..045bf74 100644 --- a/tmpl/ct.en +++ b/tmpl/ct.en @@ -5,8 +5,8 @@ NameStart dateEnd dateOwner - - +<%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{start}; %> +<%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{end}; %> @@ -19,8 +19,8 @@ NameStart dateEnd dateOwner - - +<%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{start}; %> +<%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{end}; %> @@ -33,8 +33,8 @@ NameStart dateEnd dateOwner - - +<%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{start}; %> +<%perl __OUT__ POSIX::strftime '%c', localtime __CURRENT__->{end}; %> diff --git a/tmpl/ct_entry.en b/tmpl/ct_entry.en index 14ac48e..f95f345 100644 --- a/tmpl/ct_entry.en +++ b/tmpl/ct_entry.en @@ -1,5 +1,5 @@ -Contest start time:
-Contest end time:

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

Problems
Job log
diff --git a/tmpl/log_entry.en b/tmpl/log_entry.en index 35725c7..adf6bfd 100644 --- a/tmpl/log_entry.en +++ b/tmpl/log_entry.en @@ -9,7 +9,7 @@ Test numberResultTime - +<%perl __OUT__ sprintf "%.4fs", __CURRENT__->{time}; %> \ No newline at end of file -- 2.39.2