]>
Commit | Line | Data |
---|---|---|
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 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 { $a->{start} <=> $b->{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 |