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; |
56168e97 |
9 | |
10 | has root => (is => 'lazy'); |
11 | |
12 | has json => (is => 'lazy'); |
13 | |
14 | sub _build_root { |
8e9d9fe5 |
15 | io->dir( $ENV{JTV_ROOT} || die "JTV_ROOT env var not set" ) |
56168e97 |
16 | } |
17 | |
18 | sub _build_json { |
b5f74ce3 |
19 | JSON->new->relaxed->pretty |
56168e97 |
20 | } |
483736bb |
21 | |
22 | sub dispatch_request { |
23 | my ($self) = @_; |
3b2e0720 |
24 | sub (/raw/...) { |
25 | use_module('Plack::App::Directory')->new({ |
26 | root => $self->root->name |
27 | }); |
28 | }, |
483736bb |
29 | sub () { |
30 | response_filter { |
31 | ref($_[0][0]) eq 'HASH' ? $self->render_table($_[0][0]) : $_[0] |
32 | } |
33 | }, |
2ff9773b |
34 | sub (/) { |
5951d9d3 |
35 | sub (?@host=) { |
0c3fdf90 |
36 | [ 302, [ 'Location', '/'.join('+', @{$_[1]}).'/' ], [] ]; |
5951d9d3 |
37 | }, |
38 | sub () { |
39 | $self->root_structure; |
40 | }, |
2ff9773b |
41 | }, |
56168e97 |
42 | sub (/**/) { |
5b04ffd1 |
43 | $self->structure(map { |
44 | s{\\/}{/}g; |
45 | s{\\\\}{\\}g; |
46 | $_; |
47 | } split qr{(?<!\\)/}, $_[1]); |
56168e97 |
48 | }, |
49 | } |
50 | |
5951d9d3 |
51 | sub root_structure { |
52 | my ($self) = @_; |
53 | my $struct = $self->mangle_structure($self->root); |
54 | push @{$struct->[0]{columns}}, 'select'; |
55 | foreach my $host (@{$struct->[0]{data}}) { |
56 | use HTML::Tags; |
57 | my $name = $host->{name}; |
58 | my $html = join '', HTML::Tags::to_html_string( |
59 | <input type="checkbox" name="host" value="$name" /> |
60 | ); |
61 | $host->{select} = \$html; |
62 | } |
63 | $struct->[0]{wrapper} = sub { |
64 | use HTML::Tags; |
65 | ' ', <form>, "\n", |
66 | (map /^\s*$/ ? " $_" : $_, @_), |
67 | ' ', <input type="submit" value="Now Multify" />, "\n", |
68 | ' ', </form>, "\n" |
69 | }; |
70 | return $struct; |
71 | } |
72 | |
56168e97 |
73 | sub structure { |
5951d9d3 |
74 | my ($self, @parts) = @_; |
75 | if ($parts[0] =~ /\+/) { |
76 | ($parts[0], my @extra) = split /\+/, $parts[0]; |
77 | my $struct = $self->mangle_structure($self->descend($self->root, @parts)); |
5951d9d3 |
78 | my $first = shift @parts; |
79 | my @rest = map [ $_, $self->mangle_structure( |
80 | $self->descend($self->root, $_, @parts) |
81 | )->[0] ], @extra; |
ac9c8b97 |
82 | unless ($struct->[0]{show_columns}) { |
83 | my @cols = @{ $struct->[0]{columns} }; |
84 | if (@cols == 2) { |
85 | my ($key_name, $value_name) = @cols; |
86 | my %name; |
87 | $name{ $_ }++ |
88 | for map $_->{$key_name}, |
89 | map @$_, $struct->[0]{data}, map $_->[1]{data}, @rest; |
90 | my %value_by_host = (map { |
91 | my $host = $_->[0]; |
92 | my $data = $_->[1]{data}; |
93 | ($host, +{ |
94 | map { ($_->{$key_name}, $_->{$value_name}) } @$data, |
95 | }); |
96 | } [$first, $struct->[0]], @rest); |
97 | my @hosts = ($first, @extra); |
98 | return [{ |
99 | columns => ['key', @hosts], |
100 | show_columns => 1, |
101 | data => [ map { |
102 | my $key = $_; |
103 | +{ key => $key, (map { |
104 | ($_, $value_by_host{$_}{$key}); |
105 | } @hosts)}; |
106 | } sort keys %name ], |
107 | }]; |
108 | } |
109 | } |
5951d9d3 |
110 | my %by_name; |
111 | my %host_cols; |
112 | my %complex_cols; |
113 | foreach my $thing ([ $first, $struct->[0] ], @rest) { |
114 | foreach my $el (@{$thing->[1]{data}}) { |
115 | my $by = $by_name{$el->{name}} ||= { name => $el->{name} }; |
116 | foreach my $key (keys %$el) { |
117 | next if $key eq 'name'; |
118 | if (ref($el->{$key}) eq 'HASH') { |
119 | $complex_cols{$key} = 1; |
120 | $by->{$key} = {}; |
121 | } else { |
122 | my $full_key = $key.' ('.$thing->[0].')'; |
123 | $host_cols{$full_key} = 1; |
124 | $by->{$full_key} = $el->{$key}; |
125 | } |
126 | } |
127 | } |
128 | } |
129 | return [{ |
130 | columns => [ 'name', sort(keys %host_cols), sort(keys %complex_cols) ], |
131 | show_columns => 1, |
132 | data => [ |
133 | map $by_name{$_}, sort keys %by_name |
134 | ], |
135 | }]; |
136 | } |
137 | return $self->mangle_structure($self->descend($self->root, @parts)); |
138 | } |
139 | |
140 | sub mangle_structure { |
56168e97 |
141 | my ($self, $data) = @_; |
fa101d7f |
142 | return unless $data; |
a7a7a4b9 |
143 | if (ref($data) eq 'HASH') { |
a6694990 |
144 | if (keys %$data > 1 |
145 | and values %$data == grep ref($_) eq 'HASH', values %$data) { |
146 | my %tmp; |
147 | $tmp{join '|', keys %$_} = 1 for values %$data; |
148 | if (keys %tmp == 1) { |
149 | $data->{$_}->{name} ||= $_ for keys %$data; |
b5f74ce3 |
150 | my @cols = grep $_ ne 'name', sort keys %{(values %$data)[0]}; |
151 | unshift @cols, 'name'; |
fa101d7f |
152 | return [{ |
b5f74ce3 |
153 | columns => \@cols, |
a6694990 |
154 | show_columns => 1, |
155 | data => [ @{$data}{sort keys %$data} ], |
fa101d7f |
156 | }] |
a6694990 |
157 | } |
158 | } |
fa101d7f |
159 | return [{ |
2ff9773b |
160 | columns => [ 'key', 'value' ], |
161 | data => [ map +{ key => $_, value => $data->{$_} }, sort keys %$data ], |
fa101d7f |
162 | }]; |
53cf6a70 |
163 | } elsif (ref($data) eq 'ARRAY') { |
164 | if (not grep { not ref($_) eq 'HASH' } @$data) { |
165 | my %key; |
166 | $key{$_} = 1 |
167 | for map { keys %$_ } @$data; |
168 | return [{ |
169 | columns => [sort keys %key], |
170 | show_columns => 1, |
171 | data => $data, |
172 | }]; |
173 | } |
2ff9773b |
174 | } elsif (blessed($data) and $data->isa('IO::All::Dir')) { |
fa101d7f |
175 | return [{ |
2ff9773b |
176 | columns => [ 'name', 'explore' ], |
177 | data => [ |
178 | map +{ name => $_, explore => $self->link_to($_) }, keys %$data, |
179 | ] |
fa101d7f |
180 | }]; |
56168e97 |
181 | } else { |
182 | die "Confused by $data"; |
183 | } |
184 | } |
185 | |
2ff9773b |
186 | sub link_to { |
fa101d7f |
187 | my ($self, @to) = @_; |
2ff9773b |
188 | use HTML::Tags; |
5b04ffd1 |
189 | my @link = map { |
5af88d19 |
190 | my $link = $_; |
191 | $link =~ s{\\}{\\\\}g; |
192 | $link =~ s{/}{\\/}g; |
193 | $link; |
5b04ffd1 |
194 | } @to; |
fa101d7f |
195 | my $link = join('/', @link, ''); |
196 | my $to = $to[-1]; |
2ff9773b |
197 | my $html = join '', HTML::Tags::to_html_string( |
5b04ffd1 |
198 | <a href="./${link}">, "Explore $to", </a> |
2ff9773b |
199 | ); |
200 | return \$html; |
201 | } |
202 | |
56168e97 |
203 | sub descend { |
204 | my ($self, $target, @path) = @_; |
fa101d7f |
205 | return unless $target; |
56168e97 |
206 | if (blessed($target) and $target->isa('IO::All::File')) { |
ac9c8b97 |
207 | my $all = $target->all; |
208 | $target = $self->json->decode($all); |
483736bb |
209 | } |
2ff9773b |
210 | return $target unless @path; |
5b04ffd1 |
211 | my $step = shift @path; |
fd9adeae |
212 | $self->descend($target->{$step}, @path); |
483736bb |
213 | } |
214 | |
215 | sub render_table { |
216 | my ($self, $data) = @_; |
217 | use HTML::Tags; |
218 | my @rows = ( |
2ff9773b |
219 | $data->{show_columns} ? { map +($_ => $_), @{$data->{columns}} } : (), |
220 | @{$data->{data}} |
483736bb |
221 | ); |
222 | [ 200, [ 'Content-type' => 'text/html' ], [ |
223 | HTML::Tags::to_html_string( |
56168e97 |
224 | <html>, <body>, "\n", |
5951d9d3 |
225 | ($data->{wrapper}||sub{@_})->( |
226 | '', <table>, "\n", |
a3808ee6 |
227 | @rows |
228 | ? (map { my $el = $_; |
229 | ' ', ($el->{key} eq '__error__') ? <tr class="error"> : <tr>, |
230 | (map { |
231 | <td>, $self->render_el($el, $_, $el->{$_}), </td> |
232 | } @{$data->{columns}}), |
233 | </tr>, "\n" |
234 | } @rows) |
235 | : (<tr class="no-rows">, |
236 | <td>, 'No entries in this data structure', </td>, |
237 | </tr>), |
5951d9d3 |
238 | '', </table>, "\n", |
239 | ), |
56168e97 |
240 | </body>, </html>, "\n", |
483736bb |
241 | ) |
242 | ] ]; |
243 | } |
244 | |
2ff9773b |
245 | sub render_el { |
fa101d7f |
246 | my ($self, $whole, $key, $part) = @_; |
2ff9773b |
247 | if (ref($part) eq 'ARRAY') { |
8347d3a1 |
248 | if (grep { ref($_) eq 'HASH' } @$part) { |
249 | if ($whole->{key}) { |
250 | return $self->link_to($whole->{key}) |
251 | } elsif ($whole->{name}) { |
53cf6a70 |
252 | return $self->link_to($whole->{name}, $key); |
253 | } |
254 | } |
861950c2 |
255 | return join ', ', @$part |
256 | if @$part < 5; |
257 | use HTML::Tags; |
258 | return <ul>, (map { (<li>, $_, </li>) } @$part), </ul>; |
2ff9773b |
259 | } |
260 | if (ref($part) eq 'HASH') { |
b5f74ce3 |
261 | if ($whole->{key}) { |
262 | return $self->link_to($whole->{key}) |
fa101d7f |
263 | } elsif ($whole->{name}) { |
264 | return $self->link_to($whole->{name}, $key); |
b5f74ce3 |
265 | } |
266 | $part = '(complex)'; |
2ff9773b |
267 | } |
b5f74ce3 |
268 | use HTML::Tags; |
269 | return $part =~ /\n/ ? (<pre>, $part, </pre>) : $part; |
2ff9773b |
270 | } |
a7a7a4b9 |
271 | |
483736bb |
272 | __PACKAGE__->run_if_script; |