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