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