lib/SCSite.pm

   1 package SCSite;
   2
   3 use IO::All;
   4 use SCSite::PageSet;
   5 use Web::Simple;
   6
   7 has pages => (is => 'lazy');
   8
   9 has filters => (is => 'lazy');
  10
  11 has _layout_zoom => (is => 'lazy');
  12
  13 has _feed_configs => (is => 'lazy');
  14
  15 has _feed_generator => (
  16   is => 'lazy',
  17   handles => { _feed_http_response => 'feed_http_response' },
  18 );
  19
  20 sub default_config {
  21   (
  22     pages_dir => 'share/pages',
  23     template_dir => 'share/templates',
  24     feed_id_prefix => 'http://shadow.cat',
  25   )
  26 }
  27
  28 sub _build_pages {
  29   my ($self) = @_;
  30   SCSite::PageSet->new(base_dir => io->dir($self->config->{pages_dir}))
  31 }
  32
  33 sub _build_filters {
  34   my ($self) = @_;
  35   require SCSite::SubListFilter;
  36   require SCSite::SidebarFilter;
  37   +{
  38     map +($_ => "SCSite::${_}Filter"->new_from_site($self)),
  39       qw(SubList Sidebar)
  40   }
  41 }
  42
  43 sub _build__feed_configs {
  44   my $f = +{
  45     'blog' => {
  46       title => 'All Shadowcat blogs',
  47       entries => { min_depth => 2, max_depth => 3 },
  48     },
  49     'blog/matt-s-trout' => {
  50       title => q{Matt S Trout (mst)'s blog},
  51       entries => { at_depth => 1 },
  52     },
  53     'blog/mark-keating' => {
  54       title => q{Mark Keating (mdk)'s blog},
  55       entries => { min_depth => 1, max_depth => 2 },
  56     },
  57     'news' => {
  58       title => 'Shadowcat News',
  59       entries => { at_depth => 4 },
  60     },
  61   };
  62   $f->{$_}{base} ||= $_ for keys %$f;
  63   $f;
  64 }
  65
  66 sub _build__feed_generator {
  67   my ($self) = @_;
  68   require SCSite::FeedGenerator;
  69   SCSite::FeedGenerator->new(
  70     pages => $self->pages,
  71     id_prefix => $self->config->{feed_id_prefix},
  72   );
  73 }
  74
  75 sub dispatch_request {
  76   my $self = shift;
  77   sub (/feed/**/) {
  78     if (my $conf = $self->_feed_configs->{$_[1]}) {
  79       $self->_feed_http_response(200 => $conf);
  80     }
  81   },
  82   sub (/) {
  83     $self->_page_http_response(200 => $self->_find_page('index'));
  84   },
  85   sub (/**) {
  86     [ 302, [ 'Location' => "/$_[1]/" ], [] ]
  87   },
  88   sub (/**/) {
  89     my ($code, $page) = map {
  90       $_ ? (200, $_) : (404, $self->_error_page(404))
  91     } $self->_find_page($_[1]);
  92     $self->_page_http_response($code => $page);
  93   }
  94 }
  95
  96 sub _error_page {
  97   my ($self, $code) = @_;
  98   $self->_find_page("error_${code}");
  99 }
 100
 101 sub _find_page {
 102   my ($self, $path) = @_;
 103   $self->pages->get({ path => $path });
 104 }
 105
 106 sub _http_response {
 107   my ($self, $code, $type, $content) = @_;
 108   [ $code, [ 'Content-type' => $type ], [ $content ] ];
 109 }
 110
 111 sub _page_http_response {
 112   my ($self, $code, $page) = @_;
 113   [ $code, [ 'Content-type' => 'text/html' ], $self->_render_page($page) ];
 114 }
 115
 116 sub _render_page {
 117   my ($self, $page) = @_;
 118   my $zoom = $self->_layout_zoom;
 119   my %filters = %{$self->filters};
 120   $zoom->select('.page.title')->replace_content($page->title)
 121        ->select('meta[name=description]')->replace_content($page->description)
 122        ->select('meta[name=keywords]')->replace_content($page->keywords)
 123        ->select('.main')->replace_content(\$page->body)
 124        ->apply(sub {
 125            foreach my $fname (sort keys %filters) {
 126              my $cb = $filters{$fname}->callback_for($page);
 127              $_ = $_->select(".${fname}")->collect({
 128                         filter => $cb, passthrough => 1
 129                       });
 130            }
 131            $_
 132          })
 133        ->to_fh
 134 }
 135
 136 sub _build__layout_zoom {
 137   my ($self) = @_;
 138   HTML::Zoom->from_file(
 139     io->dir($self->config->{template_dir})->catfile('layout.html')
 140   )->memoize;
 141 }
 142
 143 sub run_if_script {
 144   return $_[0]->to_psgi_app if caller(1);
 145   my $class = shift;
 146   my @config_keys = keys %{{$class->default_config}};
 147   require Getopt::Long;
 148   my %config;
 149   Getopt::Long::GetOptions(
 150     map +("$_=s" => \$config{$_}), @config_keys
 151   );
 152   delete $config{$_} for grep !defined($config{$_}), keys %config;
 153   my $new = $class->new(config => \%config);
 154   $new->run(@_)
 155 }
 156
 157 __PACKAGE__->run_if_script;