Remove silly DOCTYPE

[scpubgit/App-SCS.git] / lib / App / SCS / PageSet.pm

package App::SCS::PageSet;

use Text::MultiMarkdown 'markdown';
use HTML::Zoom;
use Sub::Quote;
use Syntax::Keyword::Gather;
use App::SCS::Page;
use IO::All;
use Try::Tiny;
use List::Util qw(reduce max);
use Module::Runtime qw(use_module);
use JSON::MaybeXS;
use Moo;
use JSONY;

with 'App::SCS::Role::PageChildren';

{
  my $j = JSON->new;
  sub _json { $j }
}

has top_dir => (is => 'ro', lazy => 1, builder => 'base_dir');
has base_dir => (is => 'ro', required => 1);
has plugin_config => (is => 'ro', required => 1);
has max_depth => (is => 'ro', default => quote_sub q{ 0 });
has min_depth => (is => 'ro', default => quote_sub q{ 1 });

has rel_path => (is => 'lazy');

sub _build_rel_path {
  my ($self) = @_;
  io->dir('/')
    ->catdir(File::Spec->abs2rel($self->base_dir->name, $self->top_dir->name))
}

sub _page_set { $_[0] }
sub _page_set_class { ref($_[0]) }
sub _top_dir { shift->top_dir }
sub _my_path { shift->base_dir }

sub get {
  my ($self, $spec) = @_;
  $spec->{path} or die "path is required to get";
  my ($dir, $file) = $spec->{path} =~ m{^(?:(.*)/)?([^/]+)$};
  my $type;
  my @poss = io->dir($self->base_dir)->${\sub {
    my $io = shift;
    defined($dir) ? $io->catdir($dir) : $io
  }}->filter(sub {
        $_->filename =~ /^\Q${file}\E${\$self->_types_re}$/ and $type = $1
      })
    ->${\sub { -e "$_[0]" ? $_[0]->all_files : () }};
  die "multiple files found for ${\$spec->{path}}:\n".join "\n", @poss
    if @poss > 1;
  return undef unless @poss;
  $self->_inflate(
    $type, $self->rel_path->catdir($spec->{path}), $poss[0]
  );
}

sub _config_files_for {
  my ($self, $path) = @_;

  my @dir_parts = io->dir($path)->splitdir;
  my @dirs = map io->dir('')->catdir(@dir_parts[1..$_]), 1..($#dir_parts - 1);

  return grep +(-f $_->name and not $_->empty),
           map $self->_top_dir->catfile("${_}.conf"), @dirs;
}

sub _inflate {
  my ($self, $type, $path, $io) = @_;
  (my $cache_name = $io->name) =~ s/\/([^\/]+)$/\/.htcache.$1.json/;
  my $cache = io($cache_name);
  my @config_files = $self->_config_files_for($path);
  my $max_stat = max map $_->mtime, $io, @config_files;

  if (-f $cache_name) {
    if ($cache->mtime >= $max_stat) {
      return try {
        $self->_new_page($path, $self->_json->decode($cache->all));
      } catch {
        die "Error inflating ${path} from cache: $_\n";
      }
    }
  }
  my $raw = $io->all;
  try {

    my $extracted = $self->${\"_extract_from_${type}"}($raw);
    my $jsony = JSONY->new;

    my $setup = {
      %$extracted,
      plugin_config => [
        map @{$jsony->load($_)}, (
          $extracted->{plugins},
          (map $_->all, reverse @config_files), # apply config deepest first
        )
      ]
    };

    try {
        my $tmp_cache = io($cache_name . ".tmp");
        $tmp_cache->print($self->_json->encode($setup));
        $tmp_cache->rename($cache_name);
    };

    $self->_new_page($path, $setup);
  } catch {
    die "Error inflating ${path} as ${type}: $_\n";
  }
}

sub map {
  my ($self, $mapper) = @_;
  [ map $mapper->($_), $self->flatten ]
}

sub _depth_under_base {
  my ($self, $path) = @_;
  File::Spec->splitdir(File::Spec->abs2rel($path, $self->base_dir->name))
}

sub flatten {
  my ($self) = @_;
  my $slash = io->dir('/');
  map {
    my ($path, $type) = $_->name =~ /^(.*)${\$self->_types_re}$/;
    $self->_inflate(
      $type,
      $slash->catdir(File::Spec->abs2rel($path, $self->top_dir->name)),
      $_
    );
  } $self->_all_files;
}

sub all_paths {
  my ($self) = @_;
  my $slash = io->dir('/');
  map {
    my ($path, $type) = $_->name =~ /^(.*)${\$self->_types_re}$/;
    $slash->catdir(File::Spec->abs2rel($path, $self->top_dir->name))->name,
  } $self->_all_files;
}

sub _all_files {
  my ($self) = @_;
  return unless (my $base = $self->base_dir)->exists;
  my %seen;
  my $min = $self->min_depth;
  map {
    $_->filter(sub { $_->filename =~ /${\$self->_types_re}$/ })
      ->all_files($self->max_depth - ($min-1))
  } map
      $min > 1
        ? do {
            # can't use ->all_dirs($min-1) since we only want the final level
            my @x = ($_); @x = map $_->all_dirs, @x for 1..$min-1; @x
          }
        : $_,
      $base;
}

sub latest {
  my ($self, $max) = @_;
  use_module('App::SCS::LatestPageSet')->new(
    parent => $self,
    max_entries => $max,
  );
}

sub _new_page {
  use_module('App::SCS::Page')->new(
    path => $_[1], page_set => $_[0], %{$_[2]}
  );
}

sub _types_re { qw/\.(html|md)/ }

sub _extract_from_html {
  my ($self, $html) = @_;
  my %meta;
  HTML::Zoom->from_html($html)
    ->select('title')->collect_content({ into => \my @title })
    ->${\sub {
        my $z = shift;
        return reduce {
          $a->collect("meta[name=${b}]", { into => ($meta{$b}=[]) })
        } $z, qw(subtitle description keywords created plugins)
      }}
    ->run;
  +{
    title => $title[0]->{raw}||'',
    (map +($_ => $meta{$_}[0]->{attrs}{content}||''), keys %meta),
    html => $html,
  }
}

sub _extract_from_md {
  my ($self, $md) = @_;

  my $html = markdown($md, { document_format => 'complete' });

  $html =~ s#<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">##g;
  $self->_extract_from_html($html);
}

1;