make generator (a) provide output (b) accept arguments to restrict what it generates
[scpubgit/SCS.git] / 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, @spec) = @_;
190   die "generate requires a directory to generate to"
191     unless $to and -d $to;
192   my $out = io($to);
193   my $check = do {
194     if (@spec) { '^('.join('|',map quotemeta($_),@spec).')' }
195     else { '.' }
196   };
197   foreach my $path ('', $self->pages->all_paths) {
198     next unless "$path/" =~ /$check/;
199     print "Generating ${path}\n";
200     my $dir = $out->catdir($path);
201     $dir->mkpath;
202     $dir->catfile('index.html')->print(
203       $self->run_test_request(GET => "$path/")->content
204     );
205   }
206   foreach my $path (map "/feed/$_/", keys %{$self->_feed_configs}) {
207     next unless "$path/" =~ /$check/;
208     print "Generating ${path}\n";
209     my $dir = $out->catdir($path);
210     $dir->mkpath;
211     $dir->catfile('index.atom')->print(
212       $self->run_test_request(GET => $path)->content
213     );
214   }
215 }
216    
217
218 __PACKAGE__->run_if_script;