X-Git-Url: http://git.ieval.ro/?p=gruntmaster-page.git;a=blobdiff_plain;f=lib%2FPlack%2FApp%2FGruntmaster.pm;h=3c26ecfd0cbd69a9151fdb0ece3037eb60193be6;hp=3c989ac10fe533058e1b3d12bcf219d68d7ffcb3;hb=3b69df7a785bbfc5b8c4a1719c046f9800aa3548;hpb=594d53ba258320b2b98ec4413a808366237f5e40 diff --git a/lib/Plack/App/Gruntmaster.pm b/lib/Plack/App/Gruntmaster.pm index 3c989ac..3c26ecf 100644 --- a/lib/Plack/App/Gruntmaster.pm +++ b/lib/Plack/App/Gruntmaster.pm @@ -4,53 +4,24 @@ use 5.014000; use strict; our $VERSION = '5999.000_001'; -use Apache2::Authen::Passphrase qw/pwcheck pwset/; use CSS::Minifier::XS; +use Encode qw/encode decode/; use File::Slurp qw/read_file/; use JavaScript::Minifier::XS; - -use HTML::Template::Compiled; +use JSON::MaybeXS qw/encode_json/; use PerlX::Maybe; use Scope::Upper qw/unwind SUB UP/; +use Web::Simple; use Gruntmaster::Data; -use Web::Simple; -no warnings FATAL => 'all'; -use warnings; -no warnings::illegalproto; +use Plack::App::Gruntmaster::HTML; + +use warnings NONFATAL => 'all'; +no warnings 'illegalproto'; no if $] >= 5.017011, warnings => 'experimental::smartmatch'; ################################################## -sub read_templates { - my $name = shift; - - my %tmpl = map { m/\.(.+)$/; $1 => scalar read_file $_ } ; - my %arti = map { m/\.(.+)$/; $1 => scalar read_file $_ } ; - return %tmpl ? %tmpl : %arti -} - -my %header_templates = read_templates 'header'; -my %footer_templates = read_templates 'footer'; -my %templates; - -sub render { - my ($tmpl, $title, %params) = @_; - unless ($templates{$tmpl}) { - $templates{$tmpl} = { read_templates $tmpl }; - for my $lang (keys $templates{$tmpl}) { - my $header = $header_templates{$lang} =~ s/TITLE_GOES_HERE/$title/rg; - $templates{$tmpl}{$lang} = $header . $templates{$tmpl}{$lang}; - } - $templates{$tmpl}{$_} .= $footer_templates{$_} for keys $templates{$tmpl}; - - } - - my $htc = HTML::Template::Compiled->new(scalarref => \$templates{$tmpl}{en}, default_escape => 'HTML', use_perl => 1); - $htc->param(%params); - [200, ['Content-Type' => 'text/html'], [$htc->output]] -} - use constant USER_REGEX => qr/^\w{2,20}$/a; use constant CONTENT_TYPES => +{ @@ -74,7 +45,7 @@ use constant FORMAT_EXTENSION => { }; use constant NOT_FOUND => [404, ['Content-Type' => 'text/plain'], ['Not found']]; -use constant FORBIDDEN => [401, ['Content-Type' => 'text/plain', 'WWW-Authenticate' => ' Basic realm="Gruntmaster 6000"'], ['Forbidden']]; +use constant FORBIDDEN => [401, ['Content-Type' => 'text/plain', 'WWW-Authenticate' => 'Basic realm="Gruntmaster 6000"'], ['Forbidden']]; my $env; @@ -86,7 +57,7 @@ sub remote_user { $user } -sub admin { remote_user && remote_user->isadmin } +sub admin { remote_user && remote_user->admin } sub contest { db->contest ($_{contest}) } sub problem { db->problem ($_{problem}) } sub job { db->job ($_{job}) } @@ -102,6 +73,7 @@ sub response { } bless {template => $template, title => $title, params => $params}, __PACKAGE__.'::Response' } + sub forbid { return if !shift || admin; unwind FORBIDDEN, SUB UP @@ -149,8 +121,9 @@ sub dispatch_request{ response_filter { my ($r) = @_; return $r if ref $r ne 'Plack::App::Gruntmaster::Response'; - return [200, ['Content-Type' => 'application/json', 'X-Forever' => 1], [encode_json $r->{params}]] if $env->{HTTP_ACCEPT} =~ m,^\s*application/json\s*$,g; - render $r->{template}, $r->{title}, %{$r->{params}} + return [200, ['Content-Type' => 'application/json', 'X-Forever' => 1], [encode 'UTF-8', encode_json $r->{params}]] if $env->{HTTP_ACCEPT} =~ m,^\s*application/json\s*$,g; + my $ret = render $r->{template}, 'en', title => $r->{title}, %{$r->{params}}; + [200, ['Content-Type' => 'text/html'], [encode 'UTF-8', $ret]] }, }, @@ -169,8 +142,8 @@ sub dispatch_request{ sub (/us/) { response us => 'Users', {us => db->user_list} }, sub (/ct/ + ?:owner~) { response ct => 'Contests', db->contest_list(%_) }, - sub (/log/ + ?:contest~&:owner~&:page~&:problem~) { response log => 'Job list', {log => db->job_list(%_)} }, - sub (/pb/ + ?:owner~&:contest~) { response pb => 'Problems', db->problem_list(%_) }, + sub (/log/ + ?:contest~&:owner~&:page~&:problem~) { response log => 'Job list', {%{db->job_list(%_)}, maybe contest => $_{contest}} }, + sub (/pb/ + ?:owner~&:contest~) { response pb => 'Problems', {%{db->problem_list(%_)}, maybe contest => $_{contest}} }, sub (/us/:user) { response us_entry => user->name, db->user_entry($_{user}) }, sub (/ct/:contest) { response ct_entry => contest->name, db->contest_entry($_{contest}) }, @@ -182,11 +155,7 @@ sub dispatch_request{ }, sub (/) { redispatch_to '/index' }, - - sub (/:article) { - my $title = read_file "a/$_{article}.en.title"; - response $_{article} => $title, {}; - } + sub (/:article) { [200, ['Content-Type' => 'text/html'], [render_article $_{article}, 'en']] } }, sub (POST) { @@ -210,16 +179,16 @@ sub dispatch_request{ reply 'Password changed successfully'; }, - sub (/action/submit + %:problem=&:contest~&prog_format=&private~ + *source_code=) { + sub (/action/submit + %:problem=&:contest~&:prog_format=&:private~&:source_code~ + *:prog~) { forbid !remote_user; - return reply 'This contest has finished' if contest->is_finished; - return reply 'This contest has not yet started' if !admin && contest->is_pending; - return reply 'Maximum source size is 10KB' if $_{source_code}->size > 25 * 1024; + return reply 'This contest has finished' if contest && contest->is_finished; + return reply 'This contest has not yet started' if !admin && contest && contest->is_pending; + return reply 'Maximum source size is 10KB' if ($_{prog} ? $_{prog}->size : length $_{source_code}) > 10 * 1024; return reply 'You must wait 30 seconds between jobs' if !admin && time <= remote_user->lastjob + 30; remote_user->update({lastjob => time}); - my $prog = read_file $_{source_code}->path; - unlink $_{source_code}->path; + my $prog = $_{prog} ? read_file $_{prog}->path : $_{source_code}; + unlink $_{prog}->path if $_{prog}; db->jobs->create({ maybe contest => $_{contest}, maybe private => $_{private},