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     return $struct unless $struct->[0]{show_columns};
  79     my $first = shift @parts;
  80     my @rest = map [ $_, $self->mangle_structure(
  81                      $self->descend($self->root, $_, @parts)
  82                    )->[0] ], @extra;
  83     my %by_name;
  84     my %host_cols;
  85     my %complex_cols;
  86     foreach my $thing ([ $first, $struct->[0] ], @rest) {
  87       foreach my $el (@{$thing->[1]{data}}) {
  88         my $by = $by_name{$el->{name}} ||= { name => $el->{name} };
  89         foreach my $key (keys %$el) {
  90           next if $key eq 'name';
  91           if (ref($el->{$key}) eq 'HASH') {
  92             $complex_cols{$key} = 1;
  93             $by->{$key} = {};
  94           } else {
  95             my $full_key = $key.' ('.$thing->[0].')';
  96             $host_cols{$full_key} = 1;
  97             $by->{$full_key} = $el->{$key};
  98           }
  99         }
 100       }
 101     }
 102     return [{
 103       columns => [ 'name', sort(keys %host_cols), sort(keys %complex_cols) ],
 104       show_columns => 1,
 105       data => [
 106         map $by_name{$_}, sort keys %by_name
 107       ],
 108     }];
 109   }
 110   return $self->mangle_structure($self->descend($self->root, @parts));
 111 }
 112
 113 sub mangle_structure {
 114   my ($self, $data) = @_;
 115   return unless $data;
 116   if (ref($data) eq 'HASH') {
 117     if (keys %$data > 1
 118         and values %$data == grep ref($_) eq 'HASH', values %$data) {
 119       my %tmp;
 120       $tmp{join '|', keys %$_} = 1 for values %$data;
 121       if (keys %tmp == 1) {
 122         $data->{$_}->{name} ||= $_ for keys %$data;
 123         my @cols = grep $_ ne 'name', sort keys %{(values %$data)[0]};
 124         unshift @cols, 'name';
 125         return [{
 126           columns => \@cols,
 127           show_columns => 1,
 128           data => [ @{$data}{sort keys %$data} ],
 129         }]
 130       }
 131     }
 132     return [{
 133       columns => [ 'key', 'value' ],
 134       data => [ map +{ key => $_, value => $data->{$_} }, sort keys %$data ],
 135     }];
 136   } elsif (ref($data) eq 'ARRAY') {
 137     if (not grep { not ref($_) eq 'HASH' } @$data) {
 138       my %key;
 139       $key{$_} = 1
 140         for map { keys %$_ } @$data;
 141       return [{
 142         columns => [sort keys %key],
 143         show_columns => 1,
 144         data => $data,
 145       }];
 146     }
 147   } elsif (blessed($data) and $data->isa('IO::All::Dir')) {
 148     return [{
 149       columns => [ 'name', 'explore' ],
 150       data => [
 151         map +{ name => $_, explore => $self->link_to($_) }, keys %$data,
 152       ]
 153     }];
 154   } else {
 155     die "Confused by $data";
 156   }
 157 }
 158
 159 sub link_to {
 160   my ($self, @to) = @_;
 161   use HTML::Tags;
 162   my @link = map {
 163     my $link = $_;
 164     $link =~ s{\\}{\\\\}g;
 165     $link =~ s{/}{\\/}g;
 166     $link;
 167   } @to;
 168   my $link = join('/', @link, '');
 169   my $to = $to[-1];
 170   my $html = join '', HTML::Tags::to_html_string(
 171     <a href="./${link}">, "Explore $to", </a>
 172   );
 173   return \$html;
 174 }
 175
 176 sub descend {
 177   my ($self, $target, @path) = @_;
 178   return unless $target;
 179   if (blessed($target) and $target->isa('IO::All::File')) {
 180     $target = $self->json->decode(scalar $target->all);
 181   }
 182   return $target unless @path;
 183   my $step = shift @path;
 184   $self->descend($target->{$step}, @path);
 185 }
 186
 187 sub render_table {
 188   my ($self, $data) = @_;
 189   use HTML::Tags;
 190   my @rows = (
 191     $data->{show_columns} ? { map +($_ => $_), @{$data->{columns}} } : (),
 192     @{$data->{data}}
 193   );
 194   [ 200, [ 'Content-type' => 'text/html' ], [
 195     HTML::Tags::to_html_string(
 196       <html>, <body>, "\n",
 197       ($data->{wrapper}||sub{@_})->(
 198         '', <table>, "\n",
 199           @rows
 200           ? (map { my $el = $_;
 201               '  ', ($el->{key} eq '__error__') ? <tr class="error"> : <tr>,
 202                 (map {
 203                   <td>, $self->render_el($el, $_, $el->{$_}), </td>
 204                 } @{$data->{columns}}),
 205               </tr>, "\n"
 206             } @rows)
 207           : (<tr class="no-rows">,
 208               <td>, 'No entries in this data structure', </td>,
 209             </tr>),
 210         '', </table>, "\n",
 211       ),
 212       </body>, </html>, "\n",
 213     )
 214   ] ];
 215 }
 216
 217 sub render_el {
 218   my ($self, $whole, $key, $part) = @_;
 219   if (ref($part) eq 'ARRAY') {
 220     if (grep { ref($_) eq 'HASH' } @$part) {
 221       if ($whole->{key}) {
 222         return $self->link_to($whole->{key})
 223       } elsif ($whole->{name}) {
 224         return $self->link_to($whole->{name}, $key);
 225       }
 226     }
 227     return join ', ', @$part
 228       if @$part < 5;
 229     use HTML::Tags;
 230     return <ul>, (map { (<li>, $_, </li>) } @$part), </ul>;
 231   }
 232   if (ref($part) eq 'HASH') {
 233     if ($whole->{key}) {
 234       return $self->link_to($whole->{key})
 235     } elsif ($whole->{name}) {
 236       return $self->link_to($whole->{name}, $key);
 237     }
 238     $part = '(complex)';
 239   }
 240   use HTML::Tags;
 241   return $part =~ /\n/ ? (<pre>, $part, </pre>) : $part;
 242 }
 243
 244 __PACKAGE__->run_if_script;