lib/Gruntmaster/Page/Generic.pm

   1 package Gruntmaster::Page::Generic;
   2
   3 use 5.014000;
   4 use strict;
   5 use warnings;
   6 our $VERSION = '5999.000_001';
   7
   8 use Gruntmaster::Data;
   9 use Gruntmaster::Page::Base;
  10 use JSON qw/encode_json decode_json/;
  11
  12 sub hgetall {
  13         my $hash = shift;
  14         my $cp = $Gruntmaster::Data::contest ? "contest.$Gruntmaster::Data::contest." : '';
  15         map { { id => $_, HGETALL "$cp$hash.$_" } } SMEMBERS "$cp$hash"
  16 }
  17
  18 sub putsym {
  19         my ($key, $value) = @_;
  20         no strict 'refs';
  21         *{"$key"} = $value;
  22 }
  23
  24 sub makepkg {
  25         my ($pkg, $id, $title) = @_;
  26         my $fn = $pkg =~ s,::,/,gr;
  27         return if $INC{"$fn.pm"};
  28         $INC{"$fn.pm"} = 1;
  29         Gruntmaster::Page::Base->import_to($pkg, $id, $title);
  30         1
  31 }
  32
  33 sub list {
  34         my ($thing, $lang, $env, $ct) = @_;
  35         my %thing = %$thing;
  36         undef $ct unless $thing{contest};
  37         debug $env => "Contest is $ct";
  38         local $Gruntmaster::Data::contest = $ct if $ct;
  39         my @thing = hgetall $thing{hash};
  40         @thing = map  { $thing{mangle}->(); $_ } @thing if exists $thing{mangle};
  41         @thing = grep { $thing{choose}->() } @thing if exists $thing{choose};
  42         @thing = sort { $thing{sortby}->() } @thing if exists $thing{sortby};
  43         my %params;
  44         $thing{group} //= sub { $thing{id} };
  45         for (@thing) {
  46                 my $group = $thing{group}->();
  47                 $params{$group} //= [];
  48                 push $params{$group}, $_
  49         }
  50         wantarray ? %params : \%params
  51 }
  52
  53 sub entry {
  54         my ($thing, $lang, $env, $id, $ct) = @_;
  55         my %thing = %$thing;
  56         ($id, $ct) = ($ct, $id) if $thing{contest};
  57         local $Gruntmaster::Data::contest = $ct if $ct;
  58         debug $env => "Hash is $thing{hash} and id is $id";
  59         my %params = HGETALL "$thing{hash}.$id";
  60         $thing{mangle}->(local $_ = \%params) if exists $thing{mangle};
  61         wantarray ? %params : \%params
  62 }
  63
  64 sub headers ($) { ['Content-Type' => 'application/json', 'Cache-Control' => 'max-age=' . $_[0]->max_age] }
  65
  66 sub create_thing {
  67         my %thing = @_;
  68         my $ucid = ucfirst $thing{id};
  69         my $pkg = "Gruntmaster::Page::$ucid";
  70
  71         putsym "${pkg}::_generate", sub { $_[1]->param(list \%thing, @_[2..$#_]) } if makepkg $pkg, @thing{qw/id title/};
  72         putsym "${pkg}::Entry::_generate",  sub { $_[1]->param(entry \%thing, @_[2..$#_]) } if makepkg "${pkg}::Entry", "$thing{id}_entry", '<tmpl_var name>';
  73         putsym "${pkg}::Read::generate", sub { [200, headers shift, [encode_json list \%thing, @_]] } if makepkg "${pkg}::Read";
  74         putsym "${pkg}::Entry::Read::generate", sub { [200, headers shift, [encode_json entry \%thing, @_]] } if makepkg "${pkg}::Entry::Read";
  75 }
  76
  77 sub params;
  78 sub contest;
  79 sub choose (&);
  80 sub sortby (&);
  81 sub group  (&);
  82 sub mangle (&);
  83
  84 sub thing (&){
  85         my %thing;
  86         no strict 'refs';
  87         local *{"params"} = sub { @thing{qw/id hash title/} = @_ };
  88         local *{"choose"} = sub { $thing{choose} = shift };
  89         local *{"sortby"} = sub { $thing{sortby} = shift };
  90         local *{"mangle"} = sub { $thing{mangle} = shift };
  91         local *{"group"} = sub { $thing{group} = shift };
  92         local *{"contest"} = sub { $thing{contest} = 1 };
  93         use strict 'refs';
  94
  95         shift->();
  96         create_thing %thing
  97 }
  98
  99 ##################################################
 100
 101 thing {
 102         params qw/us user Users/;
 103         choose { $_->{name} =~ /\w/ };
 104         sortby { lc $a->{name} cmp lc $b->{name} };
 105 };
 106
 107 thing {
 108         params qw/pb problem Problems/;
 109         contest;
 110         sortby { $a->{name} cmp $b->{name} };
 111         group { $_->{level} };
 112         mangle { $_->{owner_name} = do { local $Gruntmaster::Data::contest; user_name $_->{owner} } }
 113 };
 114
 115 thing {
 116         params qw/ct contest Contests/;
 117         sortby { $b->{start} <=> $a->{start} };
 118         group { time < $_->{start} ? 'pending' : time > $_->{end} ? 'finished' : 'running' };
 119         mangle { $_->{started} = time >= $_->{start}; $_->{owner_name} = do { local $Gruntmaster::Data::contest; user_name $_->{owner} } };
 120 };
 121
 122 thing {
 123         params qw/log job/, 'Job log';
 124         contest;
 125         mangle { $_->{results} &&= decode_json $_->{results}; $_->{user_name} = do { local $Gruntmaster::Data::contest; user_name $_->{user} } }
 126 };
 127
 128 1