]>
Commit | Line | Data |
---|---|---|
fdbf59e5 MG |
1 | package Gruntmaster::Page::Generic; |
2 | ||
3 | use 5.014000; | |
4 | use strict; | |
5 | use warnings; | |
5c6aea93 | 6 | our $VERSION = '0.001'; |
fdbf59e5 MG |
7 | |
8 | use Gruntmaster::Data; | |
9 | use Gruntmaster::Page::Base; | |
5c6aea93 | 10 | use JSON qw/encode_json decode_json/; |
fdbf59e5 MG |
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); | |
5c6aea93 | 30 | 1 |
fdbf59e5 MG |
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 |