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