subtitle handling, prettified dates. bugfixes and better errors

[scpubgit/SCS.git] / lib / SCSite.pm

package SCSite;

use IO::All;
use SCSite::PageSet;
use Web::Simple;

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

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

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

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

has _feed_generator => (
  is => 'lazy',
  handles => { _feed_http_response => 'feed_http_response' },
);

sub default_config {
  (
    pages_dir => 'share/pages',
    template_dir => 'share/templates',
    static_dir => 'share/static',
    feed_id_prefix => 'http://shadow.cat',
  )
}

sub _build_pages {
  my ($self) = @_;
  SCSite::PageSet->new(base_dir => io->dir($self->config->{pages_dir}))
}

sub _build_filters {
  my ($self) = @_;
  require SCSite::SubListFilter;
  require SCSite::SidebarFilter;
  +{
    map +($_ => "SCSite::${_}Filter"->new_from_site($self)),
      qw(SubList Sidebar)
  }
}

sub _build__feed_configs {
  my $f = +{
    'blog' => {
      title => 'All Shadowcat blogs',
      entries => { min_depth => 2, max_depth => 3 },
    },
    'blog/matt-s-trout' => {
      title => q{Matt S Trout (mst)'s blog},
      entries => { at_depth => 1 },
    },
    'blog/mark-keating' => {
      title => q{Mark Keating (mdk)'s blog},
      entries => { min_depth => 1, max_depth => 2 },
    },
    'news' => {
      title => 'Shadowcat News',
      entries => { at_depth => 4 },
    },
  };
  $f->{$_}{base} ||= $_ for keys %$f;
  $f;
}

sub _build__feed_generator {
  my ($self) = @_;
  require SCSite::FeedGenerator;
  SCSite::FeedGenerator->new(
    pages => $self->pages,
    id_prefix => $self->config->{feed_id_prefix},
  );
}

sub dispatch_request {
  my $self = shift;
  sub (/feed/**/) {
    if (my $conf = $self->_feed_configs->{$_[1]}) {
      $self->_feed_http_response(200 => $conf);
    }
  },
  sub (/) {
    $self->_page_http_response(200 => $self->_find_page('index'));
  },
  sub (/**) {
    [ 302, [ 'Location' => "/$_[1]/" ], [] ]
  },
  sub (/**/) {
    my ($code, $page) = map {
      $_ ? (200, $_) : (404, $self->_error_page(404))
    } $self->_find_page($_[1]);
    $self->_page_http_response($code => $page);
  }
}

sub _error_page {
  my ($self, $code) = @_;
  $self->_find_page("error_${code}");
}

sub _find_page {
  my ($self, $path) = @_;
  $self->pages->get({ path => $path });
}

sub _http_response {
  my ($self, $code, $type, $content) = @_;
  [ $code, [ 'Content-type' => $type ], [ $content ] ];
}

sub _page_http_response {
  my ($self, $code, $page) = @_;
  [ $code, [ 'Content-type' => 'text/html' ], $self->_render_page($page) ];
}

sub _render_page {
  my ($self, $page) = @_;
  my $zoom = $self->_layout_zoom;
  my %filters = %{$self->filters};
  $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)
       ->select('.page.body')->replace_content(\$page->body)
       ->apply(sub {
           foreach my $fname (sort keys %filters) {
             my $cb = $filters{$fname}->callback_for($page);
             $_ = $_->select(".${fname}")->collect({
                        filter => $cb, passthrough => 1
                      });
           }
           $_
         })
       ->to_fh
}

sub _build__layout_zoom {
  my ($self) = @_;
  HTML::Zoom->from_file(
    io->dir($self->config->{template_dir})->catfile('layout.html')
  )->memoize;
}

sub run_if_script {
  return $_[0]->to_psgi_app if caller(1);
  my $class = shift;
  my @config_keys = keys %{{$class->default_config}};
  require Getopt::Long;
  my %config;
  Getopt::Long::GetOptions(
    map +("$_=s" => \$config{$_}), @config_keys
  );
  delete $config{$_} for grep !defined($config{$_}), keys %config;
  my $new = $class->new(config => \%config);
  $new->run(@_)
}

around _run_cli => sub {
  my ($orig, $self) = (shift, shift);
  if (@_ >= 2 and $_[0] eq 'dev' and $_[1] eq 'server') {
    require SCSite::DevMode;
    Moo::Role->apply_roles_to_object($self, 'SCSite::DevMode');
    return $self->_run_dev_server(@_[2..$#_]);
  }
  return $self->$orig(@_);
};

__PACKAGE__->run_if_script;