lib/Gruntmaster/Page/Generic.pm

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