br.pl

   1 package TB_Temp_Packname;
   2
   3 use Web::Simple;
   4 use Module::Runtime qw(use_module);
   5 use Scalar::Util qw(blessed);
   6 use IO::All;
   7 use JSON;
   8 use URI::Escape;
   9
  10 has root => (is => 'lazy');
  11
  12 has json => (is => 'lazy');
  13
  14 sub _build_root {
  15   io->dir( $ENV{JTV_ROOT} || die "JTV_ROOT env var not set" )
  16 }
  17
  18 sub _build_json {
  19   JSON->new->relaxed->pretty
  20 }
  21
  22 sub dispatch_request {
  23   my ($self) = @_;
  24   sub (/raw/...) {
  25     use_module('Plack::App::Directory')->new({
  26       root => $self->root->name
  27     });
  28   },
  29   sub () {
  30     response_filter {
  31       ref($_[0][0]) eq 'HASH' ? $self->render_table($_[0][0]) : $_[0]
  32     }
  33   },
  34   sub (/) {
  35     sub (?@host=) {
  36       [ 302, [ 'Location', '/'.join('+', @{$_[1]}).'/' ], [] ];
  37     },
  38     sub () {
  39       $self->root_structure;
  40     },
  41   },
  42   sub (/**/) {
  43     $self->structure(map {
  44       s{\\/}{/}g;
  45       s{\\\\}{\\}g;
  46       $_;
  47     } split qr{(?<!\\)/}, $_[1]);
  48   },
  49 }
  50
  51 sub root_structure {
  52   my ($self) = @_;
  53   my $struct = $self->mangle_structure($self->root);
  54   push @{$struct->[0]{columns}}, 'select';
  55   foreach my $host (@{$struct->[0]{data}}) {
  56     use HTML::Tags;
  57     my $name = $host->{name};
  58     my $html = join '', HTML::Tags::to_html_string(
  59       <input type="checkbox" name="host" value="$name" />
  60     );
  61     $host->{select} = \$html;
  62   }
  63   $struct->[0]{wrapper} = sub {
  64     use HTML::Tags;
  65     '  ', <form>, "\n",
  66     (map /^\s*$/ ? "    $_" : $_, @_),
  67     '    ', <input type="submit" value="Now Multify" />, "\n",
  68     '  ', </form>, "\n"
  69   };
  70   return $struct;
  71 }
  72
  73 sub structure {
  74   my ($self, @parts) = @_;
  75   if ($parts[0] =~ /\+/) {
  76     ($parts[0], my @extra) = split /\+/, $parts[0];
  77     my $struct = $self->mangle_structure($self->descend($self->root, @parts));
  78     my $first = shift @parts;
  79     my @rest = map [ $_, $self->mangle_structure(
  80                      $self->descend($self->root, $_, @parts)
  81                    )->[0] ], @extra;
  82     unless ($struct->[0]{show_columns}) {
  83       my @cols = @{ $struct->[0]{columns} };
  84       if (@cols == 2) {
  85         my ($key_name, $value_name) = @cols;
  86         my %name;
  87         $name{ $_ }++
  88           for map $_->{$key_name},
  89               map @$_, $struct->[0]{data}, map $_->[1]{data}, @rest;
  90         my %value_by_host = (map {
  91           my $host = $_->[0];
  92           my $data = $_->[1]{data};
  93           ($host, +{
  94             map { ($_->{$key_name}, $_->{$value_name}) } @$data,
  95           });
  96         } [$first, $struct->[0]], @rest);
  97         my @hosts = ($first, @extra);
  98         return [{
  99           columns => ['key', @hosts],
 100           show_columns => 1,
 101           data => [ map {
 102             my $key = $_;
 103             +{ key => $key, (map {
 104               ($_, $value_by_host{$_}{$key});
 105             } @hosts)};
 106           } sort keys %name ],
 107         }];
 108       }
 109     }
 110     my %by_name;
 111     my %host_cols;
 112     my %complex_cols;
 113     foreach my $thing ([ $first, $struct->[0] ], @rest) {
 114       foreach my $el (@{$thing->[1]{data}}) {
 115         my $by = $by_name{$el->{name}} ||= { name => $el->{name} };
 116         foreach my $key (keys %$el) {
 117           next if $key eq 'name';
 118           if (ref($el->{$key}) eq 'HASH') {
 119             $complex_cols{$key} = 1;
 120             $by->{$key} = {};
 121           } else {
 122             my $full_key = $key.' ('.$thing->[0].')';
 123             $host_cols{$full_key} = 1;
 124             $by->{$full_key} = $el->{$key};
 125           }
 126         }
 127       }
 128     }
 129     return [{
 130       columns => [ 'name', sort(keys %host_cols), sort(keys %complex_cols) ],
 131       show_columns => 1,
 132       data => [
 133         map $by_name{$_}, sort keys %by_name
 134       ],
 135     }];
 136   }
 137   return $self->mangle_structure($self->descend($self->root, @parts));
 138 }
 139
 140 sub mangle_structure {
 141   my ($self, $data) = @_;
 142   return unless $data;
 143   if (ref($data) eq 'HASH') {
 144     if (keys %$data > 1
 145         and values %$data == grep ref($_) eq 'HASH', values %$data) {
 146       my %tmp;
 147       $tmp{join '|', keys %$_} = 1 for values %$data;
 148       if (keys %tmp == 1) {
 149         $data->{$_}->{name} ||= $_ for keys %$data;
 150         my @cols = grep $_ ne 'name', sort keys %{(values %$data)[0]};
 151         unshift @cols, 'name';
 152         return [{
 153           columns => \@cols,
 154           show_columns => 1,
 155           data => [ @{$data}{sort keys %$data} ],
 156         }]
 157       }
 158     }
 159     return [{
 160       columns => [ 'key', 'value' ],
 161       data => [ map +{ key => $_, value => $data->{$_} }, sort keys %$data ],
 162     }];
 163   } elsif (ref($data) eq 'ARRAY') {
 164     if (not grep { not ref($_) eq 'HASH' } @$data) {
 165       my %key;
 166       $key{$_} = 1
 167         for map { keys %$_ } @$data;
 168       return [{
 169         columns => [sort keys %key],
 170         show_columns => 1,
 171         data => $data,
 172       }];
 173     }
 174   } elsif (blessed($data) and $data->isa('IO::All::Dir')) {
 175     return [{
 176       columns => [ 'name', 'explore' ],
 177       data => [
 178         map +{ name => $_, explore => $self->link_to($_) }, keys %$data,
 179       ]
 180     }];
 181   } else {
 182     die "Confused by $data";
 183   }
 184 }
 185
 186 sub link_to {
 187   my ($self, @to) = @_;
 188   use HTML::Tags;
 189   my @link = map {
 190     my $link = $_;
 191     $link =~ s{\\}{\\\\}g;
 192     $link =~ s{/}{\\/}g;
 193     $link;
 194   } @to;
 195   my $link = join('/', @link, '');
 196   my $to = $to[-1];
 197   my $html = join '', HTML::Tags::to_html_string(
 198     <a href="./${link}">, "Explore $to", </a>
 199   );
 200   return \$html;
 201 }
 202
 203 sub descend {
 204   my ($self, $target, @path) = @_;
 205   return unless $target;
 206   if (blessed($target) and $target->isa('IO::All::File')) {
 207     my $all = $target->all;
 208     $target = $self->json->decode($all);
 209   }
 210   return $target unless @path;
 211   my $step = shift @path;
 212   $self->descend($target->{$step}, @path);
 213 }
 214
 215 sub render_table {
 216   my ($self, $data) = @_;
 217   use HTML::Tags;
 218   my @rows = (
 219     $data->{show_columns} ? { map +($_ => $_), @{$data->{columns}} } : (),
 220     @{$data->{data}}
 221   );
 222   [ 200, [ 'Content-type' => 'text/html' ], [
 223     HTML::Tags::to_html_string(
 224       <html>, <body>, "\n",
 225       ($data->{wrapper}||sub{@_})->(
 226         '', <table>, "\n",
 227           @rows
 228           ? (map { my $el = $_;
 229               '  ', ($el->{key} eq '__error__') ? <tr class="error"> : <tr>,
 230                 (map {
 231                   <td>, $self->render_el($el, $_, $el->{$_}), </td>
 232                 } @{$data->{columns}}),
 233               </tr>, "\n"
 234             } @rows)
 235           : (<tr class="no-rows">,
 236               <td>, 'No entries in this data structure', </td>,
 237             </tr>),
 238         '', </table>, "\n",
 239       ),
 240       </body>, </html>, "\n",
 241     )
 242   ] ];
 243 }
 244
 245 sub render_el {
 246   my ($self, $whole, $key, $part) = @_;
 247   if (ref($part) eq 'ARRAY') {
 248     if (grep { ref($_) eq 'HASH' } @$part) {
 249       if ($whole->{key}) {
 250         return $self->link_to($whole->{key})
 251       } elsif ($whole->{name}) {
 252         return $self->link_to($whole->{name}, $key);
 253       }
 254     }
 255     return join ', ', @$part
 256       if @$part < 5;
 257     use HTML::Tags;
 258     return <ul>, (map { (<li>, $_, </li>) } @$part), </ul>;
 259   }
 260   if (ref($part) eq 'HASH') {
 261     if ($whole->{key}) {
 262       return $self->link_to($whole->{key})
 263     } elsif ($whole->{name}) {
 264       return $self->link_to($whole->{name}, $key);
 265     }
 266     $part = '(complex)';
 267   }
 268   use HTML::Tags;
 269   return $part =~ /\n/ ? (<pre>, $part, </pre>) : $part;
 270 }
 271
 272 __PACKAGE__->run_if_script;