basic porting work for SCSite
[scpubgit/App-SCS.git] / lib / App / SCS / Page.pm
1 package App::SCS::Page;
2
3 use IO::All;
4 use Time::Local qw(timelocal);
5 use Data::Pond qw(pond_read_datum pond_write_datum);
6 use List::Util qw(reduce);
7 use Module::Runtime qw(use_module);
8 use Moo;
9
10 has "_$_" => (is => 'ro', init_arg => $_) for qw(page_set);
11
12 sub _page_set_class { ref($_[0]->_page_set) }
13 sub _top_dir { $_[0]->_page_set->top_dir }
14 sub _my_path { io->dir($_[0]->_top_dir)->catdir($_[0]->path) }
15
16 with 'App::SCS::Role::PageChildren';
17
18 has $_ => (is => 'ro') for qw(
19   title subtitle description keywords plugins html created path
20 );
21
22 has plugin_config => (is => 'lazy');
23
24 sub _build_plugin_config {
25   my ($self) = @_;
26   $self->plugins
27     ? pond_read_datum('[ '.$self->plugins.' ]')
28     : []
29 }
30
31 sub has_plugin_config { exists $_[0]->plugin_config->{$_[1]} }
32
33 sub with_plugin_config {
34   my ($self, $with_name, $with_config) = @_;
35   my @orig = @{$self->plugin_config};
36   my @new;
37   while (my ($name, $config) = splice @orig, 0, 2) {
38     push @new, (
39       $name eq $with_name
40         ? ($name, { %$config, %$with_config })
41         : ($name, $config)
42     );
43   }
44   return $self->with(plugins => pond_write_datum(\@new));
45 }
46
47 has _page_plugins => (is => 'lazy');
48
49 sub _build__page_plugins {
50   my ($self) = @_;
51   my $plugin_config = $self->plugin_config;
52   my ($plugin_map, $defaults) = @{$self->_page_set->plugin_config}
53                                  {qw(plugin_map defaults)};
54   my @spec = (@$defaults, @$plugin_config);
55   my @plugins;
56   while (my ($name, $config) = splice @spec, 0, 2) {
57     my $info = $plugin_map->{$name};
58     push @plugins,
59       use_module($info->{class})->new(
60         ($info->{config}||sub{})->(), %$config, page => $self
61       );
62   }
63   return \@plugins;
64 }
65
66 sub published_at {
67   $_[0]->created
68     ? scalar localtime timelocal
69         map +(@{$_}[0..3], $_->[4]-1, $_->[5]-1900),
70           [ reverse split '\D+', $_[0]->created ]
71     : ''
72 }
73
74 sub to_app {
75   my ($self) = @_;
76   return sub { $self->to_psgi_response(@_) };
77 }
78
79 sub to_psgi_response {
80   my ($self, $env) = @_;
81
82   if (my $cb = $env->{'App::SCS::Command::Generate.extra_pages'}) {
83     $cb->($_->extra_pages) for @{$self->page_plugins};
84   }
85
86   $self->_psgi_response;
87 }
88
89 has _psgi_response => (is => 'lazy');
90
91 sub _build__psgi_response {
92   my ($self) = @_;
93
94   my $psgi_res = [
95     200, [ 'Content-type' => 'text/html' ], $self->_content_zoom->to_fh
96   ];
97
98   return reduce {
99     $b->filter_psgi_response($a)
100   } $psgi_res, @{$self->_page_plugins};
101 }
102
103 sub _content_zoom {
104   my ($self) = @_;
105   return reduce {
106     $b->filter_content_zoom($a)
107   } $self->_html_zoom, @{$self->_page_plugins};
108 }
109
110 sub _html_zoom {
111   my ($self) = @_;
112   return reduce {
113     $b->filter_html_zoom($a)
114   } HTML::Zoom->from_html($self->html), @{$self->_page_plugins};
115 }
116
117 no Moo;
118
119 sub with {
120   my $self = shift;
121   return ref($self)->new(%$self, @_);
122 }
123
124 1;