lib/SCSite.pm

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