f5b9e5e9b63cd4e32ddb70e27338e8fc539f83a1
[scpubgit/App-SCS.git] / lib / App / SCS / PageSet.pm
1 package App::SCS::PageSet;
2
3 use Text::MultiMarkdown 'markdown';
4 use HTML::Zoom;
5 use Sub::Quote;
6 use Syntax::Keyword::Gather;
7 use App::SCS::Page;
8 use IO::All;
9 use Try::Tiny;
10 use List::Util qw(reduce max);
11 use Module::Runtime qw(use_module);
12 use JSON::MaybeXS;
13 use Moo;
14 use Hash::Merge qw(merge);
15 use Data::Pond qw(pond_read_datum pond_write_datum);
16 use JSONY;
17
18 with 'App::SCS::Role::PageChildren';
19
20 {
21   my $j = JSON->new;
22   sub _json { $j }
23 }
24
25 has top_dir => (is => 'ro', lazy => 1, builder => 'base_dir');
26 has base_dir => (is => 'ro', required => 1);
27 has plugin_config => (is => 'ro', required => 1);
28 has max_depth => (is => 'ro', default => quote_sub q{ 0 });
29 has min_depth => (is => 'ro', default => quote_sub q{ 1 });
30
31 has rel_path => (is => 'lazy');
32
33 sub _build_rel_path {
34   my ($self) = @_;
35   io->dir('/')
36     ->catdir(File::Spec->abs2rel($self->base_dir->name, $self->top_dir->name))
37 }
38
39 sub _page_set { $_[0] }
40 sub _page_set_class { ref($_[0]) }
41 sub _top_dir { shift->top_dir }
42 sub _my_path { shift->base_dir }
43
44 sub get {
45   my ($self, $spec) = @_;
46   $spec->{path} or die "path is required to get";
47   my ($dir, $file) = $spec->{path} =~ m{^(?:(.*)/)?([^/]+)$};
48   my $type;
49   my @poss = io->dir($self->base_dir)->${\sub {
50     my $io = shift;
51     defined($dir) ? $io->catdir($dir) : $io
52   }}->filter(sub {
53         $_->filename =~ /^\Q${file}\E${\$self->_types_re}$/ and $type = $1
54       })
55     ->${\sub { -e "$_[0]" ? $_[0]->all_files : () }};
56   die "multiple files found for ${\$spec->{path}}:\n".join "\n", @poss
57     if @poss > 1;
58   return undef unless @poss;
59   $self->_inflate(
60     $type, $self->rel_path->catdir($spec->{path}), $poss[0]
61   );
62 }
63
64 sub _config_files_for {
65   my ($self, $path) = @_;
66
67   my @files = ();
68   my @dirs = io->dir($path)->splitdir;
69
70   shift @dirs;
71   pop @dirs;
72   my $build_path = io('');
73
74   foreach my $dir (@dirs) {
75     $build_path = $build_path->catdir("/$dir");
76     #/home/.../share/pages/blog.conf etc
77
78     my $file = $self->_top_dir->catfile("$build_path.conf");
79
80     if (!$file->exists || !$file->file || $file->empty) {
81         next;
82     }
83
84     push @files, $file;
85   }
86
87   return \@files;
88 }
89
90 sub _inflate {
91   my ($self, $type, $path, $io) = @_;
92   (my $cache_name = $io->name) =~ s/\/([^\/]+)$/\/.htcache.$1.json/;
93   my $cache = io($cache_name);
94   my $config_files = $self->_config_files_for($path);
95   my $max_stat = max map $_->mtime, $io, @$config_files;
96
97   if (-f $cache_name) {
98     if ($cache->mtime >= $max_stat) {
99       return try {
100         $self->_new_page($path, $self->_json->decode($cache->all));
101       } catch {
102         die "Error inflating ${path} from cache: $_\n";
103       }
104     }
105   }
106   my $raw = $io->all;
107   try {
108
109     my $extracted = $self->${\"_extract_from_${type}"}($raw);
110     my $jsony = JSONY->new;
111     my $config = reduce { merge($a, $jsony->load($b->all)) } [], @$config_files;
112
113     $extracted->{plugins} = pond_read_datum('[' . $extracted->{plugins} . ']');
114
115     my $setup = $extracted;
116
117     $setup->{plugin_config} = merge($extracted->{plugins}, $config);
118
119     try {
120         my $tmp_cache = io($cache_name . ".tmp");
121         $tmp_cache->print($self->_json->encode($setup));
122         $tmp_cache->rename($cache_name);
123     };
124
125     $self->_new_page($path, $setup);
126   } catch {
127     die "Error inflating ${path} as ${type}: $_\n";
128   }
129 }
130
131 sub map {
132   my ($self, $mapper) = @_;
133   [ map $mapper->($_), $self->flatten ]
134 }
135
136 sub _depth_under_base {
137   my ($self, $path) = @_;
138   File::Spec->splitdir(File::Spec->abs2rel($path, $self->base_dir->name))
139 }
140
141 sub flatten {
142   my ($self) = @_;
143   my $slash = io->dir('/');
144   map {
145     my ($path, $type) = $_->name =~ /^(.*)${\$self->_types_re}$/;
146     $self->_inflate(
147       $type,
148       $slash->catdir(File::Spec->abs2rel($path, $self->top_dir->name)),
149       $_
150     );
151   } $self->_all_files;
152 }
153
154 sub all_paths {
155   my ($self) = @_;
156   my $slash = io->dir('/');
157   map {
158     my ($path, $type) = $_->name =~ /^(.*)${\$self->_types_re}$/;
159     $slash->catdir(File::Spec->abs2rel($path, $self->top_dir->name))->name,
160   } $self->_all_files;
161 }
162
163 sub _all_files {
164   my ($self) = @_;
165   return unless (my $base = $self->base_dir)->exists;
166   my %seen;
167   my $min = $self->min_depth;
168   map {
169     $_->filter(sub { $_->filename =~ /${\$self->_types_re}$/ })
170       ->all_files($self->max_depth - ($min-1))
171   } map
172       $min > 1
173         ? do {
174             # can't use ->all_dirs($min-1) since we only want the final level
175             my @x = ($_); @x = map $_->all_dirs, @x for 1..$min-1; @x
176           }
177         : $_,
178       $base;
179 }
180
181 sub latest {
182   my ($self, $max) = @_;
183   use_module('App::SCS::LatestPageSet')->new(
184     parent => $self,
185     max_entries => $max,
186   );
187 }
188
189 sub _new_page {
190   use_module('App::SCS::Page')->new(
191     path => $_[1], page_set => $_[0], %{$_[2]}
192   );
193 }
194
195 sub _types_re { qw/\.(html|md)/ }
196
197 sub _extract_from_html {
198   my ($self, $html) = @_;
199   my %meta;
200   HTML::Zoom->from_html($html)
201     ->select('title')->collect_content({ into => \my @title })
202     ->${\sub {
203         my $z = shift;
204         return reduce {
205           $a->collect("meta[name=${b}]", { into => ($meta{$b}=[]) })
206         } $z, qw(subtitle description keywords created plugins)
207       }}
208     ->run;
209   +{
210     title => $title[0]->{raw}||'',
211     (map +($_ => $meta{$_}[0]->{attrs}{content}||''), keys %meta),
212     html => $html,
213   }
214 }
215
216 sub _extract_from_md {
217   my ($self, $md) = @_;
218   $self->_extract_from_html(markdown($md, { document_format => 'complete' }));
219 }
220
221 1;