package TB_Temp_Packname;
use Web::Simple;
+use Module::Runtime qw(use_module);
use Scalar::Util qw(blessed);
use IO::All;
use JSON;
+use URI::Escape;
+use Data::Dump qw( pp );
has root => (is => 'lazy');
has json => (is => 'lazy');
sub _build_root {
- io->dir("/home/matthewt/tmp/introspection-data/host/services-dev/stable/node/host/")
+ io->dir( $ENV{JTV_ROOT} || die "JTV_ROOT env var not set" )
}
sub _build_json {
- JSON->new->relaxed
+ JSON->new->relaxed->pretty
}
sub dispatch_request {
my ($self) = @_;
+ sub (/raw/...) {
+ use_module('Plack::App::Directory')->new({
+ root => $self->root->name
+ });
+ },
sub () {
response_filter {
ref($_[0][0]) eq 'HASH' ? $self->render_table($_[0][0]) : $_[0]
}
},
+ sub (/) {
+ sub (?@host=) {
+ [ 302, [ 'Location', '/'.join('+', @{$_[1]}).'/' ], [] ];
+ },
+ sub () {
+ $self->root_structure;
+ },
+ },
sub (/**/) {
- $self->structure($self->descend($self->root, split '/', $_[1]));
+ $self->structure(map {
+ s{\\/}{/}g;
+ s{\\\\}{\\}g;
+ $_;
+ } split qr{(?<!\\)/}, $_[1]);
},
}
+sub root_structure {
+ my ($self) = @_;
+ my $struct = $self->mangle_structure($self->root);
+ push @{$struct->[0]{columns}}, 'select';
+ foreach my $host (@{$struct->[0]{data}}) {
+ use HTML::Tags;
+ my $name = $host->{name};
+ my $html = join '', HTML::Tags::to_html_string(
+ <input type="checkbox" name="host" value="$name" />
+ );
+ $host->{select} = \$html;
+ }
+ $struct->[0]{wrapper} = sub {
+ use HTML::Tags;
+ ' ', <form>, "\n",
+ (map /^\s*$/ ? " $_" : $_, @_),
+ ' ', <input type="submit" value="Now Multify" />, "\n",
+ ' ', </form>, "\n"
+ };
+ return $struct;
+}
+
+sub merge_pair_structures {
+ my ($self, $cols, @structures) = @_;
+ my ($key_name, $value_name) = @$cols;
+ my %name;
+ $name{ $_ }++
+ for map $_->{$key_name},
+ map { ($_ ? @$_ : ()) } map $_->[1]{data}, @structures;
+ my %value_by_host = (map {
+ my $host = $_->[0];
+ my $data = $_->[1]{data};
+ ($host, +{
+ map { ($_->{$key_name}, $_->{$value_name}) } @$data,
+ });
+ } @structures);
+ my @hosts = map $_->[0], @structures;
+ return [{
+ columns => ['key', @hosts],
+ show_columns => 1,
+ data => [ map {
+ my $key = $_;
+ +{ key => $key, (map {
+ ($_, $value_by_host{$_}{$key});
+ } @hosts)};
+ } sort keys %name ],
+ }];
+}
+
+sub merge_generic_structures {
+ my ($self, $cols, @structures) = @_;
+ my %by_name;
+ my %host_cols;
+ my %complex_cols;
+ my %alias;
+ my $is_explore = grep { $_ eq 'explore' } @$cols;
+ foreach my $thing (@structures) {
+ foreach my $el (@{$thing->[1]{data}}) {
+ my $by = $by_name{$el->{name}} ||= { name => $el->{name} };
+ foreach my $key (keys %$el) {
+ next if $is_explore and $key eq 'name';
+ if (ref($el->{$key}) eq 'HASH') {
+ $complex_cols{$key} = 1;
+ $by->{$key} = {};
+ } else {
+ my $full_key = $key.' ('.$thing->[0].')';
+ $alias{$full_key} = $key;
+ $host_cols{$full_key} = 1;
+ $by->{$full_key} = $el->{$key};
+ }
+ }
+ }
+ }
+ return [{
+ columns => [
+ $is_explore ? ('name') : (),
+ sort(keys %host_cols),
+ sort(keys %complex_cols),
+ ],
+ show_columns => 1,
+ aliases => \%alias,
+ data => [
+ map $by_name{$_}, sort keys %by_name
+ ],
+ }];
+}
+
+sub merge_unrelated_structures {
+ my ($self, $cols, @structures) = @_;
+ my $done = [{
+ columns => ['host', sort @$cols],
+ show_columns => 1,
+ data => [ map {
+ my ($host, $data) = @$_;
+ (map +{ host => $host, %$_ }, @{ $data->{data} || [] });
+ } @structures ],
+ }];
+ return $done;
+}
+
+sub _pred_columns_kv { @_ == 3 and $_[1] eq 'key' and $_[2] eq 'value' }
+
sub structure {
+ my ($self, @parts) = @_;
+ if ($parts[0] =~ /\+/) {
+ ($parts[0], my @extra) = split /\+/, $parts[0];
+ my $struct = $self->mangle_structure($self->descend($self->root, @parts));
+ my $first = shift @parts;
+ my @rest = map {
+ my $name = $_;
+ my $data = $self->mangle_structure(
+ $self->descend($self->root, $name, @parts),
+ );
+ [$name, $data ? $data->[0] : {}];
+ } @extra;
+ my %col;
+ $col{$_}++
+ for map { (@{$_->{columns}||[]}) }
+ $struct->[0], map $_->[1], @rest;
+ my @cols = sort keys %col;
+ my $show_cols;
+ $show_cols++
+ for grep { $_->{show_columns} }
+ $struct->[0], map $_->[1], @rest;
+ my @structures = ([$first, $struct->[0]], @rest);
+ if ($self->_pred_columns_kv(@cols)) {
+ return $self->merge_pair_structures(
+ [@cols],
+ @structures,
+ );
+ }
+ elsif (not $col{name}) {
+ return $self->merge_unrelated_structures([@cols], @structures);
+ }
+ return $self->merge_generic_structures([@cols], @structures);
+ }
+ return $self->mangle_structure($self->descend($self->root, @parts));
+}
+
+sub mangle_hash_structure {
my ($self, $data) = @_;
- if (ref($data) eq 'ARRAY') {
- my @cols = sort keys %{$data->[0]};
- return [ {
- columns => \@cols,
+ if (keys %$data > 1
+ and values %$data == grep ref($_) eq 'HASH', values %$data) {
+ my %tmp;
+ $tmp{join '|', keys %$_} = 1 for values %$data;
+ if (keys %tmp == 1) {
+ $data->{$_}->{name} ||= $_ for keys %$data;
+ my @cols = grep $_ ne 'name', sort keys %{(values %$data)[0]};
+ unshift @cols, 'name';
+ return [{
+ columns => \@cols,
+ show_columns => 1,
+ data => [ @{$data}{sort keys %$data} ],
+ }]
+ }
+ }
+ return [{
+ columns => [ 'key', 'value' ],
+ data => [ map +{ key => $_, value => $data->{$_} }, sort keys %$data ],
+ }];
+}
+
+sub mangle_array_structure {
+ my ($self, $data) = @_;
+ if (not grep { not ref($_) eq 'HASH' } @$data) {
+ my %key;
+ $key{$_} = 1
+ for map { keys %$_ } @$data;
+ return [{
+ columns => [sort keys %key],
+ show_columns => 1,
data => $data,
- } ];
+ }];
+ }
+}
+
+sub mangle_directory {
+ my ($self, $data) = @_;
+ return [{
+ columns => [ 'name', 'explore' ],
+ data => [
+ map +{ name => $_, explore => $self->link_to($_) }, keys %$data,
+ ]
+ }];
+}
+
+sub mangle_structure {
+ my ($self, $data) = @_;
+ return unless $data;
+ if (ref($data) eq 'HASH') {
+ return $self->mangle_hash_structure($data);
+ } elsif (ref($data) eq 'ARRAY') {
+ return $self->mangle_array_structure($data);
+ } elsif (blessed($data) and $data->isa('IO::All::Dir')) {
+ return $self->mangle_directory($data);
} else {
die "Confused by $data";
}
}
+sub link_to {
+ my ($self, @to) = @_;
+ use HTML::Tags;
+ my @link = map {
+ my $link = $_;
+ $link =~ s{\\}{\\\\}g;
+ $link =~ s{/}{\\/}g;
+ $link;
+ } @to;
+ my $link = join('/', @link, '');
+ my $to = $to[-1];
+ my $html = join '', HTML::Tags::to_html_string(
+ <a href="./${link}">, "Explore $to", </a>
+ );
+ return \$html;
+}
+
sub descend {
my ($self, $target, @path) = @_;
- my $step = shift @path;
+ return unless $target;
if (blessed($target) and $target->isa('IO::All::File')) {
- $target = $self->json->decode(scalar $target->all);
+ my $all = $target->all;
+ $target = $self->json->decode($all);
}
- $self->descend(::Dwarn($target->{$step}), @path);
+ return $target unless @path;
+ my $step = shift @path;
+ $self->descend($target->{$step}, @path);
}
sub render_table {
my ($self, $data) = @_;
use HTML::Tags;
my @rows = (
- $data->{columns},
- map [ @{$_}{@{$data->{columns}}} ], @{$data->{data}}
+ $data->{show_columns} ? { map +($_ => $_), @{$data->{columns}} } : (),
+ @{$data->{data}}
);
+ my $column_count = scalar @{$data->{columns}};
[ 200, [ 'Content-type' => 'text/html' ], [
HTML::Tags::to_html_string(
<html>, <body>, "\n",
- <table>, "\n",
- (map {;
- ' ', <tr>, (map { <td>, $_, </td> } @$_), </tr>, "\n"
- } @rows),
- </table>, "\n",
+ ($data->{wrapper}||sub{@_})->(
+ '', <table>, "\n",
+ (map { my $el = $_;
+ ' ', ($el->{key} eq '__error__') ? <tr class="error"> : <tr>,
+ (map {
+ <td>, $self->render_el(
+ $el,
+ $_,
+ $el->{$_},
+ $data->{aliases}{$_},
+ ), </td>
+ } @{$data->{columns}}),
+ </tr>, "\n"
+ } @rows),
+ @{$data->{data}}
+ ? ()
+ : (<tr class="no-rows">,
+ <td colspan="$column_count">,
+ 'No entries in this data structure',
+ </td>,
+ </tr>),
+ '', </table>, "\n",
+ ),
</body>, </html>, "\n",
)
] ];
}
+sub render_el {
+ my ($self, $whole, $key, $part, $alias) = @_;
+ my $link_key = defined($alias) ? $alias : $key;
+ if (ref($part) eq 'ARRAY') {
+ if (grep { ref($_) eq 'HASH' } @$part) {
+ if ($whole->{key}) {
+ return $self->link_to($whole->{key})
+ } elsif ($whole->{name}) {
+ return $self->link_to($whole->{name}, $link_key);
+ }
+ }
+ return join ', ', @$part
+ if @$part < 5;
+ use HTML::Tags;
+ return <ul>, (map { (<li>, $_, </li>) } @$part), </ul>;
+ }
+ if (ref($part) eq 'HASH') {
+ if ($whole->{key}) {
+ return $self->link_to($whole->{key})
+ } elsif ($whole->{name}) {
+ return $self->link_to($whole->{name}, $link_key);
+ }
+ $part = '(complex)';
+ }
+ use HTML::Tags;
+ return $part =~ /\n/ ? (<pre>, $part, </pre>) : $part;
+}
+
__PACKAGE__->run_if_script;
projects / scpubgit/JSON-Tree-Viewer.git / blobdiff