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