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 use Data::Dump qw( pp );
  10
  11 has root => (is => 'lazy');
  12
  13 has json => (is => 'lazy');
  14
  15 sub _build_root {
  16   io->dir( $ENV{JTV_ROOT} || die "JTV_ROOT env var not set" )
  17 }
  18
  19 sub _build_json {
  20   JSON->new->relaxed->pretty
  21 }
  22
  23 sub dispatch_request {
  24   my ($self) = @_;
  25   sub (/raw/...) {
  26     use_module('Plack::App::Directory')->new({
  27       root => $self->root->name
  28     });
  29   },
  30   sub () {
  31     response_filter {
  32       ref($_[0][0]) eq 'HASH' ? $self->render_table($_[0][0]) : $_[0]
  33     }
  34   },
  35   sub (/) {
  36     sub (?@host=) {
  37       [ 302, [ 'Location', '/'.join('+', @{$_[1]}).'/' ], [] ];
  38     },
  39     sub () {
  40       $self->root_structure;
  41     },
  42   },
  43   sub (/**/) {
  44     $self->structure(map {
  45       s{\\/}{/}g;
  46       s{\\\\}{\\}g;
  47       $_;
  48     } split qr{(?<!\\)/}, $_[1]);
  49   },
  50 }
  51
  52 sub root_structure {
  53   my ($self) = @_;
  54   my $struct = $self->mangle_structure($self->root);
  55   push @{$struct->[0]{columns}}, 'select';
  56   foreach my $host (@{$struct->[0]{data}}) {
  57     use HTML::Tags;
  58     my $name = $host->{name};
  59     my $html = join '', HTML::Tags::to_html_string(
  60       <input type="checkbox" name="host" value="$name" />
  61     );
  62     $host->{select} = \$html;
  63   }
  64   $struct->[0]{wrapper} = sub {
  65     use HTML::Tags;
  66     '  ', <form>, "\n",
  67     (map /^\s*$/ ? "    $_" : $_, @_),
  68     '    ', <input type="submit" value="Now Multify" />, "\n",
  69     '  ', </form>, "\n"
  70   };
  71   return $struct;
  72 }
  73
  74 sub merge_pair_structures {
  75   my ($self, $cols, @structures) = @_;
  76   my ($key_name, $value_name) = @$cols;
  77   my %name;
  78   $name{ $_ }++
  79     for map $_->{$key_name},
  80         map { ($_ ? @$_ : ()) } map $_->[1]{data}, @structures;
  81   my %value_by_host = (map {
  82     my $host = $_->[0];
  83     my $data = $_->[1]{data};
  84     ($host, +{
  85       map { ($_->{$key_name}, $_->{$value_name}) } @$data,
  86     });
  87   } @structures);
  88   my @hosts = map $_->[0], @structures;
  89   return [{
  90     columns => ['key', @hosts],
  91     show_columns => 1,
  92     data => [ map {
  93       my $key = $_;
  94       +{ key => $key, (map {
  95         ($_, $value_by_host{$_}{$key});
  96       } @hosts)};
  97     } sort keys %name ],
  98   }];
  99 }
 100
 101 sub merge_generic_structures {
 102   my ($self, $cols, @structures) = @_;
 103   my %by_name;
 104   my %host_cols;
 105   my %complex_cols;
 106   my %alias;
 107   my $is_explore = grep { $_ eq 'explore' } @$cols;
 108   foreach my $thing (@structures) {
 109     foreach my $el (@{$thing->[1]{data}}) {
 110       my $by = $by_name{$el->{name}} ||= { name => $el->{name} };
 111       foreach my $key (keys %$el) {
 112         next if $is_explore and $key eq 'name';
 113         if (ref($el->{$key}) eq 'HASH') {
 114           $complex_cols{$key} = 1;
 115           $by->{$key} = {};
 116         } else {
 117           my $full_key = $key.' ('.$thing->[0].')';
 118           $alias{$full_key} = $key;
 119           $host_cols{$full_key} = 1;
 120           $by->{$full_key} = $el->{$key};
 121         }
 122       }
 123     }
 124   }
 125   return [{
 126     columns => [
 127       $is_explore ? ('name') : (),
 128       sort(keys %host_cols),
 129       sort(keys %complex_cols),
 130     ],
 131     show_columns => 1,
 132     aliases => \%alias,
 133     data => [
 134       map $by_name{$_}, sort keys %by_name
 135     ],
 136   }];
 137 }
 138
 139 sub merge_unrelated_structures {
 140   my ($self, $cols, @structures) = @_;
 141   my $done = [{
 142     columns => ['host', sort @$cols],
 143     show_columns => 1,
 144     data => [ map {
 145       my ($host, $data) = @$_;
 146       (map +{ host => $host, %$_ }, @{ $data->{data} || [] });
 147     } @structures ],
 148   }];
 149   return $done;
 150 }
 151
 152 sub _pred_columns_kv { @_ == 3 and $_[1] eq 'key' and $_[2] eq 'value' }
 153
 154 sub structure {
 155   my ($self, @parts) = @_;
 156   if ($parts[0] =~ /\+/) {
 157     ($parts[0], my @extra) = split /\+/, $parts[0];
 158     my $struct = $self->mangle_structure($self->descend($self->root, @parts));
 159     my $first = shift @parts;
 160     my @rest = map {
 161       my $name = $_;
 162       my $data = $self->mangle_structure(
 163         $self->descend($self->root, $name, @parts),
 164       );
 165       [$name, $data ? $data->[0] : {}];
 166     } @extra;
 167     my %col;
 168     $col{$_}++
 169       for map { (@{$_->{columns}||[]}) }
 170           $struct->[0], map $_->[1], @rest;
 171     my @cols = sort keys %col;
 172     my $show_cols;
 173     $show_cols++
 174       for grep { $_->{show_columns} }
 175           $struct->[0], map $_->[1], @rest;
 176     my @structures = ([$first, $struct->[0]], @rest);
 177     if ($self->_pred_columns_kv(@cols)) {
 178       return $self->merge_pair_structures(
 179         [@cols],
 180         @structures,
 181       );
 182     }
 183     elsif (not $col{name}) {
 184       return $self->merge_unrelated_structures([@cols], @structures);
 185     }
 186     return $self->merge_generic_structures([@cols], @structures);
 187   }
 188   return $self->mangle_structure($self->descend($self->root, @parts));
 189 }
 190
 191 sub mangle_hash_structure {
 192   my ($self, $data) = @_;
 193   if (keys %$data > 1
 194       and values %$data == grep ref($_) eq 'HASH', values %$data) {
 195     my %tmp;
 196     $tmp{join '|', keys %$_} = 1 for values %$data;
 197     if (keys %tmp == 1) {
 198       $data->{$_}->{name} ||= $_ for keys %$data;
 199       my @cols = grep $_ ne 'name', sort keys %{(values %$data)[0]};
 200       unshift @cols, 'name';
 201       return [{
 202         columns => \@cols,
 203         show_columns => 1,
 204         data => [ @{$data}{sort keys %$data} ],
 205       }]
 206     }
 207   }
 208   return [{
 209     columns => [ 'key', 'value' ],
 210     data => [ map +{ key => $_, value => $data->{$_} }, sort keys %$data ],
 211   }];
 212 }
 213
 214 sub mangle_array_structure {
 215   my ($self, $data) = @_;
 216   if (not grep { not ref($_) eq 'HASH' } @$data) {
 217     my %key;
 218     $key{$_} = 1
 219       for map { keys %$_ } @$data;
 220     return [{
 221       columns => [sort keys %key],
 222       show_columns => 1,
 223       data => $data,
 224     }];
 225   }
 226 }
 227
 228 sub mangle_directory {
 229   my ($self, $data) = @_;
 230   return [{
 231     columns => [ 'name', 'explore' ],
 232     data => [
 233       map +{ name => $_, explore => $self->link_to($_) }, keys %$data,
 234     ]
 235   }];
 236 }
 237
 238 sub mangle_structure {
 239   my ($self, $data) = @_;
 240   return unless $data;
 241   if (ref($data) eq 'HASH') {
 242     return $self->mangle_hash_structure($data);
 243   } elsif (ref($data) eq 'ARRAY') {
 244     return $self->mangle_array_structure($data);
 245   } elsif (blessed($data) and $data->isa('IO::All::Dir')) {
 246     return $self->mangle_directory($data);
 247   } else {
 248     die "Confused by $data";
 249   }
 250 }
 251
 252 sub link_to {
 253   my ($self, @to) = @_;
 254   use HTML::Tags;
 255   my @link = map {
 256     my $link = $_;
 257     $link =~ s{\\}{\\\\}g;
 258     $link =~ s{/}{\\/}g;
 259     $link;
 260   } @to;
 261   my $link = join('/', @link, '');
 262   my $to = $to[-1];
 263   my $html = join '', HTML::Tags::to_html_string(
 264     <a href="./${link}">, "Explore $to", </a>
 265   );
 266   return \$html;
 267 }
 268
 269 sub descend {
 270   my ($self, $target, @path) = @_;
 271   return unless $target;
 272   if (blessed($target) and $target->isa('IO::All::File')) {
 273     my $all = $target->all;
 274     $target = $self->json->decode($all);
 275   }
 276   return $target unless @path;
 277   my $step = shift @path;
 278   $self->descend($target->{$step}, @path);
 279 }
 280
 281 sub render_table {
 282   my ($self, $data) = @_;
 283   use HTML::Tags;
 284   my @rows = (
 285     $data->{show_columns} ? { map +($_ => $_), @{$data->{columns}} } : (),
 286     @{$data->{data}}
 287   );
 288   my $column_count = scalar @{$data->{columns}};
 289   [ 200, [ 'Content-type' => 'text/html' ], [
 290     HTML::Tags::to_html_string(
 291       <html>, <body>, "\n",
 292       ($data->{wrapper}||sub{@_})->(
 293         '', <table>, "\n",
 294           (map { my $el = $_;
 295             '  ', ($el->{key} eq '__error__') ? <tr class="error"> : <tr>,
 296               (map {
 297                 <td>, $self->render_el(
 298                   $el,
 299                   $_,
 300                   $el->{$_},
 301                   $data->{aliases}{$_},
 302                 ), </td>
 303               } @{$data->{columns}}),
 304             </tr>, "\n"
 305           } @rows),
 306           @{$data->{data}}
 307           ? ()
 308           : (<tr class="no-rows">,
 309               <td colspan="$column_count">,
 310                 'No entries in this data structure',
 311               </td>,
 312             </tr>),
 313         '', </table>, "\n",
 314       ),
 315       </body>, </html>, "\n",
 316     )
 317   ] ];
 318 }
 319
 320 sub render_el {
 321   my ($self, $whole, $key, $part, $alias) = @_;
 322   my $link_key = defined($alias) ? $alias : $key;
 323   if (ref($part) eq 'ARRAY') {
 324     if (grep { ref($_) eq 'HASH' } @$part) {
 325       if ($whole->{key}) {
 326         return $self->link_to($whole->{key})
 327       } elsif ($whole->{name}) {
 328         return $self->link_to($whole->{name}, $link_key);
 329       }
 330     }
 331     return join ', ', @$part
 332       if @$part < 5;
 333     use HTML::Tags;
 334     return <ul>, (map { (<li>, $_, </li>) } @$part), </ul>;
 335   }
 336   if (ref($part) eq 'HASH') {
 337     if ($whole->{key}) {
 338       return $self->link_to($whole->{key})
 339     } elsif ($whole->{name}) {
 340       return $self->link_to($whole->{name}, $link_key);
 341     }
 342     $part = '(complex)';
 343   }
 344   use HTML::Tags;
 345   return $part =~ /\n/ ? (<pre>, $part, </pre>) : $part;
 346 }
 347
 348 __PACKAGE__->run_if_script;