br.pl

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