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