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);
  11 use Module::Runtime qw(use_module);
  12 use JSON;
  13 use Moo;
  14
  15 with 'App::SCS::Role::PageChildren';
  16
  17 {
  18   my $j = JSON->new;
  19   sub _json { $j }
  20 }
  21
  22 has top_dir => (is => 'ro', lazy => 1, builder => 'base_dir');
  23 has base_dir => (is => 'ro', required => 1);
  24 has plugin_config => (is => 'ro', required => 1);
  25 has max_depth => (is => 'ro', default => quote_sub q{ 0 });
  26 has min_depth => (is => 'ro', default => quote_sub q{ 1 });
  27
  28 has rel_path => (is => 'lazy');
  29
  30 sub _build_rel_path {
  31   my ($self) = @_;
  32   io->dir('/')
  33     ->catdir(File::Spec->abs2rel($self->base_dir->name, $self->top_dir->name))
  34 }
  35
  36 sub _page_set_class { ref($_[0]) }
  37 sub _top_dir { shift->top_dir }
  38 sub _my_path { shift->base_dir }
  39
  40 sub get {
  41   my ($self, $spec) = @_;
  42   $spec->{path} or die "path is required to get";
  43   my ($dir, $file) = $spec->{path} =~ m{^(?:(.*)/)?([^/]+)$};
  44   my $type;
  45   my @poss = io->dir($self->base_dir)->${\sub {
  46     my $io = shift;
  47     defined($dir) ? $io->catdir($dir) : $io
  48   }}->filter(sub {
  49         $_->filename =~ /^\Q${file}\E${\$self->_types_re}$/ and $type = $1
  50       })
  51     ->${\sub { -e "$_[0]" ? $_[0]->all_files : () }};
  52   die "multiple files found for ${\$spec->{path}}:\n".join "\n", @poss
  53     if @poss > 1;
  54   return undef unless @poss;
  55   $self->_inflate(
  56     $type, $self->rel_path->catdir($spec->{path}), $poss[0]
  57   );
  58 }
  59
  60 sub _inflate {
  61   my ($self, $type, $path, $io) = @_;
  62   (my $cache_name = $io->name) =~ s/\/([^\/]+)$/\/.htcache.$1.json/;
  63   my $cache = io($cache_name);
  64   if (-f $cache_name) {
  65     if ($cache->mtime >= $io->mtime) {
  66       return try {
  67         $self->_new_page($path, $self->_json->decode($cache->all));
  68       } catch {
  69         die "Error inflating ${path} from cache: $_\n";
  70       }
  71     }
  72   }
  73   my $raw = $io->all;
  74   try {
  75     my $extracted = $self->${\"_extract_from_${type}"}($raw);
  76     try { $cache->print($self->_json->encode($extracted)); };
  77     $self->_new_page($path, $extracted);
  78   } catch {
  79     die "Error inflating ${path} as ${type}: $_\n";
  80   }
  81 }
  82
  83 sub map {
  84   my ($self, $mapper) = @_;
  85   [ map $mapper->($_), $self->flatten ]
  86 }
  87
  88 sub _depth_under_base {
  89   my ($self, $path) = @_;
  90   File::Spec->splitdir(File::Spec->abs2rel($path, $self->base_dir->name))
  91 }
  92
  93 sub flatten {
  94   my ($self) = @_;
  95   my $slash = io->dir('/');
  96   map {
  97     my ($path, $type) = $_->name =~ /^(.*)${\$self->_types_re}$/;
  98     $self->_inflate(
  99       $type,
 100       $slash->catdir(File::Spec->abs2rel($path, $self->top_dir->name)),
 101       $_
 102     );
 103   } $self->_all_files;
 104 }
 105
 106 sub all_paths {
 107   my ($self) = @_;
 108   my $slash = io->dir('/');
 109   map {
 110     my ($path, $type) = $_->name =~ /^(.*)${\$self->_types_re}$/;
 111     $slash->catdir(File::Spec->abs2rel($path, $self->top_dir->name))->name,
 112   } $self->_all_files;
 113 }
 114
 115 sub _all_files {
 116   my ($self) = @_;
 117   return unless (my $base = $self->base_dir)->exists;
 118   my %seen;
 119   my $min = $self->min_depth;
 120   map {
 121     $_->filter(sub { $_->filename =~ /${\$self->_types_re}$/ })
 122       ->all_files($self->max_depth - ($min-1))
 123   } map
 124       $min > 1
 125         ? do {
 126             # can't use ->all_dirs($min-1) since we only want the final level
 127             my @x = ($_); @x = map $_->all_dirs, @x for 1..$min-1; @x
 128           }
 129         : $_,
 130       $base;
 131 }
 132
 133 sub latest {
 134   my ($self, $max) = @_;
 135   use_module('App::SCS::LatestPageSet')->new(
 136     parent => $self,
 137     max_entries => $max,
 138   );
 139 }
 140
 141 sub _new_page {
 142   use_module('App::SCS::Page')->new(
 143     path => $_[1], page_set => $_[0], %{$_[2]}
 144   );
 145 }
 146
 147 sub _types_re { qw/\.(html|md)/ }
 148
 149 sub _extract_from_html {
 150   my ($self, $html) = @_;
 151   my %meta;
 152   HTML::Zoom->from_html($html)
 153     ->select('title')->collect_content({ into => \my @title })
 154     ->${\sub {
 155         my $z = shift;
 156         return reduce {
 157           $a->collect("meta[name=${b}]", { into => ($meta{$b}=[]) })
 158         } $z, qw(subtitle description keywords created plugins)
 159       }}
 160     ->run;
 161   +{
 162     title => $title[0]->{raw}||'',
 163     (map +($_ => $meta{$_}[0]->{attrs}{content}||''), keys %meta),
 164     html => $html,
 165   }
 166 }
 167
 168 sub _extract_from_md {
 169   my ($self, $md) = @_;
 170   #warn markdown($md, { document_format => 'complete' });
 171   $self->_extract_from_html(markdown($md, { document_format => 'complete' }));
 172 }
 173
 174 1;