Commit | Line | Data |
483736bb |
1 | package TB_Temp_Packname; |
2 | |
3 | use Web::Simple; |
3b2e0720 |
4 | use Module::Runtime qw(use_module); |
56168e97 |
5 | use Scalar::Util qw(blessed); |
6 | use IO::All; |
7 | use JSON; |
fd9adeae |
8 | use URI::Escape; |
8f4f50a8 |
9 | use Data::Dump qw( pp ); |
56168e97 |
10 | |
11 | has root => (is => 'lazy'); |
12 | |
13 | has json => (is => 'lazy'); |
14 | |
15 | sub _build_root { |
8e9d9fe5 |
16 | io->dir( $ENV{JTV_ROOT} || die "JTV_ROOT env var not set" ) |
56168e97 |
17 | } |
18 | |
19 | sub _build_json { |
b5f74ce3 |
20 | JSON->new->relaxed->pretty |
56168e97 |
21 | } |
483736bb |
22 | |
23 | sub dispatch_request { |
24 | my ($self) = @_; |
3b2e0720 |
25 | sub (/raw/...) { |
26 | use_module('Plack::App::Directory')->new({ |
27 | root => $self->root->name |
28 | }); |
29 | }, |
483736bb |
30 | sub () { |
31 | response_filter { |
32 | ref($_[0][0]) eq 'HASH' ? $self->render_table($_[0][0]) : $_[0] |
33 | } |
34 | }, |
2ff9773b |
35 | sub (/) { |
5951d9d3 |
36 | sub (?@host=) { |
0c3fdf90 |
37 | [ 302, [ 'Location', '/'.join('+', @{$_[1]}).'/' ], [] ]; |
5951d9d3 |
38 | }, |
39 | sub () { |
40 | $self->root_structure; |
41 | }, |
2ff9773b |
42 | }, |
56168e97 |
43 | sub (/**/) { |
5b04ffd1 |
44 | $self->structure(map { |
45 | s{\\/}{/}g; |
46 | s{\\\\}{\\}g; |
47 | $_; |
48 | } split qr{(?<!\\)/}, $_[1]); |
56168e97 |
49 | }, |
50 | } |
51 | |
5951d9d3 |
52 | sub root_structure { |
53 | my ($self) = @_; |
54 | my $struct = $self->mangle_structure($self->root); |
55 | push @{$struct->[0]{columns}}, 'select'; |
56 | foreach my $host (@{$struct->[0]{data}}) { |
57 | use HTML::Tags; |
58 | my $name = $host->{name}; |
59 | my $html = join '', HTML::Tags::to_html_string( |
60 | <input type="checkbox" name="host" value="$name" /> |
61 | ); |
62 | $host->{select} = \$html; |
63 | } |
64 | $struct->[0]{wrapper} = sub { |
65 | use HTML::Tags; |
66 | ' ', <form>, "\n", |
67 | (map /^\s*$/ ? " $_" : $_, @_), |
68 | ' ', <input type="submit" value="Now Multify" />, "\n", |
69 | ' ', </form>, "\n" |
70 | }; |
71 | return $struct; |
72 | } |
73 | |
8f4f50a8 |
74 | sub merge_pair_structures { |
75 | my ($self, $cols, @structures) = @_; |
76 | my ($key_name, $value_name) = @$cols; |
77 | my %name; |
78 | $name{ $_ }++ |
79 | for map $_->{$key_name}, |
80 | map { ($_ ? @$_ : ()) } map $_->[1]{data}, @structures; |
81 | my %value_by_host = (map { |
82 | my $host = $_->[0]; |
83 | my $data = $_->[1]{data}; |
84 | ($host, +{ |
85 | map { ($_->{$key_name}, $_->{$value_name}) } @$data, |
86 | }); |
87 | } @structures); |
88 | my @hosts = map $_->[0], @structures; |
89 | return [{ |
90 | columns => ['key', @hosts], |
91 | show_columns => 1, |
92 | data => [ map { |
93 | my $key = $_; |
94 | +{ key => $key, (map { |
95 | ($_, $value_by_host{$_}{$key}); |
96 | } @hosts)}; |
97 | } sort keys %name ], |
98 | }]; |
99 | } |
100 | |
101 | sub merge_generic_structures { |
102 | my ($self, $cols, @structures) = @_; |
103 | my %by_name; |
104 | my %host_cols; |
105 | my %complex_cols; |
106 | my %alias; |
107 | my $is_explore = grep { $_ eq 'explore' } @$cols; |
108 | foreach my $thing (@structures) { |
109 | foreach my $el (@{$thing->[1]{data}}) { |
110 | my $by = $by_name{$el->{name}} ||= { name => $el->{name} }; |
111 | foreach my $key (keys %$el) { |
112 | next if $is_explore and $key eq 'name'; |
113 | if (ref($el->{$key}) eq 'HASH') { |
114 | $complex_cols{$key} = 1; |
115 | $by->{$key} = {}; |
116 | } else { |
117 | my $full_key = $key.' ('.$thing->[0].')'; |
118 | $alias{$full_key} = $key; |
119 | $host_cols{$full_key} = 1; |
120 | $by->{$full_key} = $el->{$key}; |
121 | } |
122 | } |
123 | } |
124 | } |
125 | return [{ |
126 | columns => [ |
127 | $is_explore ? ('name') : (), |
128 | sort(keys %host_cols), |
129 | sort(keys %complex_cols), |
130 | ], |
131 | show_columns => 1, |
132 | aliases => \%alias, |
133 | data => [ |
134 | map $by_name{$_}, sort keys %by_name |
135 | ], |
136 | }]; |
137 | } |
138 | |
139 | sub merge_unrelated_structures { |
140 | my ($self, $cols, @structures) = @_; |
141 | my $done = [{ |
142 | columns => ['host', sort @$cols], |
143 | show_columns => 1, |
144 | data => [ map { |
145 | my ($host, $data) = @$_; |
146 | (map +{ host => $host, %$_ }, @{ $data->{data} || [] }); |
147 | } @structures ], |
148 | }]; |
149 | return $done; |
150 | } |
151 | |
152 | sub _pred_columns_kv { @_ == 3 and $_[1] eq 'key' and $_[2] eq 'value' } |
153 | |
56168e97 |
154 | sub structure { |
5951d9d3 |
155 | my ($self, @parts) = @_; |
156 | if ($parts[0] =~ /\+/) { |
157 | ($parts[0], my @extra) = split /\+/, $parts[0]; |
158 | my $struct = $self->mangle_structure($self->descend($self->root, @parts)); |
5951d9d3 |
159 | my $first = shift @parts; |
8f4f50a8 |
160 | my @rest = map { |
161 | my $name = $_; |
162 | my $data = $self->mangle_structure( |
163 | $self->descend($self->root, $name, @parts), |
164 | ); |
165 | [$name, $data ? $data->[0] : {}]; |
166 | } @extra; |
167 | my %col; |
168 | $col{$_}++ |
169 | for map { (@{$_->{columns}||[]}) } |
170 | $struct->[0], map $_->[1], @rest; |
171 | my @cols = sort keys %col; |
172 | my $show_cols; |
173 | $show_cols++ |
174 | for grep { $_->{show_columns} } |
175 | $struct->[0], map $_->[1], @rest; |
176 | my @structures = ([$first, $struct->[0]], @rest); |
177 | if ($self->_pred_columns_kv(@cols)) { |
178 | return $self->merge_pair_structures( |
179 | [@cols], |
180 | @structures, |
181 | ); |
ac9c8b97 |
182 | } |
8f4f50a8 |
183 | elsif (not $col{name}) { |
184 | return $self->merge_unrelated_structures([@cols], @structures); |
185 | } |
186 | return $self->merge_generic_structures([@cols], @structures); |
187 | } |
188 | return $self->mangle_structure($self->descend($self->root, @parts)); |
189 | } |
190 | |
191 | sub mangle_hash_structure { |
192 | my ($self, $data) = @_; |
193 | if (keys %$data > 1 |
194 | and values %$data == grep ref($_) eq 'HASH', values %$data) { |
195 | my %tmp; |
196 | $tmp{join '|', keys %$_} = 1 for values %$data; |
197 | if (keys %tmp == 1) { |
198 | $data->{$_}->{name} ||= $_ for keys %$data; |
199 | my @cols = grep $_ ne 'name', sort keys %{(values %$data)[0]}; |
200 | unshift @cols, 'name'; |
201 | return [{ |
202 | columns => \@cols, |
203 | show_columns => 1, |
204 | data => [ @{$data}{sort keys %$data} ], |
205 | }] |
5951d9d3 |
206 | } |
8f4f50a8 |
207 | } |
208 | return [{ |
209 | columns => [ 'key', 'value' ], |
210 | data => [ map +{ key => $_, value => $data->{$_} }, sort keys %$data ], |
211 | }]; |
212 | } |
213 | |
214 | sub mangle_array_structure { |
215 | my ($self, $data) = @_; |
216 | if (not grep { not ref($_) eq 'HASH' } @$data) { |
217 | my %key; |
218 | $key{$_} = 1 |
219 | for map { keys %$_ } @$data; |
5951d9d3 |
220 | return [{ |
8f4f50a8 |
221 | columns => [sort keys %key], |
5951d9d3 |
222 | show_columns => 1, |
8f4f50a8 |
223 | data => $data, |
5951d9d3 |
224 | }]; |
225 | } |
8f4f50a8 |
226 | } |
227 | |
228 | sub mangle_directory { |
229 | my ($self, $data) = @_; |
230 | return [{ |
231 | columns => [ 'name', 'explore' ], |
232 | data => [ |
233 | map +{ name => $_, explore => $self->link_to($_) }, keys %$data, |
234 | ] |
235 | }]; |
5951d9d3 |
236 | } |
237 | |
238 | sub mangle_structure { |
56168e97 |
239 | my ($self, $data) = @_; |
fa101d7f |
240 | return unless $data; |
a7a7a4b9 |
241 | if (ref($data) eq 'HASH') { |
8f4f50a8 |
242 | return $self->mangle_hash_structure($data); |
53cf6a70 |
243 | } elsif (ref($data) eq 'ARRAY') { |
8f4f50a8 |
244 | return $self->mangle_array_structure($data); |
2ff9773b |
245 | } elsif (blessed($data) and $data->isa('IO::All::Dir')) { |
8f4f50a8 |
246 | return $self->mangle_directory($data); |
56168e97 |
247 | } else { |
248 | die "Confused by $data"; |
249 | } |
250 | } |
251 | |
2ff9773b |
252 | sub link_to { |
fa101d7f |
253 | my ($self, @to) = @_; |
2ff9773b |
254 | use HTML::Tags; |
5b04ffd1 |
255 | my @link = map { |
5af88d19 |
256 | my $link = $_; |
257 | $link =~ s{\\}{\\\\}g; |
258 | $link =~ s{/}{\\/}g; |
259 | $link; |
5b04ffd1 |
260 | } @to; |
fa101d7f |
261 | my $link = join('/', @link, ''); |
262 | my $to = $to[-1]; |
2ff9773b |
263 | my $html = join '', HTML::Tags::to_html_string( |
5b04ffd1 |
264 | <a href="./${link}">, "Explore $to", </a> |
2ff9773b |
265 | ); |
266 | return \$html; |
267 | } |
268 | |
56168e97 |
269 | sub descend { |
270 | my ($self, $target, @path) = @_; |
fa101d7f |
271 | return unless $target; |
56168e97 |
272 | if (blessed($target) and $target->isa('IO::All::File')) { |
ac9c8b97 |
273 | my $all = $target->all; |
274 | $target = $self->json->decode($all); |
483736bb |
275 | } |
2ff9773b |
276 | return $target unless @path; |
5b04ffd1 |
277 | my $step = shift @path; |
fd9adeae |
278 | $self->descend($target->{$step}, @path); |
483736bb |
279 | } |
280 | |
281 | sub render_table { |
282 | my ($self, $data) = @_; |
283 | use HTML::Tags; |
284 | my @rows = ( |
2ff9773b |
285 | $data->{show_columns} ? { map +($_ => $_), @{$data->{columns}} } : (), |
286 | @{$data->{data}} |
483736bb |
287 | ); |
d568eb4c |
288 | my $column_count = scalar @{$data->{columns}}; |
483736bb |
289 | [ 200, [ 'Content-type' => 'text/html' ], [ |
290 | HTML::Tags::to_html_string( |
56168e97 |
291 | <html>, <body>, "\n", |
5951d9d3 |
292 | ($data->{wrapper}||sub{@_})->( |
293 | '', <table>, "\n", |
d568eb4c |
294 | (map { my $el = $_; |
295 | ' ', ($el->{key} eq '__error__') ? <tr class="error"> : <tr>, |
296 | (map { |
8f4f50a8 |
297 | <td>, $self->render_el( |
298 | $el, |
299 | $_, |
300 | $el->{$_}, |
301 | $data->{aliases}{$_}, |
302 | ), </td> |
d568eb4c |
303 | } @{$data->{columns}}), |
304 | </tr>, "\n" |
305 | } @rows), |
306 | @{$data->{data}} |
307 | ? () |
a3808ee6 |
308 | : (<tr class="no-rows">, |
d568eb4c |
309 | <td colspan="$column_count">, |
310 | 'No entries in this data structure', |
311 | </td>, |
a3808ee6 |
312 | </tr>), |
5951d9d3 |
313 | '', </table>, "\n", |
314 | ), |
56168e97 |
315 | </body>, </html>, "\n", |
483736bb |
316 | ) |
317 | ] ]; |
318 | } |
319 | |
2ff9773b |
320 | sub render_el { |
8f4f50a8 |
321 | my ($self, $whole, $key, $part, $alias) = @_; |
322 | my $link_key = defined($alias) ? $alias : $key; |
2ff9773b |
323 | if (ref($part) eq 'ARRAY') { |
8347d3a1 |
324 | if (grep { ref($_) eq 'HASH' } @$part) { |
325 | if ($whole->{key}) { |
326 | return $self->link_to($whole->{key}) |
327 | } elsif ($whole->{name}) { |
8f4f50a8 |
328 | return $self->link_to($whole->{name}, $link_key); |
53cf6a70 |
329 | } |
330 | } |
861950c2 |
331 | return join ', ', @$part |
332 | if @$part < 5; |
333 | use HTML::Tags; |
334 | return <ul>, (map { (<li>, $_, </li>) } @$part), </ul>; |
2ff9773b |
335 | } |
336 | if (ref($part) eq 'HASH') { |
b5f74ce3 |
337 | if ($whole->{key}) { |
338 | return $self->link_to($whole->{key}) |
fa101d7f |
339 | } elsif ($whole->{name}) { |
8f4f50a8 |
340 | return $self->link_to($whole->{name}, $link_key); |
b5f74ce3 |
341 | } |
342 | $part = '(complex)'; |
2ff9773b |
343 | } |
b5f74ce3 |
344 | use HTML::Tags; |
345 | return $part =~ /\n/ ? (<pre>, $part, </pre>) : $part; |
2ff9773b |
346 | } |
a7a7a4b9 |
347 | |
483736bb |
348 | __PACKAGE__->run_if_script; |