lib/Gruntmaster/Page/Generic.pm

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