domain support for feeds, factor out sc-specific bits

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

#!/usr/bin/env perl

package SCSite;

our $VERSION = '0.001001'; # 0.1.1

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',
    generate_host => 'www.example.com',
  )
}

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

sub _build_filters {
  my ($self) = @_;
  +{
    map {
      require "SCSite/${_}Filter.pm";
      +($_ => "SCSite::${_}Filter"->new_from_site($self))
    } @{$self->config->{filters}}
  }
}

sub _build__feed_configs {
  my ($self) = @_;
  my $f = $self->config->{feeds}||{};
  $f->{$_}{base} ||= $_ for keys %$f;
  $f;
}

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

sub dispatch_request {
  my $self = shift;
  sub (/feed/**/) {
    if (my $conf = $self->_feed_configs->{$_[1]}) {
      $self->_feed_http_response(200 => $conf => $_[PSGI_ENV]);
    }
  },
  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 $self = ref($_[0]) ? $_[0] : $_[0]->new;
  my @config_keys = keys %{{$self->default_config}};
  require Getopt::Long;
  my %config = map +($_ => $ENV{"SCS_${\uc $_}"}), @config_keys;
  Getopt::Long::GetOptions(
    map +("$_=s" => \$config{$_}), @config_keys
  );
  delete $config{$_} for grep !defined($config{$_}), keys %config;
  @{$self->config}{keys %config} = values %config;
  $self->run(@_)
}

around _run_cli => sub {
  my ($orig, $self) = (shift, shift);
  if (@_ >= 2 and $_[0] eq 'dev') {
    require SCSite::DevMode;
    Moo::Role->apply_roles_to_object($self, 'SCSite::DevMode');
    if ($self->can("_run_dev_$_[1]")) {
      return $self->${\"_run_dev_$_[1]"}(@_[2..$#_]);
    } else {
      die "No such dev mode $_[1]";
    }
  }
  if (@_ >= 1 and my $code = $self->can("_run_cli_$_[0]")) {
    shift;
    return $self->$code(@_);
  }
  return $self->$orig(@_);
};

sub _run_cli_generate {
  my ($self, $to, @spec) = @_;
  die "generate requires a directory to generate to"
    unless $to and -d $to;
  my $out = io($to);
  my $check = do {
    if (@spec) { '^('.join('|',map quotemeta($_),@spec).')' }
    else { '.' }
  };
  my $prefix = 'http://'.$self->config->{generate_host};
  foreach my $path ('', $self->pages->all_paths) {
    next unless "$path/" =~ /$check/;
    print "Generating page ${path}\n";
    my $dir = $out->catdir($path);
    $dir->mkpath;
    $dir->catfile('index.html')->print(
      $self->run_test_request(GET => "${prefix}${path}/")->content
    );
  }
  foreach my $path (map "/feed/$_/", keys %{$self->_feed_configs}) {
    next unless "$path/" =~ /$check/;
    print "Generating feed ${path}\n";
    my $dir = $out->catdir($path);
    $dir->mkpath;
    $dir->catfile('index.atom')->print(
      $self->run_test_request(GET => "${prefix}${path}")->content
    );
  }
}
   

__PACKAGE__->run_if_script;