feed generation
Matt S Trout [Thu, 10 Feb 2011 16:48:45 +0000 (16:48 +0000)]
lib/SCSite.pm
lib/SCSite/FeedGenerator.pm [new file with mode: 0644]
lib/SCSite/Page.pm
lib/SCSite/PageSet.pm
t/pages/blog/mdk/2011/post.md [new file with mode: 0644]
t/pages/blog/mdk/post2.md [new file with mode: 0644]
t/pages/blog/mst.md [new file with mode: 0644]
t/pages/blog/mst/post.md [new file with mode: 0644]
t/pages/blog/mst/post2.md [new file with mode: 0644]

index 7d821d4..5972766 100644 (file)
@@ -10,10 +10,18 @@ has filters => (is => 'lazy');
 
 has _layout_zoom => (is => 'lazy');
 
+has _feed_configs => (is => 'lazy');
+
+has _feed_generator => (
+  is => 'lazy',
+  handles => { _feed_http_response => 'feed_http_response' },
+);
+
 sub default_config {
   (
     pages_dir => 'share/content',
     template_dir => 'share/skin',
+    feed_id_prefix => 'http://shadow.cat',
   )
 }
 
@@ -32,10 +40,32 @@ sub _build_filters {
   }
 }
 
+sub _build__feed_configs {
+  my $f = +{
+    'blog' => {
+      title => 'All Shadowcat blogs',
+      entries => { min_depth => 2, max_depth => 3 },
+    }
+  };
+  $f->{$_}{base} ||= $_ for keys %$f;
+  $f;
+}
+
+sub _build__feed_generator {
+  my ($self) = @_;
+  require SCSite::FeedGenerator;
+  SCSite::FeedGenerator->new(
+    pages => $self->pages,
+    id_prefix => $self->config->{feed_id_prefix},
+  );
+}
+
 sub dispatch_request {
   my $self = shift;
   sub (/feed/**/) {
-    $self->_http_response(500 => 'text/plain' => 'Not implemented');
+    if (my $conf = $self->_feed_configs->{$_[1]}) {
+      $self->_feed_http_response(200 => $conf);
+    }
   },
   sub (/) {
     $self->_page_http_response(200 => $self->_find_page('index'));
diff --git a/lib/SCSite/FeedGenerator.pm b/lib/SCSite/FeedGenerator.pm
new file mode 100644 (file)
index 0000000..463ce56
--- /dev/null
@@ -0,0 +1,96 @@
+package SCSite::FeedGenerator;
+
+use Moo;
+no warnings 'once';
+
+has id_prefix => (is => 'ro', required => 1);
+has pages => (is => 'ro', required => 1);
+
+sub feed_http_response {
+  my ($self, $code, $feed_config) = @_;
+  $self->_feed_response(
+    $code, $self->_config_to_data($feed_config)
+  );
+}
+
+sub _config_to_data {
+  my ($self, $config) = @_;
+  my $base_page = $self->pages->get({ path => $config->{base} });
+  my @entry_pages = $base_page->children(%{$config->{entries}})
+                              ->latest(10)->flatten;
+  +{
+     %$config,
+     id => $self->_id_for($base_page->path),
+     web_url => $base_page->path,
+     feed_url => "/feed/${\$config->{base}}",
+     entries => [ map +{
+       title => $_->title,
+       summary_html => do {
+         use HTML::Tags;
+         HTML::Tags::to_html_string(<p>, $_->description, </p>)
+       },
+       content_html => $_->body,
+       created => $_->created,
+       web_url => $_->path,
+     }, @entry_pages ],
+  }
+}
+
+sub _id_for {
+  my ($self, $for) = @_;
+  join '', $self->id_prefix, $for;
+}
+
+sub _feed_response {
+  my ($self, $code, $data) = @_;
+  [ $code,
+    [ 'Content-type' => 'application/atom+xml' ],
+    [ $self->_feed_string($data) ]
+  ]
+}
+
+sub _feed_string {
+  my ($self, $data) = @_;
+  XML::Tags::to_xml_string(
+    $self->_feed_data_to_tags($data)
+  );
+}
+
+sub _feed_data_to_tags {
+  my ($self, $data) = @_;
+  use XML::Tags qw(
+    feed title subtitle link id
+  );
+  my ($web_url, $feed_url) = @{$data}{qw(web_url feed_url)};
+  (\'<?xml version="1.0" encoding="UTF-8"?>',
+  <feed xmlns="http://www.w3.org/2005/Atom">,
+    <title type="text">, $data->{title}, </title>,
+    ($data->{subtitle}
+      ? (<subtitle type="text">, $data->{subtitle}, </subtitle>)
+      : ()),
+    <link rel="alternate" type="text/html" href="${web_url}" />,
+    <link rel="self" type="application/atom+xml" href="${feed_url}" />,
+    <id>, $data->{id}, </id>,
+    (map $self->_entry_data_to_tags($_), @{$data->{entries}}),
+  </feed>);
+}
+
+sub _entry_data_to_tags {
+  my ($self, $data) = @_;
+  use XML::Tags qw(entry title link id published updated summary content);
+  my $web_url = $data->{web_url};
+  <entry>,
+    <title>, $data->{title}, </title>,
+    <link href="${web_url}" />,
+    <id>, $self->_id_for($data->{web_url}), </id>,
+    <published>, $data->{created}, </published>,
+    <updated>, ($data->{created}||$data->{updated}), </updated>,
+    ($data->{summary_html}
+      ? (<summary type="html">, \($data->{summary_html}), </summary>)
+      : ()
+    ),
+    <content type="html">, \($data->{body_html}), </content>,
+  </entry>;
+}
+
+1;
index cba4d6a..b1b7e6f 100644 (file)
@@ -10,8 +10,7 @@ has "_$_" => (is => 'ro', init_arg => $_) for qw(page_set);
 sub children {
   my ($self, %args) = @_;
   if (my $at = delete $args{at_depth}) {
-warn "Here, $at";
-    @args{qw(min_depth max_depth)} = ($at-1, $at);
+    @args{qw(min_depth max_depth)} = ($at, $at);
   }
   my $ps = $self->_page_set;
   (ref $ps)->new(
index a1e12f5..0e0aedd 100644 (file)
@@ -11,7 +11,7 @@ use Moo;
 has top_dir => (is => 'ro', lazy => 1, builder => 'base_dir');
 has base_dir => (is => 'ro', required => 1);
 has max_depth => (is => 'ro', default => quote_sub q{ 0 });
-has min_depth => (is => 'ro', default => quote_sub q{ 0 });
+has min_depth => (is => 'ro', default => quote_sub q{ 1 });
 
 has rel_path => (is => 'lazy');
 
@@ -32,7 +32,7 @@ sub get {
   }}->filter(sub {
         $_->filename =~ /^\Q${file}\E${\$self->_types_re}$/ and $type = $1
       })
-    ->${\sub { $_[0]->exists ? $_[0]->all_files : () }};
+    ->${\sub { -e "$_[0]" ? $_[0]->all_files : () }};
   die "multiple files found for ${\$spec->{path}}:\n".join "\n", @poss
     if @poss > 1;
   return undef unless @poss;
@@ -57,7 +57,6 @@ sub flatten {
   my %seen;
   my $slash = io->dir('/');
   my $min = $self->min_depth;
-  my @dirs = map $min ? $_->all_dirs($min) : $_, $base;
   map {
     my ($path, $type) = $_->name =~ /^(.*)${\$self->_types_re}$/;
     $self->${\"_inflate_${type}"}(
@@ -66,15 +65,15 @@ sub flatten {
     );
   } map {
     $_->filter(sub { $_->filename =~ /${\$self->_types_re}$/ })
-      ->all_files($self->max_depth - $min)
+      ->all_files($self->max_depth - ($min-1))
   } map
-      $min
+      $min > 1
         ? do {
-            # can't use ->all_dirs($min) since we only want the final level
-            my @x = ($_); @x = map $_->all_dirs, @x for 1..$min; @x
+            # can't use ->all_dirs($min-1) since we only want the final level
+            my @x = ($_); @x = map $_->all_dirs, @x for 1..$min-1; @x
           }
         : $_,
-      $self->base_dir;
+      $base;
 }
 
 sub latest {
diff --git a/t/pages/blog/mdk/2011/post.md b/t/pages/blog/mdk/2011/post.md
new file mode 100644 (file)
index 0000000..16be9f0
--- /dev/null
@@ -0,0 +1,4 @@
+Title: mdk post 1
+created: 2011-01-02
+
+Post 1
diff --git a/t/pages/blog/mdk/post2.md b/t/pages/blog/mdk/post2.md
new file mode 100644 (file)
index 0000000..f587c29
--- /dev/null
@@ -0,0 +1,4 @@
+Title: mdk post 2
+created: 2011-01-03
+
+Post 2
diff --git a/t/pages/blog/mst.md b/t/pages/blog/mst.md
new file mode 100644 (file)
index 0000000..d4ca038
--- /dev/null
@@ -0,0 +1,4 @@
+Title: mst's blog
+created: 2012-01-01
+
+Test
diff --git a/t/pages/blog/mst/post.md b/t/pages/blog/mst/post.md
new file mode 100644 (file)
index 0000000..a428aa4
--- /dev/null
@@ -0,0 +1,4 @@
+Title: Mst post 1
+created: 2011-01-01
+
+Post 1
diff --git a/t/pages/blog/mst/post2.md b/t/pages/blog/mst/post2.md
new file mode 100644 (file)
index 0000000..2f04f81
--- /dev/null
@@ -0,0 +1,4 @@
+Title: Mst post 2
+created: 2011-01-05
+
+Post 2