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     generate_host => 'www.example.com',
  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   +{
  41     map {
  42       require "SCSite/${_}Filter.pm";
  43       +($_ => "SCSite::${_}Filter"->new_from_site($self))
  44     } @{$self->config->{filters}}
  45   }
  46 }
  47
  48 sub _build__feed_configs {
  49   my ($self) = @_;
  50   my $f = $self->config->{feeds}||{};
  51   $f->{$_}{base} ||= $_ for keys %$f;
  52   $f;
  53 }
  54
  55 sub _build__feed_generator {
  56   my ($self) = @_;
  57   require SCSite::FeedGenerator;
  58   SCSite::FeedGenerator->new(
  59     pages => $self->pages,
  60   );
  61 }
  62
  63 sub dispatch_request {
  64   my $self = shift;
  65   sub (/feed/**/) {
  66     if (my $conf = $self->_feed_configs->{$_[1]}) {
  67       $self->_feed_http_response(200 => $conf => $_[PSGI_ENV]);
  68     }
  69   },
  70   sub (/) {
  71     $self->_page_http_response(200 => $self->_find_page('index'));
  72   },
  73   sub (/**) {
  74     [ 302, [ 'Location' => "/$_[1]/" ], [] ]
  75   },
  76   sub (/**/) {
  77     my ($code, $page) = map {
  78       $_ ? (200, $_) : (404, $self->_error_page(404))
  79     } $self->_find_page($_[1]);
  80     $self->_page_http_response($code => $page);
  81   }
  82 }
  83
  84 sub _error_page {
  85   my ($self, $code) = @_;
  86   $self->_find_page("error_${code}");
  87 }
  88
  89 sub _find_page {
  90   my ($self, $path) = @_;
  91   $self->pages->get({ path => $path });
  92 }
  93
  94 sub _http_response {
  95   my ($self, $code, $type, $content) = @_;
  96   [ $code, [ 'Content-type' => $type ], [ $content ] ];
  97 }
  98
  99 sub _page_http_response {
 100   my ($self, $code, $page) = @_;
 101   [ $code, [ 'Content-type' => 'text/html' ], $self->_render_page($page) ];
 102 }
 103
 104 sub _render_page {
 105   my ($self, $page) = @_;
 106   my $zoom = $self->_layout_zoom;
 107   my %filters = %{$self->filters};
 108   $zoom->select('.page.title')->replace_content($page->title)
 109        ->select('.page.subtitle')->${\sub {
 110            $page->subtitle
 111              ? $_[0]->replace_content($page->subtitle)
 112              : $_[0]->replace('')
 113          }}
 114        ->select('.page.published_at')->replace_content($page->published_at)
 115        ->select('meta[name=description]')
 116          ->set_attribute(content => $page->description)
 117        ->select('meta[name=keywords]')
 118          ->set_attribute(content => $page->keywords)
 119        ->select('meta[name=created]')
 120          ->set_attribute(content => $page->created)
 121        ->select('.page.body')->replace_content(\$page->body)
 122        ->apply(sub {
 123            foreach my $fname (sort keys %filters) {
 124              my $cb = $filters{$fname}->callback_for($page);
 125              $_ = $_->select(".${fname}")->collect({
 126                         filter => $cb, passthrough => 1
 127                       });
 128            }
 129            $_
 130          })
 131        ->to_fh
 132 }
 133
 134 sub _build__layout_zoom {
 135   my ($self) = @_;
 136   HTML::Zoom->from_file(
 137     io->dir($self->config->{template_dir})->catfile('layout.html')
 138   )->memoize;
 139 }
 140
 141 sub run_if_script {
 142   return $_[0]->to_psgi_app if caller(1);
 143   my $self = ref($_[0]) ? $_[0] : $_[0]->new;
 144   my @config_keys = keys %{{$self->default_config}};
 145   require Getopt::Long;
 146   my %config = map +($_ => $ENV{"SCS_${\uc $_}"}), @config_keys;
 147   Getopt::Long::GetOptions(
 148     map +("$_=s" => \$config{$_}), @config_keys
 149   );
 150   delete $config{$_} for grep !defined($config{$_}), keys %config;
 151   @{$self->config}{keys %config} = values %config;
 152   $self->run(@_)
 153 }
 154
 155 around _run_cli => sub {
 156   my ($orig, $self) = (shift, shift);
 157   if (@_ >= 2 and $_[0] eq 'dev') {
 158     require SCSite::DevMode;
 159     Moo::Role->apply_roles_to_object($self, 'SCSite::DevMode');
 160     if ($self->can("_run_dev_$_[1]")) {
 161       return $self->${\"_run_dev_$_[1]"}(@_[2..$#_]);
 162     } else {
 163       die "No such dev mode $_[1]";
 164     }
 165   }
 166   if (@_ >= 1 and my $code = $self->can("_run_cli_$_[0]")) {
 167     shift;
 168     return $self->$code(@_);
 169   }
 170   return $self->$orig(@_);
 171 };
 172
 173 sub _run_cli_generate {
 174   my ($self, $to, @spec) = @_;
 175   die "generate requires a directory to generate to"
 176     unless $to and -d $to;
 177   my $out = io($to);
 178   my $check = do {
 179     if (@spec) { '^('.join('|',map quotemeta($_),@spec).')' }
 180     else { '.' }
 181   };
 182   my $prefix = 'http://'.$self->config->{generate_host};
 183   foreach my $path ('', $self->pages->all_paths) {
 184     next unless "$path/" =~ /$check/;
 185     print "Generating page ${path}\n";
 186     my $dir = $out->catdir($path);
 187     $dir->mkpath;
 188     $dir->catfile('index.html')->print(
 189       $self->run_test_request(GET => "${prefix}${path}/")->content
 190     );
 191   }
 192   foreach my $path (map "/feed/$_/", keys %{$self->_feed_configs}) {
 193     next unless "$path/" =~ /$check/;
 194     print "Generating feed ${path}\n";
 195     my $dir = $out->catdir($path);
 196     $dir->mkpath;
 197     $dir->catfile('index.atom')->print(
 198       $self->run_test_request(GET => "${prefix}${path}")->content
 199     );
 200   }
 201 }
 202
 203
 204 __PACKAGE__->run_if_script;