Commit | Line | Data |
483736bb |
1 | package TB_Temp_Packname; |
2 | |
3 | use Web::Simple; |
56168e97 |
4 | use Scalar::Util qw(blessed); |
5 | use IO::All; |
6 | use JSON; |
7 | |
8 | has root => (is => 'lazy'); |
9 | |
10 | has json => (is => 'lazy'); |
11 | |
12 | sub _build_root { |
13 | io->dir("/home/matthewt/tmp/introspection-data/host/services-dev/stable/node/host/") |
14 | } |
15 | |
16 | sub _build_json { |
b5f74ce3 |
17 | JSON->new->relaxed->pretty |
56168e97 |
18 | } |
483736bb |
19 | |
20 | sub dispatch_request { |
21 | my ($self) = @_; |
22 | sub () { |
23 | response_filter { |
24 | ref($_[0][0]) eq 'HASH' ? $self->render_table($_[0][0]) : $_[0] |
25 | } |
26 | }, |
2ff9773b |
27 | sub (/) { |
28 | [ $self->structure($self->root) ]; |
29 | }, |
56168e97 |
30 | sub (/**/) { |
2ff9773b |
31 | [ $self->structure($self->descend($self->root, split '/', $_[1])) ]; |
56168e97 |
32 | }, |
33 | } |
34 | |
35 | sub structure { |
36 | my ($self, $data) = @_; |
a7a7a4b9 |
37 | if (ref($data) eq 'HASH') { |
a6694990 |
38 | if (keys %$data > 1 |
39 | and values %$data == grep ref($_) eq 'HASH', values %$data) { |
40 | my %tmp; |
41 | $tmp{join '|', keys %$_} = 1 for values %$data; |
42 | if (keys %tmp == 1) { |
43 | $data->{$_}->{name} ||= $_ for keys %$data; |
b5f74ce3 |
44 | my @cols = grep $_ ne 'name', sort keys %{(values %$data)[0]}; |
45 | unshift @cols, 'name'; |
a6694990 |
46 | return { |
b5f74ce3 |
47 | columns => \@cols, |
a6694990 |
48 | show_columns => 1, |
49 | data => [ @{$data}{sort keys %$data} ], |
50 | } |
51 | } |
52 | } |
2ff9773b |
53 | return { |
54 | columns => [ 'key', 'value' ], |
55 | data => [ map +{ key => $_, value => $data->{$_} }, sort keys %$data ], |
56 | }; |
57 | } elsif (blessed($data) and $data->isa('IO::All::Dir')) { |
58 | return { |
59 | columns => [ 'name', 'explore' ], |
60 | data => [ |
61 | map +{ name => $_, explore => $self->link_to($_) }, keys %$data, |
62 | ] |
63 | }; |
56168e97 |
64 | } else { |
65 | die "Confused by $data"; |
66 | } |
67 | } |
68 | |
2ff9773b |
69 | sub link_to { |
70 | my ($self, $to) = @_; |
71 | use HTML::Tags; |
72 | my $html = join '', HTML::Tags::to_html_string( |
73 | <a href="${to}/">, "Explore $to", </a> |
74 | ); |
75 | return \$html; |
76 | } |
77 | |
56168e97 |
78 | sub descend { |
79 | my ($self, $target, @path) = @_; |
56168e97 |
80 | if (blessed($target) and $target->isa('IO::All::File')) { |
81 | $target = $self->json->decode(scalar $target->all); |
483736bb |
82 | } |
2ff9773b |
83 | return $target unless @path; |
84 | my $step = shift @path; |
a7a7a4b9 |
85 | $self->descend($target->{$step}, @path); |
483736bb |
86 | } |
87 | |
88 | sub render_table { |
89 | my ($self, $data) = @_; |
90 | use HTML::Tags; |
91 | my @rows = ( |
2ff9773b |
92 | $data->{show_columns} ? { map +($_ => $_), @{$data->{columns}} } : (), |
93 | @{$data->{data}} |
483736bb |
94 | ); |
95 | [ 200, [ 'Content-type' => 'text/html' ], [ |
96 | HTML::Tags::to_html_string( |
56168e97 |
97 | <html>, <body>, "\n", |
483736bb |
98 | <table>, "\n", |
2ff9773b |
99 | (map { my $el = $_; |
a7a7a4b9 |
100 | ' ', <tr>, |
2ff9773b |
101 | (map { |
102 | <td>, $self->render_el($el, $_), </td> |
103 | } @{$el}{@{$data->{columns}}}), |
a7a7a4b9 |
104 | </tr>, "\n" |
483736bb |
105 | } @rows), |
106 | </table>, "\n", |
56168e97 |
107 | </body>, </html>, "\n", |
483736bb |
108 | ) |
109 | ] ]; |
110 | } |
111 | |
2ff9773b |
112 | sub render_el { |
113 | my ($self, $whole, $part) = @_; |
114 | if (ref($part) eq 'ARRAY') { |
115 | return join(', ', @$part); |
116 | } |
117 | if (ref($part) eq 'HASH') { |
b5f74ce3 |
118 | if ($whole->{key}) { |
119 | return $self->link_to($whole->{key}) |
120 | } |
121 | $part = '(complex)'; |
2ff9773b |
122 | } |
b5f74ce3 |
123 | use HTML::Tags; |
124 | return $part =~ /\n/ ? (<pre>, $part, </pre>) : $part; |
2ff9773b |
125 | } |
a7a7a4b9 |
126 | |
483736bb |
127 | __PACKAGE__->run_if_script; |