X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=br.pl;h=5f65726fe87064e030e80c3f7be543829cb8697e;hb=HEAD;hp=2c63bd166dbff9850bf84e803301083b7323df87;hpb=8347d3a1f3cbea26ffec25a3cb8dadf44ba37ad3;p=scpubgit%2FJSON-Tree-Viewer.git

diff --git a/br.pl b/br.pl
index 2c63bd1..5f65726 100644
--- a/br.pl
+++ b/br.pl
@@ -6,6 +6,7 @@ use Scalar::Util qw(blessed);
 use IO::All;
 use JSON;
 use URI::Escape;
+use Data::Dump qw( pp );
 
 has root => (is => 'lazy');
 
@@ -40,7 +41,11 @@ sub dispatch_request {
     },
   },
   sub (/**/) {
-    $self->structure(split '/', $_[1]);
+    $self->structure(map {
+      s{\\/}{/}g;
+      s{\\\\}{\\}g;
+      $_;
+    } split qr{(?<!\\)/}, $_[1]);
   },
 }
 
@@ -66,87 +71,179 @@ sub root_structure {
   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));
-    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};
-          }
-        }
-      }
+    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 (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 => [ 'name', sort(keys %host_cols), sort(keys %complex_cols) ],
+      columns => [sort keys %key],
       show_columns => 1,
-      data => [
-        map $by_name{$_}, sort keys %by_name
-      ],
+      data => $data,
     }];
   }
-  return $self->mangle_structure($self->descend($self->root, @parts));
+}
+
+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') {
-    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 ],
-    }];
+    return $self->mangle_hash_structure($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,
-      }];
-    }
+    return $self->mangle_array_structure($data);
   } elsif (blessed($data) and $data->isa('IO::All::Dir')) {
-    return [{
-      columns => [ 'name', 'explore' ],
-      data => [
-        map +{ name => $_, explore => $self->link_to($_) }, keys %$data,
-      ]
-    }];
+    return $self->mangle_directory($data);
   } else {
     die "Confused by $data";
   }
@@ -155,11 +252,16 @@ sub mangle_structure {
 sub link_to {
   my ($self, @to) = @_;
   use HTML::Tags;
-  my @link = map uri_escape(uri_escape($_)), @to;
+  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>
+    <a href="./${link}">, "Explore $to", </a>
   );
   return \$html;
 }
@@ -168,10 +270,11 @@ sub descend {
   my ($self, $target, @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);
   }
   return $target unless @path;
-  my $step = uri_unescape(uri_unescape( shift @path));
+  my $step = shift @path;
   $self->descend($target->{$step}, @path);
 }
 
@@ -182,6 +285,7 @@ sub render_table {
     $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",
@@ -190,10 +294,22 @@ sub render_table {
           (map { my $el = $_;
             '  ', ($el->{key} eq '__error__') ? <tr class="error"> : <tr>,
               (map {
-                <td>, $self->render_el($el, $_, $el->{$_}), </td>
+                <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",
@@ -202,23 +318,26 @@ sub render_table {
 }
 
 sub render_el {
-  my ($self, $whole, $key, $part) = @_;
+  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}, $key);
+        return $self->link_to($whole->{name}, $link_key);
       }
-      $part = '(complex)';
     }
-    return join(', ', @$part);
+    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);
+      return $self->link_to($whole->{name}, $link_key);
     }
     $part = '(complex)';
   }