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; |
8 | |
9 | has root => (is => 'lazy'); |
10 | |
11 | has json => (is => 'lazy'); |
12 | |
13 | sub _build_root { |
14 | io->dir("/home/matthewt/tmp/introspection-data/host/services-dev/stable/node/host/") |
15 | } |
16 | |
17 | sub _build_json { |
b5f74ce3 |
18 | JSON->new->relaxed->pretty |
56168e97 |
19 | } |
483736bb |
20 | |
21 | sub dispatch_request { |
22 | my ($self) = @_; |
3b2e0720 |
23 | sub (/raw/...) { |
24 | use_module('Plack::App::Directory')->new({ |
25 | root => $self->root->name |
26 | }); |
27 | }, |
483736bb |
28 | sub () { |
29 | response_filter { |
30 | ref($_[0][0]) eq 'HASH' ? $self->render_table($_[0][0]) : $_[0] |
31 | } |
32 | }, |
2ff9773b |
33 | sub (/) { |
5951d9d3 |
34 | sub (?@host=) { |
0c3fdf90 |
35 | [ 302, [ 'Location', '/'.join('+', @{$_[1]}).'/' ], [] ]; |
5951d9d3 |
36 | }, |
37 | sub () { |
38 | $self->root_structure; |
39 | }, |
2ff9773b |
40 | }, |
56168e97 |
41 | sub (/**/) { |
5951d9d3 |
42 | $self->structure(split '/', $_[1]); |
56168e97 |
43 | }, |
44 | } |
45 | |
5951d9d3 |
46 | sub root_structure { |
47 | my ($self) = @_; |
48 | my $struct = $self->mangle_structure($self->root); |
49 | push @{$struct->[0]{columns}}, 'select'; |
50 | foreach my $host (@{$struct->[0]{data}}) { |
51 | use HTML::Tags; |
52 | my $name = $host->{name}; |
53 | my $html = join '', HTML::Tags::to_html_string( |
54 | <input type="checkbox" name="host" value="$name" /> |
55 | ); |
56 | $host->{select} = \$html; |
57 | } |
58 | $struct->[0]{wrapper} = sub { |
59 | use HTML::Tags; |
60 | ' ', <form>, "\n", |
61 | (map /^\s*$/ ? " $_" : $_, @_), |
62 | ' ', <input type="submit" value="Now Multify" />, "\n", |
63 | ' ', </form>, "\n" |
64 | }; |
65 | return $struct; |
66 | } |
67 | |
56168e97 |
68 | sub structure { |
5951d9d3 |
69 | my ($self, @parts) = @_; |
70 | if ($parts[0] =~ /\+/) { |
71 | ($parts[0], my @extra) = split /\+/, $parts[0]; |
72 | my $struct = $self->mangle_structure($self->descend($self->root, @parts)); |
73 | return $struct unless $struct->[0]{show_columns}; |
74 | my $first = shift @parts; |
75 | my @rest = map [ $_, $self->mangle_structure( |
76 | $self->descend($self->root, $_, @parts) |
77 | )->[0] ], @extra; |
78 | my %by_name; |
79 | my %host_cols; |
80 | my %complex_cols; |
81 | foreach my $thing ([ $first, $struct->[0] ], @rest) { |
82 | foreach my $el (@{$thing->[1]{data}}) { |
83 | my $by = $by_name{$el->{name}} ||= { name => $el->{name} }; |
84 | foreach my $key (keys %$el) { |
85 | next if $key eq 'name'; |
86 | if (ref($el->{$key}) eq 'HASH') { |
87 | $complex_cols{$key} = 1; |
88 | $by->{$key} = {}; |
89 | } else { |
90 | my $full_key = $key.' ('.$thing->[0].')'; |
91 | $host_cols{$full_key} = 1; |
92 | $by->{$full_key} = $el->{$key}; |
93 | } |
94 | } |
95 | } |
96 | } |
97 | return [{ |
98 | columns => [ 'name', sort(keys %host_cols), sort(keys %complex_cols) ], |
99 | show_columns => 1, |
100 | data => [ |
101 | map $by_name{$_}, sort keys %by_name |
102 | ], |
103 | }]; |
104 | } |
105 | return $self->mangle_structure($self->descend($self->root, @parts)); |
106 | } |
107 | |
108 | sub mangle_structure { |
56168e97 |
109 | my ($self, $data) = @_; |
fa101d7f |
110 | return unless $data; |
a7a7a4b9 |
111 | if (ref($data) eq 'HASH') { |
a6694990 |
112 | if (keys %$data > 1 |
113 | and values %$data == grep ref($_) eq 'HASH', values %$data) { |
114 | my %tmp; |
115 | $tmp{join '|', keys %$_} = 1 for values %$data; |
116 | if (keys %tmp == 1) { |
117 | $data->{$_}->{name} ||= $_ for keys %$data; |
b5f74ce3 |
118 | my @cols = grep $_ ne 'name', sort keys %{(values %$data)[0]}; |
119 | unshift @cols, 'name'; |
fa101d7f |
120 | return [{ |
b5f74ce3 |
121 | columns => \@cols, |
a6694990 |
122 | show_columns => 1, |
123 | data => [ @{$data}{sort keys %$data} ], |
fa101d7f |
124 | }] |
a6694990 |
125 | } |
126 | } |
fa101d7f |
127 | return [{ |
2ff9773b |
128 | columns => [ 'key', 'value' ], |
129 | data => [ map +{ key => $_, value => $data->{$_} }, sort keys %$data ], |
fa101d7f |
130 | }]; |
2ff9773b |
131 | } elsif (blessed($data) and $data->isa('IO::All::Dir')) { |
fa101d7f |
132 | return [{ |
2ff9773b |
133 | columns => [ 'name', 'explore' ], |
134 | data => [ |
135 | map +{ name => $_, explore => $self->link_to($_) }, keys %$data, |
136 | ] |
fa101d7f |
137 | }]; |
56168e97 |
138 | } else { |
139 | die "Confused by $data"; |
140 | } |
141 | } |
142 | |
2ff9773b |
143 | sub link_to { |
fa101d7f |
144 | my ($self, @to) = @_; |
2ff9773b |
145 | use HTML::Tags; |
fa101d7f |
146 | s/\//\./g for my @link = @to; |
147 | my $link = join('/', @link, ''); |
148 | my $to = $to[-1]; |
2ff9773b |
149 | my $html = join '', HTML::Tags::to_html_string( |
fa101d7f |
150 | <a href="${link}">, "Explore $to", </a> |
2ff9773b |
151 | ); |
152 | return \$html; |
153 | } |
154 | |
56168e97 |
155 | sub descend { |
156 | my ($self, $target, @path) = @_; |
fa101d7f |
157 | return unless $target; |
56168e97 |
158 | if (blessed($target) and $target->isa('IO::All::File')) { |
159 | $target = $self->json->decode(scalar $target->all); |
483736bb |
160 | } |
2ff9773b |
161 | return $target unless @path; |
fa101d7f |
162 | (my $undot = my $step = shift @path) =~ s/\./\//g; |
163 | $self->descend($target->{$step}||$target->{$undot}, @path); |
483736bb |
164 | } |
165 | |
166 | sub render_table { |
167 | my ($self, $data) = @_; |
168 | use HTML::Tags; |
169 | my @rows = ( |
2ff9773b |
170 | $data->{show_columns} ? { map +($_ => $_), @{$data->{columns}} } : (), |
171 | @{$data->{data}} |
483736bb |
172 | ); |
173 | [ 200, [ 'Content-type' => 'text/html' ], [ |
174 | HTML::Tags::to_html_string( |
56168e97 |
175 | <html>, <body>, "\n", |
5951d9d3 |
176 | ($data->{wrapper}||sub{@_})->( |
177 | '', <table>, "\n", |
178 | (map { my $el = $_; |
179 | ' ', <tr>, |
180 | (map { |
181 | <td>, $self->render_el($el, $_, $el->{$_}), </td> |
182 | } @{$data->{columns}}), |
183 | </tr>, "\n" |
184 | } @rows), |
185 | '', </table>, "\n", |
186 | ), |
56168e97 |
187 | </body>, </html>, "\n", |
483736bb |
188 | ) |
189 | ] ]; |
190 | } |
191 | |
2ff9773b |
192 | sub render_el { |
fa101d7f |
193 | my ($self, $whole, $key, $part) = @_; |
2ff9773b |
194 | if (ref($part) eq 'ARRAY') { |
195 | return join(', ', @$part); |
196 | } |
197 | if (ref($part) eq 'HASH') { |
b5f74ce3 |
198 | if ($whole->{key}) { |
199 | return $self->link_to($whole->{key}) |
fa101d7f |
200 | } elsif ($whole->{name}) { |
201 | return $self->link_to($whole->{name}, $key); |
b5f74ce3 |
202 | } |
203 | $part = '(complex)'; |
2ff9773b |
204 | } |
b5f74ce3 |
205 | use HTML::Tags; |
206 | return $part =~ /\n/ ? (<pre>, $part, </pre>) : $part; |
2ff9773b |
207 | } |
a7a7a4b9 |
208 | |
483736bb |
209 | __PACKAGE__->run_if_script; |