lib/SCSite/FeedGenerator.pm

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