split-up refactor, better specialised diffing

[scpubgit/JSON-Tree-Viewer.git] / br.pl

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( $ENV{JTV_ROOT} || die "JTV_ROOT env var not set" )
}

sub _build_json {
  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(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 (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) = @_;
  return unless $target;
  if (blessed($target) and $target->isa('IO::All::File')) {
    my $all = $target->all;
    $target = $self->json->decode($all);
  }
  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->{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",
      ($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;