lib/SCSite.pm

   1 #!/usr/bin/env perl
   2
   3 package SCSite;
   4
   5 use IO::All;
   6 use SCSite::PageSet;
   7 use Web::Simple;
   8
   9 has pages => (is => 'lazy');
  10
  11 has filters => (is => 'lazy');
  12
  13 has _layout_zoom => (is => 'lazy');
  14
  15 has _feed_configs => (is => 'lazy');
  16
  17 has _feed_generator => (
  18   is => 'lazy',
  19   handles => { _feed_http_response => 'feed_http_response' },
  20 );
  21
  22 sub default_config {
  23   (
  24     pages_dir => 'share/pages',
  25     template_dir => 'share/templates',
  26     static_dir => 'share/static',
  27     feed_id_prefix => 'http://shadow.cat',
  28   )
  29 }
  30
  31 sub _build_pages {
  32   my ($self) = @_;
  33   SCSite::PageSet->new(base_dir => io->dir($self->config->{pages_dir}))
  34 }
  35
  36 sub _build_filters {
  37   my ($self) = @_;
  38   require SCSite::SubListFilter;
  39   require SCSite::SidebarFilter;
  40   +{
  41     map +($_ => "SCSite::${_}Filter"->new_from_site($self)),
  42       qw(SubList Sidebar)
  43   }
  44 }
  45
  46 sub _build__feed_configs {
  47   my $f = +{
  48     'blog' => {
  49       title => 'All Shadowcat blogs',
  50       entries => { min_depth => 2, max_depth => 3 },
  51     },
  52     'blog/matt-s-trout' => {
  53       title => q{Matt S Trout (mst)'s blog},
  54       entries => { at_depth => 1 },
  55     },
  56     'blog/mark-keating' => {
  57       title => q{Mark Keating (mdk)'s blog},
  58       entries => { min_depth => 1, max_depth => 2 },
  59     },
  60     'news' => {
  61       title => 'Shadowcat News',
  62       entries => { at_depth => 4 },
  63     },
  64   };
  65   $f->{$_}{base} ||= $_ for keys %$f;
  66   $f;
  67 }
  68
  69 sub _build__feed_generator {
  70   my ($self) = @_;
  71   require SCSite::FeedGenerator;
  72   SCSite::FeedGenerator->new(
  73     pages => $self->pages,
  74     id_prefix => $self->config->{feed_id_prefix},
  75   );
  76 }
  77
  78 sub dispatch_request {
  79   my $self = shift;
  80   sub (/feed/**/) {
  81     if (my $conf = $self->_feed_configs->{$_[1]}) {
  82       $self->_feed_http_response(200 => $conf);
  83     }
  84   },
  85   sub (/) {
  86     $self->_page_http_response(200 => $self->_find_page('index'));
  87   },
  88   sub (/**) {
  89     [ 302, [ 'Location' => "/$_[1]/" ], [] ]
  90   },
  91   sub (/**/) {
  92     my ($code, $page) = map {
  93       $_ ? (200, $_) : (404, $self->_error_page(404))
  94     } $self->_find_page($_[1]);
  95     $self->_page_http_response($code => $page);
  96   }
  97 }
  98
  99 sub _error_page {
 100   my ($self, $code) = @_;
 101   $self->_find_page("error_${code}");
 102 }
 103
 104 sub _find_page {
 105   my ($self, $path) = @_;
 106   $self->pages->get({ path => $path });
 107 }
 108
 109 sub _http_response {
 110   my ($self, $code, $type, $content) = @_;
 111   [ $code, [ 'Content-type' => $type ], [ $content ] ];
 112 }
 113
 114 sub _page_http_response {
 115   my ($self, $code, $page) = @_;
 116   [ $code, [ 'Content-type' => 'text/html' ], $self->_render_page($page) ];
 117 }
 118
 119 sub _render_page {
 120   my ($self, $page) = @_;
 121   my $zoom = $self->_layout_zoom;
 122   my %filters = %{$self->filters};
 123   $zoom->select('.page.title')->replace_content($page->title)
 124        ->select('.page.subtitle')->${\sub {
 125            $page->subtitle
 126              ? $_[0]->replace_content($page->subtitle)
 127              : $_[0]->replace('')
 128          }}
 129        ->select('.page.published_at')->replace_content($page->published_at)
 130        ->select('meta[name=description]')
 131          ->set_attribute(content => $page->description)
 132        ->select('meta[name=keywords]')
 133          ->set_attribute(content => $page->keywords)
 134        ->select('meta[name=created]')
 135          ->set_attribute(content => $page->created)
 136        ->select('.page.body')->replace_content(\$page->body)
 137        ->apply(sub {
 138            foreach my $fname (sort keys %filters) {
 139              my $cb = $filters{$fname}->callback_for($page);
 140              $_ = $_->select(".${fname}")->collect({
 141                         filter => $cb, passthrough => 1
 142                       });
 143            }
 144            $_
 145          })
 146        ->to_fh
 147 }
 148
 149 sub _build__layout_zoom {
 150   my ($self) = @_;
 151   HTML::Zoom->from_file(
 152     io->dir($self->config->{template_dir})->catfile('layout.html')
 153   )->memoize;
 154 }
 155
 156 sub run_if_script {
 157   return $_[0]->to_psgi_app if caller(1);
 158   my $class = shift;
 159   my @config_keys = keys %{{$class->default_config}};
 160   require Getopt::Long;
 161   my %config = map +($_ => $ENV{"SCS_${\uc $_}"}), @config_keys;
 162   Getopt::Long::GetOptions(
 163     map +("$_=s" => \$config{$_}), @config_keys
 164   );
 165   delete $config{$_} for grep !defined($config{$_}), keys %config;
 166   my $new = $class->new(config => \%config);
 167   $new->run(@_)
 168 }
 169
 170 around _run_cli => sub {
 171   my ($orig, $self) = (shift, shift);
 172   if (@_ >= 2 and $_[0] eq 'dev') {
 173     require SCSite::DevMode;
 174     Moo::Role->apply_roles_to_object($self, 'SCSite::DevMode');
 175     if ($self->can("_run_dev_$_[1]")) {
 176       return $self->${\"_run_dev_$_[1]"}(@_[2..$#_]);
 177     } else {
 178       die "No such dev mode $_[1]";
 179     }
 180   }
 181   if (@_ >= 1 and my $code = $self->can("_run_cli_$_[0]")) {
 182     shift;
 183     return $self->$code(@_);
 184   }
 185   return $self->$orig(@_);
 186 };
 187
 188 sub _run_cli_generate {
 189   my ($self, $to) = @_;
 190   die "generate requires a directory to generate to"
 191     unless $to and -d $to;
 192   my $out = io($to);
 193   foreach my $path ('', $self->pages->all_paths) {
 194     my $dir = $out->catdir($path);
 195     $dir->mkpath;
 196     $dir->catfile('index.html')->print(
 197       $self->run_test_request(GET => "$path/")->content
 198     );
 199   }
 200   foreach my $path (map "/feed/$_/", keys %{$self->_feed_configs}) {
 201     my $dir = $out->catdir($path);
 202     $dir->mkpath;
 203     $dir->catfile('index.atom')->print(
 204       $self->run_test_request(GET => $path)->content
 205     );
 206   }
 207 }
 208
 209
 210 __PACKAGE__->run_if_script;