lib/App/SCS/PageSet.pm

   1 package App::SCS::PageSet;
   2
   3 use Text::MultiMarkdown 'markdown';
   4 use HTML::Zoom;
   5 use Sub::Quote;
   6 use Syntax::Keyword::Gather;
   7 use App::SCS::Page;
   8 use IO::All;
   9 use Try::Tiny;
  10 use List::Util qw(reduce max);
  11 use Module::Runtime qw(use_module);
  12 use JSON::MaybeXS;
  13 use Moo;
  14 use JSONY;
  15
  16 with 'App::SCS::Role::PageChildren';
  17
  18 {
  19   my $j = JSON->new;
  20   sub _json { $j }
  21 }
  22
  23 has top_dir => (is => 'ro', lazy => 1, builder => 'base_dir');
  24 has base_dir => (is => 'ro', required => 1);
  25 has plugin_config => (is => 'ro', required => 1);
  26 has max_depth => (is => 'ro', default => quote_sub q{ 0 });
  27 has min_depth => (is => 'ro', default => quote_sub q{ 1 });
  28
  29 has rel_path => (is => 'lazy');
  30
  31 sub _build_rel_path {
  32   my ($self) = @_;
  33   io->dir('/')
  34     ->catdir(File::Spec->abs2rel($self->base_dir->name, $self->top_dir->name))
  35 }
  36
  37 sub _page_set { $_[0] }
  38 sub _page_set_class { ref($_[0]) }
  39 sub _top_dir { shift->top_dir }
  40 sub _my_path { shift->base_dir }
  41
  42 sub get {
  43   my ($self, $spec) = @_;
  44   $spec->{path} or die "path is required to get";
  45   my ($dir, $file) = $spec->{path} =~ m{^(?:(.*)/)?([^/]+)$};
  46   my $type;
  47   my @poss = io->dir($self->base_dir)->${\sub {
  48     my $io = shift;
  49     defined($dir) ? $io->catdir($dir) : $io
  50   }}->filter(sub {
  51         $_->filename =~ /^\Q${file}\E${\$self->_types_re}$/ and $type = $1
  52       })
  53     ->${\sub { -e "$_[0]" ? $_[0]->all_files : () }};
  54   die "multiple files found for ${\$spec->{path}}:\n".join "\n", @poss
  55     if @poss > 1;
  56   return undef unless @poss;
  57   $self->_inflate(
  58     $type, $self->rel_path->catdir($spec->{path}), $poss[0]
  59   );
  60 }
  61
  62 sub _config_files_for {
  63   my ($self, $path) = @_;
  64
  65   my @dir_parts = io->dir($path)->splitdir;
  66   my @dirs = map io->dir('')->catdir(@dir_parts[1..$_]), 1..($#dir_parts - 1);
  67
  68   return grep +(-f $_->name and not $_->empty),
  69            map $self->_top_dir->catfile("${_}.conf"), @dirs;
  70 }
  71
  72 sub _inflate {
  73   my ($self, $type, $path, $io) = @_;
  74   (my $cache_name = $io->name) =~ s/\/([^\/]+)$/\/.htcache.$1.json/;
  75   my $cache = io($cache_name);
  76   my @config_files = $self->_config_files_for($path);
  77   my $max_stat = max map $_->mtime, $io, @config_files;
  78
  79   if (-f $cache_name) {
  80     if ($cache->mtime >= $max_stat) {
  81       return try {
  82         $self->_new_page($path, $self->_json->decode($cache->all));
  83       } catch {
  84         die "Error inflating ${path} from cache: $_\n";
  85       }
  86     }
  87   }
  88   my $raw = $io->all;
  89   try {
  90
  91     my $extracted = $self->${\"_extract_from_${type}"}($raw);
  92     my $jsony = JSONY->new;
  93
  94     my $setup = {
  95       %$extracted,
  96       plugin_config => [
  97         map @{$jsony->load($_)}, (
  98           $extracted->{plugins},
  99           (map $_->all, reverse @config_files), # apply config deepest first
 100         )
 101       ]
 102     };
 103
 104     try {
 105         my $tmp_cache = io($cache_name . ".tmp");
 106         $tmp_cache->print($self->_json->encode($setup));
 107         $tmp_cache->rename($cache_name);
 108     };
 109
 110     $self->_new_page($path, $setup);
 111   } catch {
 112     die "Error inflating ${path} as ${type}: $_\n";
 113   }
 114 }
 115
 116 sub map {
 117   my ($self, $mapper) = @_;
 118   [ map $mapper->($_), $self->flatten ]
 119 }
 120
 121 sub _depth_under_base {
 122   my ($self, $path) = @_;
 123   File::Spec->splitdir(File::Spec->abs2rel($path, $self->base_dir->name))
 124 }
 125
 126 sub flatten {
 127   my ($self) = @_;
 128   my $slash = io->dir('/');
 129   map {
 130     my ($path, $type) = $_->name =~ /^(.*)${\$self->_types_re}$/;
 131     $self->_inflate(
 132       $type,
 133       $slash->catdir(File::Spec->abs2rel($path, $self->top_dir->name)),
 134       $_
 135     );
 136   } $self->_all_files;
 137 }
 138
 139 sub all_paths {
 140   my ($self) = @_;
 141   my $slash = io->dir('/');
 142   map {
 143     my ($path, $type) = $_->name =~ /^(.*)${\$self->_types_re}$/;
 144     $slash->catdir(File::Spec->abs2rel($path, $self->top_dir->name))->name,
 145   } $self->_all_files;
 146 }
 147
 148 sub _all_files {
 149   my ($self) = @_;
 150   return unless (my $base = $self->base_dir)->exists;
 151   my %seen;
 152   my $min = $self->min_depth;
 153   map {
 154     $_->filter(sub { $_->filename =~ /${\$self->_types_re}$/ })
 155       ->all_files($self->max_depth - ($min-1))
 156   } map
 157       $min > 1
 158         ? do {
 159             # can't use ->all_dirs($min-1) since we only want the final level
 160             my @x = ($_); @x = map $_->all_dirs, @x for 1..$min-1; @x
 161           }
 162         : $_,
 163       $base;
 164 }
 165
 166 sub latest {
 167   my ($self, $max) = @_;
 168   use_module('App::SCS::LatestPageSet')->new(
 169     parent => $self,
 170     max_entries => $max,
 171   );
 172 }
 173
 174 sub _new_page {
 175   use_module('App::SCS::Page')->new(
 176     path => $_[1], page_set => $_[0], %{$_[2]}
 177   );
 178 }
 179
 180 sub _types_re { qw/\.(html|md)/ }
 181
 182 sub _extract_from_html {
 183   my ($self, $html) = @_;
 184   my %meta;
 185   HTML::Zoom->from_html($html)
 186     ->select('title')->collect_content({ into => \my @title })
 187     ->${\sub {
 188         my $z = shift;
 189         return reduce {
 190           $a->collect("meta[name=${b}]", { into => ($meta{$b}=[]) })
 191         } $z, qw(subtitle description keywords created plugins)
 192       }}
 193     ->run;
 194   +{
 195     title => $title[0]->{raw}||'',
 196     (map +($_ => $meta{$_}[0]->{attrs}{content}||''), keys %meta),
 197     html => $html,
 198   }
 199 }
 200
 201 sub _extract_from_md {
 202   my ($self, $md) = @_;
 203
 204   my $html = markdown($md, { document_format => 'complete' });
 205
 206   $html =~ s#<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">##g;
 207   $self->_extract_from_html($html);
 208 }
 209
 210 1;