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