default updated to epoch time if no entries
[scpubgit/App-SCS.git] / lib / App / SCS / Plugin / Feeds / Generator.pm
1 package App::SCS::Plugin::Feeds::Generator;
2
3 use URI;
4 use Moo;
5 no warnings 'once';
6
7 has pages => (is => 'ro', required => 1);
8
9 has mounted_at => (is => 'ro', required => 1);
10
11 sub feed_http_response {
12   my ($self, $code, $feed_config, $env) = @_;
13   $self->_feed_response(
14     $code, $self->_config_to_data($feed_config, $env)
15   );
16 }
17
18 sub _config_to_data {
19   my ($self, $config, $env) = @_;
20   my $url_scheme = $env->{'psgi.url_scheme'} || "http";
21   my $url_port = $env->{SERVER_PORT}||80;
22   my $base_url = URI->new(
23     $url_scheme
24     .'://'
25     .($env->{HTTP_HOST}
26       or (
27         ($env->{SERVER_NAME} || "")
28         .($url_scheme eq 'http' && $url_port == 80
29            ? ''
30            : ":${url_port}"
31          )
32       ))
33     .($env->{SCRIPT_NAME} || '/')
34   );
35   my $abs = sub { URI->new_abs($_[0], $base_url)->as_string };
36   my $base_page = $self->pages->get({ path => $config->{base} });
37   my @entry_pages = $base_page->children(%{$config->{entries}})
38                               ->latest(10)->flatten;
39   my $updated = (sort map $_->created, @entry_pages)[-1];
40   # in case of no entries yet
41   $updated ||= '1970-01-01 00:00:00';
42   my $base = $self->mounted_at;
43   +{
44      %$config,
45      id => $abs->("${base}/${\$config->{base}}/"),
46      web_url => $abs->($config->{base}.'/'),
47      feed_url => $abs->("${base}/${\$config->{base}}/"),
48      updated => join('T', split(' ',$updated)).'Z',
49      entries => [ map {
50       my $page_url = $abs->(do { (my $p = $_->path) =~ s/^\///; "$p/" });
51       +{
52          title => $_->title,
53          summary_html => do {
54            use HTML::Tags;
55            join '', HTML::Tags::to_html_string(<p>, $_->description, </p>)
56          },
57          content_html => $self->_content_html($_, $base_url, $page_url),
58          created => join('T', split(' ',$_->created)).'Z',
59          web_url => $page_url,
60        }
61     } @entry_pages ],
62   }
63 }
64
65 sub _feed_response {
66   my ($self, $code, $data) = @_;
67   [ $code,
68     [ 'Content-type' => 'application/atom+xml' ],
69     [ $self->_feed_string($data) ]
70   ]
71 }
72
73 sub _feed_string {
74   my ($self, $data) = @_;
75   XML::Tags::to_xml_string(
76     $self->_feed_data_to_tags($data)
77   );
78 }
79
80 sub _feed_data_to_tags {
81   my ($self, $data) = @_;
82   use XML::Tags qw(
83     feed title subtitle link id
84   );
85   my ($web_url, $feed_url) = @{$data}{qw(web_url feed_url)};
86   (\'<?xml version="1.0" encoding="UTF-8"?>', "\n",
87   <feed xmlns="http://www.w3.org/2005/Atom">, "\n",
88     '  ', <title type="text">, $data->{title}, </title>, "\n",
89     ($data->{subtitle}
90       ? ('  ', <subtitle type="text">, $data->{subtitle}, </subtitle>, "\n",)
91       : ()),
92     '  ', <link rel="alternate" type="text/html" href="${web_url}" />, "\n",
93     '  ', <link rel="self" type="application/atom+xml" href="${feed_url}" />, "\n",
94     '  ', <updated>, $data->{updated}, </updated>, "\n",
95     '  ', <id>, $data->{id}, </id>, "\n",
96     (map $self->_entry_data_to_tags($_), @{$data->{entries}}),
97   </feed>);
98 }
99
100 sub _entry_data_to_tags {
101   my ($self, $data) = @_;
102   use XML::Tags qw(
103     entry title author name link id published updated summary content
104   );
105   my $web_url = $data->{web_url};
106   '  ', <entry>, "\n",
107     '    ', <title>, $data->{title}, </title>, "\n",
108     '    ', <author>, <name>, "Shadowcat Staff", </name>, </author>, "\n",
109     '    ', <link href="${web_url}" />, "\n",
110     '    ', <id>, $web_url, </id>, "\n",
111     '    ', <published>, $data->{created}, </published>, "\n",
112     '    ', <updated>, ($data->{created}||$data->{updated}), </updated>, "\n",
113     ($data->{summary_html}
114       ? ('    ', <summary type="html">, \('<![CDATA['.$data->{summary_html}.']]>'), </summary>, "\n")
115       : ()
116     ),
117     '    ', <content type="html">, \('<![CDATA['.$data->{content_html}.']]>'), </content>, "\n",
118   '  ', </entry>, "\n";
119 }
120
121 sub _content_html {
122   my ($self, $page, $base_url, $page_url) = @_;
123   my @ev;
124   HTML::Zoom->from_html($page->html)
125             ->collect(body => { into => \@ev })
126             ->run;
127   HTML::Zoom->from_events(\@ev)->to_html;
128 }
129
130 1;