X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=br.pl;h=1181443dcc895cd598db7a6bcaa9ecc96afcae7f;hb=5af88d19ca808d9f8b1e3898e93bedfd0a2b39a3;hp=6ac30cc34351a3c56acebf76823cb2166aa3a32f;hpb=a7a7a4b960d599b530856a1499d2aacb414aa9ba;p=scpubgit%2FJSON-Tree-Viewer.git

diff --git a/br.pl b/br.pl
index 6ac30cc..1181443 100644
--- a/br.pl
+++ b/br.pl
@@ -1,55 +1,186 @@
 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;
 
 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 structure {
+  my ($self, @parts) = @_;
+  if ($parts[0] =~ /\+/) {
+    ($parts[0], my @extra) = split /\+/, $parts[0];
+    my $struct = $self->mangle_structure($self->descend($self->root, @parts));
+    return $struct unless $struct->[0]{show_columns};
+    my $first = shift @parts;
+    my @rest = map [ $_, $self->mangle_structure(
+                     $self->descend($self->root, $_, @parts)
+                   )->[0] ], @extra;
+    my %by_name;
+    my %host_cols;
+    my %complex_cols;
+    foreach my $thing ([ $first, $struct->[0] ], @rest) {
+      foreach my $el (@{$thing->[1]{data}}) {
+        my $by = $by_name{$el->{name}} ||= { name => $el->{name} };
+        foreach my $key (keys %$el) {
+          next if $key eq 'name';
+          if (ref($el->{$key}) eq 'HASH') {
+            $complex_cols{$key} = 1;
+            $by->{$key} = {};
+          } else {
+            my $full_key = $key.' ('.$thing->[0].')';
+            $host_cols{$full_key} = 1;
+            $by->{$full_key} = $el->{$key};
+          }
+        }
+      }
+    }
+    return [{
+      columns => [ 'name', sort(keys %host_cols), sort(keys %complex_cols) ],
+      show_columns => 1,
+      data => [
+        map $by_name{$_}, sort keys %by_name
+      ],
+    }];
+  }
+  return $self->mangle_structure($self->descend($self->root, @parts));
+}
+
+sub mangle_structure {
   my ($self, $data) = @_;
+  return unless $data;
   if (ref($data) eq 'HASH') {
-    $data = [ @{$data}{sort keys %$data} ];
-    my @cols = sort keys %{$data->[0]};
-    return [ {
-      columns => \@cols,
-      data => $data,
-    } ];
+    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 ],
+    }];
+  } elsif (ref($data) eq 'ARRAY') {
+    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,
+      }];
+    }
+  } elsif (blessed($data) and $data->isa('IO::All::Dir')) {
+    return [{
+      columns => [ 'name', 'explore' ],
+      data => [
+        map +{ name => $_, explore => $self->link_to($_) }, keys %$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) = @_;
-  return $target unless @path;
-  my $step = shift @path;
+  return unless $target;
   if (blessed($target) and $target->isa('IO::All::File')) {
     $target = $self->json->decode(scalar $target->all);
   }
+  return $target unless @path;
+  my $step = shift @path;
   $self->descend($target->{$step}, @path);
 }
 
@@ -57,24 +188,57 @@ 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}}
   );
   [ 200, [ 'Content-type' => 'text/html' ], [
     HTML::Tags::to_html_string(
       <html>, <body>, "\n",
-      <table>, "\n",
-        (map {;
-          '  ', <tr>,
-            (map { <td>, $self->render_el($_), </td> } @$_),
-          </tr>, "\n"
-        } @rows),
-      </table>, "\n",
+      ($data->{wrapper}||sub{@_})->(
+        '', <table>, "\n",
+          @rows
+          ? (map { my $el = $_;
+              '  ', ($el->{key} eq '__error__') ? <tr class="error"> : <tr>,
+                (map {
+                  <td>, $self->render_el($el, $_, $el->{$_}), </td>
+                } @{$data->{columns}}),
+              </tr>, "\n"
+            } @rows)
+          : (<tr class="no-rows">,
+              <td>, 'No entries in this data structure', </td>,
+            </tr>),
+        '', </table>, "\n",
+      ),
       </body>, </html>, "\n",
     )
   ] ];
 }
 
-sub render_el { ref($_[1]) eq 'ARRAY' ? join(', ', @{$_[1]}) : $_[1] }
+sub render_el {
+  my ($self, $whole, $key, $part) = @_;
+  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}, $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}, $key);
+    }
+    $part = '(complex)';
+  }
+  use HTML::Tags;
+  return $part =~ /\n/ ? (<pre>, $part, </pre>) : $part;
+}
 
 __PACKAGE__->run_if_script;