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     [ $self->structure($self->root) ];
  29   },
  30   sub (/**/) {
  31     [ $self->structure($self->descend($self->root, split '/', $_[1])) ];
  32   },
  33 }
  34
  35 sub structure {
  36   my ($self, $data) = @_;
  37   return unless $data;
  38   if (ref($data) eq 'HASH') {
  39     if (keys %$data > 1
  40         and values %$data == grep ref($_) eq 'HASH', values %$data) {
  41       my %tmp;
  42       $tmp{join '|', keys %$_} = 1 for values %$data;
  43       if (keys %tmp == 1) {
  44         $data->{$_}->{name} ||= $_ for keys %$data;
  45         my @cols = grep $_ ne 'name', sort keys %{(values %$data)[0]};
  46         unshift @cols, 'name';
  47         return [{
  48           columns => \@cols,
  49           show_columns => 1,
  50           data => [ @{$data}{sort keys %$data} ],
  51         }]
  52       }
  53     }
  54     return [{
  55       columns => [ 'key', 'value' ],
  56       data => [ map +{ key => $_, value => $data->{$_} }, sort keys %$data ],
  57     }];
  58   } elsif (blessed($data) and $data->isa('IO::All::Dir')) {
  59     return [{
  60       columns => [ 'name', 'explore' ],
  61       data => [
  62         map +{ name => $_, explore => $self->link_to($_) }, keys %$data,
  63       ]
  64     }];
  65   } else {
  66     die "Confused by $data";
  67   }
  68 }
  69
  70 sub link_to {
  71   my ($self, @to) = @_;
  72   use HTML::Tags;
  73   s/\//\./g for my @link = @to;
  74   my $link = join('/', @link, '');
  75   my $to = $to[-1];
  76   my $html = join '', HTML::Tags::to_html_string(
  77     <a href="${link}">, "Explore $to", </a>
  78   );
  79   return \$html;
  80 }
  81
  82 sub descend {
  83   my ($self, $target, @path) = @_;
  84   return unless $target;
  85   if (blessed($target) and $target->isa('IO::All::File')) {
  86     $target = $self->json->decode(scalar $target->all);
  87   }
  88   return $target unless @path;
  89   (my $undot = my $step = shift @path) =~ s/\./\//g;
  90   $self->descend($target->{$step}||$target->{$undot}, @path);
  91 }
  92
  93 sub render_table {
  94   my ($self, $data) = @_;
  95   use HTML::Tags;
  96   my @rows = (
  97     $data->{show_columns} ? { map +($_ => $_), @{$data->{columns}} } : (),
  98     @{$data->{data}}
  99   );
 100   [ 200, [ 'Content-type' => 'text/html' ], [
 101     HTML::Tags::to_html_string(
 102       <html>, <body>, "\n",
 103       <table>, "\n",
 104         (map { my $el = $_;
 105           '  ', <tr>,
 106             (map {
 107               <td>, $self->render_el($el, $_), </td>
 108             } @{$el}{@{$data->{columns}}}),
 109           </tr>, "\n"
 110         } @rows),
 111       </table>, "\n",
 112       </body>, </html>, "\n",
 113     )
 114   ] ];
 115 }
 116
 117 sub render_el {
 118   my ($self, $whole, $key, $part) = @_;
 119   if (ref($part) eq 'ARRAY') {
 120     return join(', ', @$part);
 121   }
 122   if (ref($part) eq 'HASH') {
 123     if ($whole->{key}) {
 124       return $self->link_to($whole->{key})
 125     } elsif ($whole->{name}) {
 126       return $self->link_to($whole->{name}, $key);
 127     }
 128     $part = '(complex)';
 129   }
 130   use HTML::Tags;
 131   return $part =~ /\n/ ? (<pre>, $part, </pre>) : $part;
 132 }
 133
 134 __PACKAGE__->run_if_script;