--- /dev/null
+package App::SCS;
+
+use Module::Runtime qw(use_module);
+use IO::All;
+use Moo;
+
+with 'App::SCS::Role::WithConfig';
+
+has plugins => (is => 'ro', default => sub { [] });
+
+has pages => (is => 'lazy');
+
+sub _build_pages {
+ my ($self) = @_;
+ return use_module('App::SCS::PageSet')->new(
+ base_dir => io->dir($self->config->{share_dir})->catdir('pages'),
+ plugin_config => {
+ plugin_map => {
+ map $_->page_plugins, reverse @{$self->plugins}
+ },
+ defaults => [
+ map $_->default_page_plugins, @{$self->plugins}
+ ],
+ }
+ );
+}
+
+has web => (is => 'lazy');
+
+sub _build_web {
+ my ($self) = @_;
+ return use_module('App::SCS::Web')->new(
+ app => $self
+ );
+}
+
+sub BUILD {
+ my ($self) = @_;
+ $self->load_plugin(Core => {});
+ foreach my $spec (@{$self->config->{plugins}||[]}) {
+ $self->load_plugin(@$spec);
+ }
+}
+
+sub load_plugin {
+ my ($self, $name, $config) = @_;
+ push(
+ @{$self->plugins},
+ use_module("App::SCS::Plugin::${name}")->new(
+ app => $self,
+ config => $config
+ )
+ );
+ return;
+}
+
+1;
--- /dev/null
+package App::SCS::Page;
+
+use IO::All;
+use Time::Local qw(timelocal);
+use Data::Pond qw(pond_read_datum pond_write_datum);
+use List::Util qw(reduce);
+use Moo;
+
+with 'App::SCS::Role::PageChildren';
+
+has $_ => (is => 'ro') for qw(
+ title subtitle description keywords plugins html created path
+);
+
+has plugin_config => (is => 'lazy');
+
+sub _build_plugin_config {
+ my ($self) = @_;
+ $self->plugins
+ ? pond_read_datum('[ '.$self->plugins.' ]')
+ : []
+}
+
+sub has_plugin_config { exists $_[0]->plugin_config->{$_[1]} }
+
+sub with_plugin_config {
+ my ($self, $with_name, $with_config) = @_;
+ my @orig = @{$self->plugin_config};
+ my @new;
+ while (my ($name, $config) = splice @orig, 0, 2) {
+ push @new, (
+ $name eq $with_name
+ ? ($name, { %$config, %$with_config })
+ : ($name, $config)
+ );
+ }
+ return $self->with(plugins => pond_write_datum(\@new));
+}
+
+has _page_plugins => (is => 'lazy');
+
+sub _build__page_plugins {
+ my ($self) = @_;
+ my $plugin_config = $self->plugin_config;
+ my ($plugin_map, $defaults) = @{$self->_page_set}{qw(plugin_map defaults)};
+
+ my @spec = (@$defaults, @$plugin_config);
+ my @plugins;
+ while (my ($name, $config) = splice @spec, 0, 2) {
+ my $info = $plugin_map->{$name};
+ push @plugins,
+ use_module($info->{class})->new(
+ %{$info->{config}||{}}, %$config, page => $self
+ );
+ }
+ return \@plugins;
+}
+
+sub published_at {
+ $_[0]->created
+ ? scalar localtime timelocal
+ map +(@{$_}[0..3], $_->[4]-1, $_->[5]-1900),
+ [ reverse split '\D+', $_[0]->created ]
+ : ''
+}
+
+has "_$_" => (is => 'ro', init_arg => $_) for qw(page_set);
+
+sub _page_set_class { ref($_[0]->_page_set) }
+sub _top_dir { $_[0]->_page_set->top_dir }
+sub _my_path { io->dir($_[0]->_top_dir)->catdir($_[0]->path) }
+
+sub to_app {
+ my ($self) = @_;
+ return sub { $self->to_psgi_response(@_) };
+}
+
+sub to_psgi_response {
+ my ($self, $env) = @_;
+
+ if (my $cb = $env->{'App::SCS::Command::Generate.extra_pages'}) {
+ $cb->($_->extra_pages) for @{$self->page_plugins};
+ }
+
+ $self->_psgi_response;
+}
+
+has _psgi_response => (is => 'lazy');
+
+sub _build__psgi_response {
+ my ($self) = @_;
+
+ my @plugins = @{$self->page_plugins};
+
+ my $html_zoom = reduce {
+ $b->filter_html_zoom($a)
+ } HTML::Zoom->from_html($self->html), @plugins;
+
+ my $content_zoom = reduce {
+ $b->filter_content_zoom($a)
+ } $html_zoom, @plugins;
+
+ my $psgi_res = [
+ 200, [ 'Content-type' => 'text/html' ], $content_zoom->to_fh
+ ];
+
+ return reduce {
+ $b->filter_psgi_response($a)
+ } $psgi_res, @plugins;
+}
+
+no Moo;
+
+sub with {
+ my $self = shift;
+ return ref($self)->new(%$self, @_);
+}
+
+1;
--- /dev/null
+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);
+use JSON;
+use Moo;
+
+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_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 _inflate {
+ my ($self, $type, $path, $io) = @_;
+ (my $cache_name = $io->name) =~ s/\/([^\/]+)$/\/.htcache.$1.json/;
+ my $cache = io($cache_name);
+ if (-f $cache_name) {
+ if ($cache->mtime >= $io->mtime) {
+ 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);
+ try { $cache->print($self->_json->encode($extracted)); };
+ $self->_new_page($path, $extracted);
+ } 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) = @_;
+ require SCSite::LatestPageSet;
+ SCSite::LatestPageSet->new(
+ parent => $self,
+ max_entries => $max,
+ );
+}
+
+sub _new_page {
+ SCSite::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) = @_;
+ #warn markdown($md, { document_format => 'complete' });
+ $self->_extract_from_html(markdown($md, { document_format => 'complete' }));
+}
+
+1;
--- /dev/null
+package App::SCS::Plugin::Archives;
+
+use Moo;
+no warnings::illegalproto;
+
+with 'App::SCS::Role::Plugin';
+
+sub page_plugins {
+ Archive => 'App::SCS::Plugin::Archive::PagePlugin'
+}
+
+sub page_dispatchers {
+ my ($self) = @_;
+ sub (/**:path/old/:page) {
+ return unless $_{page} =~ /^\d+$/;
+ if (my $page = $self->pages->get({ path => $_{path} })) {
+ if ($page->has_plugin_config('Archive')) {
+ return $page->with(path => $_{path})
+ ->with_plugin_config(Archive => { page => $_{page} });
+ }
+ }
+ return;
+ }
+}
+
+1;
--- /dev/null
+package App::SCS::Plugin::Core;
+
+use Moo;
+no warnings::illegalproto;
+use Safe::Isa;
+
+with 'App::SCS::Role::Plugin';
+
+has templates => (is => 'lazy');
+
+sub _build_templates {
+ my ($self) = @_;
+ return use_module('App::SCS::PageSet')->new(
+ base_dir => io->dir($self->app->config->{share_dir})->catdir('templates'),
+ );
+}
+
+has includes => (is => 'lazy');
+
+sub _build_includes {
+ my ($self) = @_;
+ return use_module('App::SCS::PageSet')->new(
+ base_dir => io->dir($self->app->config->{share_dir})->catdir('includes'),
+ );
+}
+
+sub page_plugins {
+ my ($self) = @_;
+ PageList => 'App::SCS::Plugin::Core::PagePlugin::PageList',
+ Template => {
+ class => 'App::SCS::Plugin::Core::PagePlugin::Template',
+ config => { templates => $self->templates },
+ },
+ Include => {
+ class => 'App::SCS::Plugin::Core::PagePlugin::Include',
+ config => { includes => $self->includes },
+ },
+ PageData => 'App::SCS::Plugin::Core::PagePlugin::PageData',
+}
+
+sub default_page_plugins {
+ Template => {
+ name => 'layout',
+ },
+ PageData => {},
+}
+
+sub page_dispatchers {
+ my ($self) = @_;
+ sub (/) {
+ $self->pages->get({ path => 'index' });
+ },
+ sub (/**) {
+ [ 302, [ 'Location' => "/$_[1]/" ], [] ]
+ },
+ sub (/**:path/) {
+ $self->pages->get({ %_ })
+ },
+ sub () {
+ $self->pages
+ ->get({ path => 'error_404' })
+ ->$_call_if_object(with_plugin_config => Status => 404);
+ },
+}
+
+1;
--- /dev/null
+package App::SCS::Plugin::Core::PagePlugin::PageData;
+
+use Moo;
+
+with 'App::SCS::Role::PagePlugin';
+
+sub filter_content_zoom {
+ my ($self, $zoom) = @_;
+ my $page = $self->page;
+ $zoom->select('.page.title')->replace_content($page->title)
+ ->select('.page.subtitle')->${\sub {
+ $page->subtitle
+ ? $_[0]->replace_content($page->subtitle)
+ : $_[0]->replace('')
+ }}
+ ->select('.page.published_at')->replace_content($page->published_at)
+ ->select('meta[name=description]')
+ ->set_attribute(content => $page->description)
+ ->select('meta[name=keywords]')
+ ->set_attribute(content => $page->keywords)
+ ->select('meta[name=created]')
+ ->set_attribute(content => $page->created);
+}
+
+1;
--- /dev/null
+package App::SCS::Plugin::Core::PagePlugin::Template;
+
+use Moo;
+
+with 'App::SCS::Role::PagePlugin';
+
+has templates => (is => 'ro', required => 1);
+
+has name => (is => 'ro', required => 1);
+
+sub filter_html_zoom {
+ my ($self, $zoom) = @_;
+ my $template_page = $self->templates->get({ path => $self->name })
+ or die "No such template ${\$self->name}";
+ my $template_zoom = HTML::Zoom->from_html($template_page->html);
+ my @ev;
+ $template_zoom->collect('*[data-replace]', { into => \@ev })
+ ->then
+ ->${\sub {
+ my $sel = $ev[0]->{attrs}{'data-replace'};
+ $zoom->collect($self, { into => \my @replace })->run;
+ shift->replace(\@replace);
+ }}
+}
+
+1;
--- /dev/null
+package App::SCS::Plugin::Feeds;
+
+use Module::Runtime qw(use_module);
+use Moo;
+
+with 'App::SCS::Role::Plugin';
+
+has mount_at => (is => 'ro', default => sub { 'feed' });
+
+has generator => (
+ is => 'lazy',
+ handles => { _feed_http_response => 'feed_http_response' },
+);
+
+sub _build_generator {
+ my ($self) = @_;
+ use_module('App::SCS::Plugin::Feeds::Generator')->new(
+ pages => $self->pages,
+ mounted_at => $self->mount_at,
+ );
+}
+
+sub page_dispatchers {
+ my ($self) = @_;
+ my $base = $self->mount_at;
+ "/${base}/**/" => sub {
+ if (my $conf = $self->config->{$_[1]}) {
+ $self->_feed_http_response(200 => $conf => $_[-1]);
+ }
+ },
+}
+
+sub provides_pages {
+ my ($self) = @_;
+ my $base = $self->mount_at;
+ return map "/${base}/$_/", keys %{$self->config};
+}
+
+1;
--- /dev/null
+package App::SCS::Plugin::Feeds::Generator;
+
+use URI;
+use Moo;
+no warnings 'once';
+
+has pages => (is => 'ro', required => 1);
+
+has mounted_at => (is => 'ro', required => 1);
+
+sub feed_http_response {
+ my ($self, $code, $feed_config, $env) = @_;
+ $self->_feed_response(
+ $code, $self->_config_to_data($feed_config, $env)
+ );
+}
+
+sub _config_to_data {
+ my ($self, $config, $env) = @_;
+ my $url_scheme = $env->{'psgi.url_scheme'} || "http";
+ my $url_port = $env->{SERVER_PORT}||80;
+ my $base_url = URI->new(
+ $url_scheme
+ .'://'
+ .($env->{HTTP_HOST}
+ or (
+ ($env->{SERVER_NAME} || "")
+ .($url_scheme eq 'http' && $url_port == 80
+ ? ''
+ : ":${url_port}"
+ )
+ ))
+ .($env->{SCRIPT_NAME} || '/')
+ );
+ my $abs = sub { URI->new_abs($_[0], $base_url)->as_string };
+ my $base_page = $self->pages->get({ path => $config->{base} });
+ my @entry_pages = $base_page->children(%{$config->{entries}})
+ ->latest(10)->flatten;
+ my $updated = (sort map $_->created, @entry_pages)[-1];
+ my $base = $self->mounted_at;
+ +{
+ %$config,
+ id => $abs->("${base}/${\$config->{base}}/"),
+ web_url => $abs->($config->{base}.'/'),
+ feed_url => $abs->("${base}/${\$config->{base}}/"),
+ updated => join('T', split(' ',$updated)).'Z',
+ entries => [ map {
+ my $page_url = $abs->(do { (my $p = $_->path) =~ s/^\///; "$p/" });
+ +{
+ title => $_->title,
+ summary_html => do {
+ use HTML::Tags;
+ join '', HTML::Tags::to_html_string(<p>, $_->description, </p>)
+ },
+ content_html => $self->_absolutify_html($_->body, $base_url, $page_url),
+ created => join('T', split(' ',$_->created)).'Z',
+ web_url => $page_url,
+ }
+ } @entry_pages ],
+ }
+}
+
+sub _feed_response {
+ my ($self, $code, $data) = @_;
+ [ $code,
+ [ 'Content-type' => 'application/atom+xml' ],
+ [ $self->_feed_string($data) ]
+ ]
+}
+
+sub _feed_string {
+ my ($self, $data) = @_;
+ XML::Tags::to_xml_string(
+ $self->_feed_data_to_tags($data)
+ );
+}
+
+sub _feed_data_to_tags {
+ my ($self, $data) = @_;
+ use XML::Tags qw(
+ feed title subtitle link id
+ );
+ my ($web_url, $feed_url) = @{$data}{qw(web_url feed_url)};
+ (\'<?xml version="1.0" encoding="UTF-8"?>', "\n",
+ <feed xmlns="http://www.w3.org/2005/Atom">, "\n",
+ ' ', <title type="text">, $data->{title}, </title>, "\n",
+ ($data->{subtitle}
+ ? (' ', <subtitle type="text">, $data->{subtitle}, </subtitle>, "\n",)
+ : ()),
+ ' ', <link rel="alternate" type="text/html" href="${web_url}" />, "\n",
+ ' ', <link rel="self" type="application/atom+xml" href="${feed_url}" />, "\n",
+ ' ', <updated>, $data->{updated}, </updated>, "\n",
+ ' ', <id>, $data->{id}, </id>, "\n",
+ (map $self->_entry_data_to_tags($_), @{$data->{entries}}),
+ </feed>);
+}
+
+sub _entry_data_to_tags {
+ my ($self, $data) = @_;
+ use XML::Tags qw(
+ entry title author name link id published updated summary content
+ );
+ my $web_url = $data->{web_url};
+ ' ', <entry>, "\n",
+ ' ', <title>, $data->{title}, </title>, "\n",
+ ' ', <author>, <name>, "Shadowcat Staff", </name>, </author>, "\n",
+ ' ', <link href="${web_url}" />, "\n",
+ ' ', <id>, $web_url, </id>, "\n",
+ ' ', <published>, $data->{created}, </published>, "\n",
+ ' ', <updated>, ($data->{created}||$data->{updated}), </updated>, "\n",
+ ($data->{summary_html}
+ ? (' ', <summary type="html">, \('<![CDATA['.$data->{summary_html}.']]>'), </summary>, "\n")
+ : ()
+ ),
+ ' ', <content type="html">, \('<![CDATA['.$data->{content_html}.']]>'), </content>, "\n",
+ ' ', </entry>, "\n";
+}
+
+sub _absolutify_html {
+ my ($self, $html, $base_url, $page_url) = @_;
+ $html;
+}
+
+1;
--- /dev/null
+package App::SCS::Role::PageChildren;
+
+use Moo::Role;
+
+requires '_page_set_class';
+requires '_top_dir';
+requires '_my_path';
+
+sub children {
+ my ($self, %args) = @_;
+ if (my $at = delete $args{at_depth}) {
+ @args{qw(min_depth max_depth)} = ($at, $at);
+ }
+ $self->_page_set_class->new(
+ top_dir => $self->_top_dir,
+ base_dir => $self->_my_path,
+ max_depth => 1,
+ %args,
+ );
+}
+
+1;
--- /dev/null
+package App::SCS::Role::PagePlugin;
+
+use Moo::Role;
+
+has 'page' => (is => 'ro', weak_ref => 1, required => 1);
+
+sub extra_pages { () }
+
+sub filter_html_zoom { shift }
+
+sub filter_content_zoom { shift }
+
+sub filter_psgi_response { shift }
+
+1;
--- /dev/null
+package App::SCS::Role::Plugin;
+
+use Moo::Role;
+
+with 'App::SCS::Role::WithConfig';
+
+has app => (
+ is => 'ro', weak_ref => 1, required => 1,
+ handles => [ 'pages' ],
+);
+
+sub page_plugins { () }
+
+sub default_page_plugins { () }
+
+sub page_dispatchers { () }
+
+sub provides_pages { () }
+
+sub register { return }
+
+1;
--- /dev/null
+package App::SCS::Role::WithConfig;
+
+use Moo::Role;
+
+has 'config' => (
+ is => 'ro',
+ default => sub {
+ my ($self) = @_;
+ +{ $self->default_config }
+ },
+ trigger => sub {
+ my ($self, $value) = @_;
+ my %default = $self->default_config;
+ my @not = grep !exists $value->{$_}, keys %default;
+ @{$value}{@not} = @default{@not};
+ }
+);
+
+sub default_config { () }
+
+
+1;
--- /dev/null
+package App::SCS::Web;
+
+use Safe::Isa;
+use Web::Simple;
+
+has app => (is => 'ro', weak_ref => 1, required => 1);
+
+has _page_dispatchers => (is => 'lazy');
+
+sub _build__page_dispatchers {
+ my ($self) = @_;
+ [ map $_->page_dispatchers, reverse @{$self->app->plugins} ]
+}
+
+has _page_dispatchers => (is => 'lazy');
+
+sub _build__page_dispatchers {
+ my ($self) = @_;
+ [ map $_->page_dispatchers, reverse @{$self->app->plugins} ]
+}
+
+sub dispatch_request {
+ my ($self) = @_;
+ return @{$self->_page_dispatchers};
+}
+
+1;
--- /dev/null
+use strictures 1;
+use Test::More;
+use Test::SharedFork;
+use IO::All;
+
+foreach my $module (grep $_->name =~ /\.pm$/, io->dir('lib')->all_files(0)) {
+ unless (fork) {
+ ok(eval { require $module }, "${module} loaded ok");
+ warn $@ if $@;
+ exit 0;
+ }
+ waitpid(-1, 0);
+}
+
+done_testing;
projects / scpubgit/App-SCS.git / commitdiff