Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Added a comment system

  • Loading branch information...
commit 1c6f249de3b689124e4aa4757a79b834ec2c01f5 1 parent a853eae
@hugoduncan authored
Showing with 969 additions and 174 deletions.
  1. +157 −0 cgi-bin/comments.cgi
  2. +3 −2 cl-blog-generator.asd
  3. +1 −1  content/site/index.atom
  4. +17 −3 content/site/index.xhtml
  5. +5 −1 content/site/post/2009/blog_generator_configuration.xhtml
  6. +9 −1 content/site/post/2009/blog_generator_design.xhtml
  7. +9 −1 content/site/post/2009/blog_site_generators.xhtml
  8. +1 −1  content/site/tag/blog.atom
  9. +13 −4 content/site/tag/blog.xhtml
  10. +1 −1  content/site/tag/clbloggenerator.atom
  11. +8 −4 content/site/tag/clbloggenerator.xhtml
  12. +1 −1  content/site/tag/generator.atom
  13. +7 −3 content/site/tag/generator.xhtml
  14. +1 −1  content/site/tag/lisp.atom
  15. +18 −4 content/site/tag/lisp.xhtml
  16. +6 −2 content/template/index.xhtml
  17. +5 −1 content/template/post.xhtml
  18. +6 −2 content/template/tag.xhtml
  19. +62 −0 src/comment-mail.lisp
  20. +1 −12 src/config.lisp
  21. +4 −1 src/package.lisp
  22. +479 −101 src/post.lisp
  23. +133 −21 test/post.lisp
  24. +8 −2 test/template/index.xhtml
  25. +1 −1  test/template/page.xhtml
  26. +5 −1 test/template/post.xhtml
  27. +8 −2 test/template/tag.xhtml
View
157 cgi-bin/comments.cgi
@@ -0,0 +1,157 @@
+#!/usr/bin/perl -w
+#
+# Based on chronicle's comments.cgi.
+#
+# This is a simple script which is designed to accept comment requests,
+# and save the details to local text files upon the localhost.
+#
+# This code is very simple and should be easy to extend with anti-spam
+# at a later point.
+#
+# NOTE: If you wish to use this you must edit three things at the
+# top of the script.
+#
+# 1. The email address to notify.
+# 2. The email address to use as the sender.
+
+use strict;
+use warnings;
+
+use CGI;
+use POSIX qw(strftime);
+
+#
+# The notification addresses - leave blank to disable
+#
+my $TO = 'comments@hugoduncan.org';
+my $FROM = 'weblog@hugoduncan.org';
+
+#
+# Find sendmail
+#
+my $SENDMAIL = undef;
+foreach my $file (qw ! /usr/lib/sendmail /usr/sbin/sendmail !)
+{
+ $SENDMAIL = $file if ( -x $file );
+}
+
+
+#
+# Get the parameters from the request.
+#
+my $cgi = new CGI();
+my $name = $cgi->param('name') || undef;
+my $mail = $cgi->param('mail') || undef;
+my $body = $cgi->param('body') || undef;
+my $id = $cgi->param('id') || undef;
+my $uri = $cgi->param('uri') || undef;
+my $cap = $cgi->param('captcha') || undef;
+my $ajax = $cgi->param("ajax") || 0;
+
+
+#
+# If any are missing just redirect back to the referer.
+#
+if ( !defined($name) ||
+ !length($name) ||
+ !defined($uri) ||
+ !length($uri) ||
+ !defined($body) ||
+ !length($body) ||
+ !defined($id) ||
+ !length($id) )
+{
+ if ($ajax)
+ {
+ print "Content-type: text/html\n\n";
+ print "Missing fields.\n";
+ }
+ else
+ {
+ print "Location: " . $ENV{ 'HTTP_REFERER' } . "\n\n";
+ }
+ exit;
+}
+
+#
+# Does the captcha value contain text? If so spam.
+#
+if ( defined($cap) && length($cap) )
+{
+ if ($ajax)
+ {
+ print "Content-type: text/html\n\n";
+ print "Missing fields.\n";
+ }
+ else
+ {
+ print "Location: " . $ENV{ 'HTTP_REFERER' } . "/\n\n";
+ }
+ exit;
+}
+
+
+
+#
+# get the current time
+#
+my $timestr = strftime "%Y-%m-%dT%H:%M:%S.000000Z", gmtime;
+
+
+#
+# Send a mail.
+#
+if ( length($TO) && length($FROM) && defined($SENDMAIL) )
+{
+ open( SENDMAIL, "|$SENDMAIL -t -f $FROM" );
+ print SENDMAIL "To: $TO\n";
+ print SENDMAIL "From: $FROM\n";
+ print SENDMAIL "Subject: New Comment [$id]\n";
+ print SENDMAIL "Content-type: text/html\n";
+ print SENDMAIL "X-Blogen-Name: $name\n";
+ print SENDMAIL "X-Blogen-Mail: $mail\n";
+ print SENDMAIL "X-Blogen-Uri: $uri\n";
+ print SENDMAIL "X-Blogen-User-Agent: $ENV{'HTTP_USER_AGENT'}\n";
+ print SENDMAIL "X-Blogen-IP-Address: $ENV{'REMOTE_ADDR'}\n";
+ print SENDMAIL "X-Blogen-When: $timestr\n";
+ print SENDMAIL "X-Blogen-id: $id\n";
+ print SENDMAIL "\n";
+ print SENDMAIL $body;
+ close(SENDMAIL);
+}
+
+#
+# Now show the user the thanks message..
+#
+
+#
+# Show the header
+#
+print "Content-type: text/html\n\n";
+
+if ( $cgi->param("ajax") )
+{
+ print <<EOF;
+<h3>Comment Submitted</h3>
+<blockquote>
+<p>Thanks for your comment, it will be made live when the queue is moderated next.</p>
+</blockquote>
+
+EOF
+ exit;
+}
+else
+{
+ print <<EOF;
+<html>
+ <head>
+ <title>Thanks For Your Comment</title>
+ </head>
+ <body>
+ <h2>Thanks!</h2>
+ <p>Your comment will be included the next time this blog is rebuilt.</p>
+ <p><a href="$ENV{'HTTP_REFERER'}">Return to blog</a>.</p>
+ </body>
+</html>
+EOF
+}
View
5 cl-blog-generator.asd
@@ -13,12 +13,13 @@
:maintainer "Hugo Duncan <hugo@hugoduncan.org>"
:licence "BSD Open Source"
:description "A generator for blog sites."
- :depends-on (:cxml :cl-fad :elephant :local-time :flexi-streams)
+ :depends-on (:cxml :cl-fad :elephant :local-time :flexi-streams :mel-base :cl-ppcre :babel)
:components
((:module "src"
:components
((:file "package" )
- (:file "post" :depends-on ("package"))))))
+ (:file "post" :depends-on ("package"))
+ (:file "comment-mail" :depends-on ("post"))))))
(defsystem #:cl-blog-generator-test
:name "cl-blog-generator-test"
View
2  content/site/index.atom
@@ -9,7 +9,7 @@
<author><name>Hugo Duncan</name></author>
<subtitle>Development Blog</subtitle>
<rights>All content written by Hugo Duncan and photos by Hugo Duncan Copyright Hugo Duncan, all rights reserved.</rights>
- <updated>2009-03-27T12:04:28.596533-04:00</updated>
+ <updated>2009-03-30T20:47:43.919555-04:00</updated>
<entry xml:base="http://hugoduncan.github.com/cl-blog-generator/content/site/"><title>Blog Site Generators</title><link href="http://hugoduncan.github.com/cl-blog-generator/content/site/post/2009/blog_site_generators.xhtml"/><id>http://hugoduncan.github.com/cl-blog-generator/content/site/post/2009/blog_site_generators.xhtml</id><published>2009-03-26T20:00:00.000000-04:00</published><updated>2009-03-26T20:00:00.000000-04:00</updated><published>2009-03-26T20:00:00.000000-04:00</published><category scheme="http://hugoduncan.github.com/cl-blog-generator/content/site/tags" term="cl-blog-generator"/><category scheme="http://hugoduncan.github.com/cl-blog-generator/content/site/tags" term="lisp"/><category scheme="http://hugoduncan.github.com/cl-blog-generator/content/site/tags" term="blog"/><summary type="xhtml"><div xmlns="http://www.w3.org/1999/xhtml"><p>
I recently uploaded some links to my <a href="http://github.com/hugoduncan/cl-blog-generator">cl-blog-generator</a> project, and have been getting some feedback with comparisons to other blog site generators, or compilers, such as <a href="http://www.advogato.org/person/Stevey/">Steve Kemp</a>'s <a href="http://www.steve.org.uk/Software/chronicle/">Chronicle</a>, or <a href="http://github.com/mojombo/jekyll">Jekyll</a> as used on <a href="http://github.com/blog/272-github-pages">GitHub Pages</a>. Compared to these, cl-blog-generator is immature, but takes a different approach in several areas that <a href="http://advogato.org/person/chalst/">Charles Stewart</a> suggested might be worth exploring. I look forward to any comments you might have.
View
20 content/site/index.xhtml
@@ -13,10 +13,24 @@
<div id="container">
<div id="banner"><h1>cl-blog-generator</h1></div>
<div id="centercontent">
-<div id="posts"><div class="post-synopsis"><span class="post-link"><a href="post/2009/blog_site_generators.xhtml">Blog Site Generators</a></span><p>
+<div class="posts">
+ <div class="post-link-with-synopsis">
+ <span class="post-link"><a href="post/2009/blog_site_generators.xhtml">Blog Site Generators</a></span> ·
+ <span class="post-synopsis"><p>
I recently uploaded some links to my <a href="http://github.com/hugoduncan/cl-blog-generator">cl-blog-generator</a> project, and have been getting some feedback with comparisons to other blog site generators, or compilers, such as <a href="http://www.advogato.org/person/Stevey/">Steve Kemp</a>'s <a href="http://www.steve.org.uk/Software/chronicle/">Chronicle</a>, or <a href="http://github.com/mojombo/jekyll">Jekyll</a> as used on <a href="http://github.com/blog/272-github-pages">GitHub Pages</a>. Compared to these, cl-blog-generator is immature, but takes a different approach in several areas that <a href="http://advogato.org/person/chalst/">Charles Stewart</a> suggested might be worth exploring. I look forward to any comments you might have.
-</p></div><div class="post-synopsis"><span class="post-link"><a href="post/2009/blog_generator_configuration.xhtml">Blog Generator Configuration</a></span><p>The blog generator is intended to be quite flexible, within the design constraints, which has lead to a large number of possible configurations, both on the lisp side, and for Emacs. Drafts can be written using any editor, but I shall describe use with Emacs. The package has only been tested with SBCL, but should work with any common lisp implentation.</p></div><div class="post-synopsis"><span class="post-link"><a href="post/2009/blog_generator_design.xhtml">Blog Generator Design</a></span><p>I want to be able publish posts easily to a statically served site. I am sure that there are lots of blog site generators out there, but I could not find one that I liked, and which was in a language I would enjoy hacking, and so I wrote my own.</p></div></div>
-<div id="footer"/>
+</p></span>
+ </div>
+
+ <div class="post-link-with-synopsis">
+ <span class="post-link"><a href="post/2009/blog_generator_configuration.xhtml">Blog Generator Configuration</a></span> ·
+ <span class="post-synopsis"><p>The blog generator is intended to be quite flexible, within the design constraints, which has lead to a large number of possible configurations, both on the lisp side, and for Emacs. Drafts can be written using any editor, but I shall describe use with Emacs. The package has only been tested with SBCL, but should work with any common lisp implentation.</p></span>
+ </div>
+
+ <div class="post-link-with-synopsis">
+ <span class="post-link"><a href="post/2009/blog_generator_design.xhtml">Blog Generator Design</a></span> ·
+ <span class="post-synopsis"><p>I want to be able publish posts easily to a statically served site. I am sure that there are lots of blog site generators out there, but I could not find one that I liked, and which was in a language I would enjoy hacking, and so I wrote my own.</p></span>
+ </div>
+</div>
</div>
<div id="rightcontent">
View
6 content/site/post/2009/blog_generator_configuration.xhtml
@@ -54,7 +54,11 @@
<div id="post-title">Blog Generator Configuration</div>
<div>Written: <span id="post-when">4-3-2009</span></div>
<div><span id="post-updated"/></div>
-Tags: <div class="post-tags"><ul><li><span class="tag"><a href="/cl-blog-generator/content/site/tag/lisp.xhtml">lisp</a></span></li></ul></div>
+Tags: <div id="post-tags">
+<ul class="post-tags">
+ <li class="post-tag"><a href="/cl-blog-generator/content/site/tag/lisp.xhtml">lisp</a></li>
+</ul>
+</div>
</div>
</div>
</div>
View
10 content/site/post/2009/blog_generator_design.xhtml
@@ -37,7 +37,15 @@
<div id="post-title">Blog Generator Design</div>
<div>Written: <span id="post-when">4-3-2009</span></div>
<div><span id="post-updated"/></div>
-Tags: <div class="post-tags"><ul><li><span class="tag"><a href="/cl-blog-generator/content/site/tag/generator.xhtml">generator</a></span></li><li><span class="tag"><a href="/cl-blog-generator/content/site/tag/blog.xhtml">blog</a></span></li><li><span class="tag"><a href="/cl-blog-generator/content/site/tag/lisp.xhtml">lisp</a></span></li></ul></div>
+Tags: <div id="post-tags">
+<ul class="post-tags">
+ <li class="post-tag"><a href="/cl-blog-generator/content/site/tag/generator.xhtml">generator</a></li>
+
+ <li class="post-tag"><a href="/cl-blog-generator/content/site/tag/blog.xhtml">blog</a></li>
+
+ <li class="post-tag"><a href="/cl-blog-generator/content/site/tag/lisp.xhtml">lisp</a></li>
+</ul>
+</div>
</div>
</div>
</div>
View
10 content/site/post/2009/blog_site_generators.xhtml
@@ -75,7 +75,15 @@ However, having <a href="http://common-lisp.net/project/elephant/">Elephant</a>
<div id="post-title">Blog Site Generators</div>
<div>Written: <span id="post-when">27-3-2009</span></div>
<div><span id="post-updated"/></div>
-Tags: <div class="post-tags"><ul><li><span class="tag"><a href="/cl-blog-generator/content/site/tag/clbloggenerator.xhtml">cl-blog-generator</a></span></li><li><span class="tag"><a href="/cl-blog-generator/content/site/tag/lisp.xhtml">lisp</a></span></li><li><span class="tag"><a href="/cl-blog-generator/content/site/tag/blog.xhtml">blog</a></span></li></ul></div>
+Tags: <div id="post-tags">
+<ul class="post-tags">
+ <li class="post-tag"><a href="/cl-blog-generator/content/site/tag/clbloggenerator.xhtml">cl-blog-generator</a></li>
+
+ <li class="post-tag"><a href="/cl-blog-generator/content/site/tag/lisp.xhtml">lisp</a></li>
+
+ <li class="post-tag"><a href="/cl-blog-generator/content/site/tag/blog.xhtml">blog</a></li>
+</ul>
+</div>
</div>
</div>
</div>
View
2  content/site/tag/blog.atom
@@ -9,7 +9,7 @@
<author><name>Hugo Duncan</name></author>
<subtitle>Development Blog</subtitle>
<rights>All content written by Hugo Duncan and photos by Hugo Duncan Copyright Hugo Duncan, all rights reserved.</rights>
- <updated>2009-03-27T12:04:28.810283-04:00</updated>
+ <updated>2009-03-30T20:47:44.151965-04:00</updated>
<entry xml:base="http://hugoduncan.github.com/cl-blog-generator/content/site/"><title>Blog Site Generators</title><link href="http://hugoduncan.github.com/cl-blog-generator/content/site/post/2009/blog_site_generators.xhtml"/><id>http://hugoduncan.github.com/cl-blog-generator/content/site/post/2009/blog_site_generators.xhtml</id><published>2009-03-26T20:00:00.000000-04:00</published><updated>2009-03-26T20:00:00.000000-04:00</updated><published>2009-03-26T20:00:00.000000-04:00</published><category scheme="http://hugoduncan.github.com/cl-blog-generator/content/site/tags" term="cl-blog-generator"/><category scheme="http://hugoduncan.github.com/cl-blog-generator/content/site/tags" term="lisp"/><category scheme="http://hugoduncan.github.com/cl-blog-generator/content/site/tags" term="blog"/><summary type="xhtml"><div xmlns="http://www.w3.org/1999/xhtml"><p>
I recently uploaded some links to my <a href="http://github.com/hugoduncan/cl-blog-generator">cl-blog-generator</a> project, and have been getting some feedback with comparisons to other blog site generators, or compilers, such as <a href="http://www.advogato.org/person/Stevey/">Steve Kemp</a>'s <a href="http://www.steve.org.uk/Software/chronicle/">Chronicle</a>, or <a href="http://github.com/mojombo/jekyll">Jekyll</a> as used on <a href="http://github.com/blog/272-github-pages">GitHub Pages</a>. Compared to these, cl-blog-generator is immature, but takes a different approach in several areas that <a href="http://advogato.org/person/chalst/">Charles Stewart</a> suggested might be worth exploring. I look forward to any comments you might have.
View
17 content/site/tag/blog.xhtml
@@ -13,10 +13,19 @@
<div id="container">
<div id="banner"><h1>cl-blog-generator :</h1></div>
<div id="centercontent">
-<div id="posts"><div class="post-synopsis"><span class="post-link"><a href="/Users/duncan/projects/blog/content/site/post/2009/blog_site_generators.xhtml">Blog Site Generators</a></span><p>
+<div class="posts">
+ <div class="post-link-with-synopsis">
+ <span class="post-link"><a href="/Users/duncan/projects/blog/content/site/post/2009/blog_site_generators.xhtml">Blog Site Generators</a></span> ·
+ <span class="post-synopsis"><p>
I recently uploaded some links to my <a href="http://github.com/hugoduncan/cl-blog-generator">cl-blog-generator</a> project, and have been getting some feedback with comparisons to other blog site generators, or compilers, such as <a href="http://www.advogato.org/person/Stevey/">Steve Kemp</a>'s <a href="http://www.steve.org.uk/Software/chronicle/">Chronicle</a>, or <a href="http://github.com/mojombo/jekyll">Jekyll</a> as used on <a href="http://github.com/blog/272-github-pages">GitHub Pages</a>. Compared to these, cl-blog-generator is immature, but takes a different approach in several areas that <a href="http://advogato.org/person/chalst/">Charles Stewart</a> suggested might be worth exploring. I look forward to any comments you might have.
-</p></div><div class="post-synopsis"><span class="post-link"><a href="/Users/duncan/projects/blog/content/site/post/2009/blog_generator_design.xhtml">Blog Generator Design</a></span><p>I want to be able publish posts easily to a statically served site. I am sure that there are lots of blog site generators out there, but I could not find one that I liked, and which was in a language I would enjoy hacking, and so I wrote my own.</p></div></div>
-<div id="footer"/>
+</p></span>
+ </div>
+
+ <div class="post-link-with-synopsis">
+ <span class="post-link"><a href="/Users/duncan/projects/blog/content/site/post/2009/blog_generator_design.xhtml">Blog Generator Design</a></span> ·
+ <span class="post-synopsis"><p>I want to be able publish posts easily to a statically served site. I am sure that there are lots of blog site generators out there, but I could not find one that I liked, and which was in a language I would enjoy hacking, and so I wrote my own.</p></span>
+ </div>
+</div>
</div>
<div id="rightcontent">
@@ -30,7 +39,7 @@ I recently uploaded some links to my <a href="http://github.com/hugoduncan/cl-bl
</a></div>
</div>
<hr/>
-Related Tags: <div class="tags-related"><ul><li><span class="tag"><a href="/cl-blog-generator/content/site/tag/clbloggenerator.xhtml">cl-blog-generator</a></span></li><li><span class="tag"><a href="/cl-blog-generator/content/site/tag/generator.xhtml">generator</a></span></li><li><span class="tag"><a href="/cl-blog-generator/content/site/tag/lisp.xhtml">lisp</a></span></li></ul></div>
+Related Tags: <div class="tags-related"><ul><li><a href="/cl-blog-generator/content/site/tag/clbloggenerator.xhtml">cl-blog-generator</a></li><li><a href="/cl-blog-generator/content/site/tag/generator.xhtml">generator</a></li><li><a href="/cl-blog-generator/content/site/tag/lisp.xhtml">lisp</a></li></ul></div>
</div>
</div>
</body>
View
2  content/site/tag/clbloggenerator.atom
@@ -9,7 +9,7 @@
<author><name>Hugo Duncan</name></author>
<subtitle>Development Blog</subtitle>
<rights>All content written by Hugo Duncan and photos by Hugo Duncan Copyright Hugo Duncan, all rights reserved.</rights>
- <updated>2009-03-27T12:04:28.655989-04:00</updated>
+ <updated>2009-03-30T20:47:43.993889-04:00</updated>
<entry xml:base="http://hugoduncan.github.com/cl-blog-generator/content/site/"><title>Blog Site Generators</title><link href="http://hugoduncan.github.com/cl-blog-generator/content/site/post/2009/blog_site_generators.xhtml"/><id>http://hugoduncan.github.com/cl-blog-generator/content/site/post/2009/blog_site_generators.xhtml</id><published>2009-03-26T20:00:00.000000-04:00</published><updated>2009-03-26T20:00:00.000000-04:00</updated><published>2009-03-26T20:00:00.000000-04:00</published><category scheme="http://hugoduncan.github.com/cl-blog-generator/content/site/tags" term="cl-blog-generator"/><category scheme="http://hugoduncan.github.com/cl-blog-generator/content/site/tags" term="lisp"/><category scheme="http://hugoduncan.github.com/cl-blog-generator/content/site/tags" term="blog"/><summary type="xhtml"><div xmlns="http://www.w3.org/1999/xhtml"><p>
I recently uploaded some links to my <a href="http://github.com/hugoduncan/cl-blog-generator">cl-blog-generator</a> project, and have been getting some feedback with comparisons to other blog site generators, or compilers, such as <a href="http://www.advogato.org/person/Stevey/">Steve Kemp</a>'s <a href="http://www.steve.org.uk/Software/chronicle/">Chronicle</a>, or <a href="http://github.com/mojombo/jekyll">Jekyll</a> as used on <a href="http://github.com/blog/272-github-pages">GitHub Pages</a>. Compared to these, cl-blog-generator is immature, but takes a different approach in several areas that <a href="http://advogato.org/person/chalst/">Charles Stewart</a> suggested might be worth exploring. I look forward to any comments you might have.
View
12 content/site/tag/clbloggenerator.xhtml
@@ -13,10 +13,14 @@
<div id="container">
<div id="banner"><h1>cl-blog-generator :</h1></div>
<div id="centercontent">
-<div id="posts"><div class="post-synopsis"><span class="post-link"><a href="/Users/duncan/projects/blog/content/site/post/2009/blog_site_generators.xhtml">Blog Site Generators</a></span><p>
+<div class="posts">
+ <div class="post-link-with-synopsis">
+ <span class="post-link"><a href="/Users/duncan/projects/blog/content/site/post/2009/blog_site_generators.xhtml">Blog Site Generators</a></span> ·
+ <span class="post-synopsis"><p>
I recently uploaded some links to my <a href="http://github.com/hugoduncan/cl-blog-generator">cl-blog-generator</a> project, and have been getting some feedback with comparisons to other blog site generators, or compilers, such as <a href="http://www.advogato.org/person/Stevey/">Steve Kemp</a>'s <a href="http://www.steve.org.uk/Software/chronicle/">Chronicle</a>, or <a href="http://github.com/mojombo/jekyll">Jekyll</a> as used on <a href="http://github.com/blog/272-github-pages">GitHub Pages</a>. Compared to these, cl-blog-generator is immature, but takes a different approach in several areas that <a href="http://advogato.org/person/chalst/">Charles Stewart</a> suggested might be worth exploring. I look forward to any comments you might have.
-</p></div></div>
-<div id="footer"/>
+</p></span>
+ </div>
+</div>
</div>
<div id="rightcontent">
@@ -30,7 +34,7 @@ I recently uploaded some links to my <a href="http://github.com/hugoduncan/cl-bl
</a></div>
</div>
<hr/>
-Related Tags: <div class="tags-related"><ul><li><span class="tag"><a href="/cl-blog-generator/content/site/tag/lisp.xhtml">lisp</a></span></li><li><span class="tag"><a href="/cl-blog-generator/content/site/tag/blog.xhtml">blog</a></span></li></ul></div>
+Related Tags: <div class="tags-related"><ul><li><a href="/cl-blog-generator/content/site/tag/generator.xhtml">generator</a></li><li><a href="/cl-blog-generator/content/site/tag/blog.xhtml">blog</a></li><li><a href="/cl-blog-generator/content/site/tag/lisp.xhtml">lisp</a></li></ul></div>
</div>
</div>
</body>
View
2  content/site/tag/generator.atom
@@ -9,7 +9,7 @@
<author><name>Hugo Duncan</name></author>
<subtitle>Development Blog</subtitle>
<rights>All content written by Hugo Duncan and photos by Hugo Duncan Copyright Hugo Duncan, all rights reserved.</rights>
- <updated>2009-03-27T12:04:28.863264-04:00</updated>
+ <updated>2009-03-30T20:47:44.203652-04:00</updated>
<entry xml:base="http://hugoduncan.github.com/cl-blog-generator/content/site/"><title>Blog Generator Design</title><link href="http://hugoduncan.github.com/cl-blog-generator/content/site/post/2009/blog_generator_design.xhtml"/><id>http://hugoduncan.github.com/cl-blog-generator/content/site/post/2009/blog_generator_design.xhtml</id><published>2009-03-03T19:00:00.000000-05:00</published><updated>2009-03-03T19:00:00.000000-05:00</updated><published>2009-03-03T19:00:00.000000-05:00</published><category scheme="http://hugoduncan.github.com/cl-blog-generator/content/site/tags" term="generator"/><category scheme="http://hugoduncan.github.com/cl-blog-generator/content/site/tags" term="blog"/><category scheme="http://hugoduncan.github.com/cl-blog-generator/content/site/tags" term="lisp"/><summary type="xhtml"><div xmlns="http://www.w3.org/1999/xhtml"><p>I want to be able publish posts easily to a statically served site. I am sure that there are lots of blog site generators out there, but I could not find one that I liked, and which was in a language I would enjoy hacking, and so I wrote my own.</p></div></summary><content type="xhtml"><div xmlns="http://www.w3.org/1999/xhtml"><p>I want to be able publish posts easily to a statically served site. I am sure that there are lots of blog site generators out there, but I could not find one that I liked, and which was in a language I would enjoy hacking, and so I wrote my own.</p>
View
10 content/site/tag/generator.xhtml
@@ -13,8 +13,12 @@
<div id="container">
<div id="banner"><h1>cl-blog-generator :</h1></div>
<div id="centercontent">
-<div id="posts"><div class="post-synopsis"><span class="post-link"><a href="/Users/duncan/projects/blog/content/site/post/2009/blog_generator_design.xhtml">Blog Generator Design</a></span><p>I want to be able publish posts easily to a statically served site. I am sure that there are lots of blog site generators out there, but I could not find one that I liked, and which was in a language I would enjoy hacking, and so I wrote my own.</p></div></div>
-<div id="footer"/>
+<div class="posts">
+ <div class="post-link-with-synopsis">
+ <span class="post-link"><a href="/Users/duncan/projects/blog/content/site/post/2009/blog_generator_design.xhtml">Blog Generator Design</a></span> ·
+ <span class="post-synopsis"><p>I want to be able publish posts easily to a statically served site. I am sure that there are lots of blog site generators out there, but I could not find one that I liked, and which was in a language I would enjoy hacking, and so I wrote my own.</p></span>
+ </div>
+</div>
</div>
<div id="rightcontent">
@@ -28,7 +32,7 @@
</a></div>
</div>
<hr/>
-Related Tags: <div class="tags-related"><ul><li><span class="tag"><a href="/cl-blog-generator/content/site/tag/blog.xhtml">blog</a></span></li><li><span class="tag"><a href="/cl-blog-generator/content/site/tag/clbloggenerator.xhtml">cl-blog-generator</a></span></li><li><span class="tag"><a href="/cl-blog-generator/content/site/tag/lisp.xhtml">lisp</a></span></li></ul></div>
+Related Tags: <div class="tags-related"><ul><li><a href="/cl-blog-generator/content/site/tag/blog.xhtml">blog</a></li><li><a href="/cl-blog-generator/content/site/tag/clbloggenerator.xhtml">cl-blog-generator</a></li><li><a href="/cl-blog-generator/content/site/tag/lisp.xhtml">lisp</a></li></ul></div>
</div>
</div>
</body>
View
2  content/site/tag/lisp.atom
@@ -9,7 +9,7 @@
<author><name>Hugo Duncan</name></author>
<subtitle>Development Blog</subtitle>
<rights>All content written by Hugo Duncan and photos by Hugo Duncan Copyright Hugo Duncan, all rights reserved.</rights>
- <updated>2009-03-27T12:04:28.716067-04:00</updated>
+ <updated>2009-03-30T20:47:44.043133-04:00</updated>
<entry xml:base="http://hugoduncan.github.com/cl-blog-generator/content/site/"><title>Blog Site Generators</title><link href="http://hugoduncan.github.com/cl-blog-generator/content/site/post/2009/blog_site_generators.xhtml"/><id>http://hugoduncan.github.com/cl-blog-generator/content/site/post/2009/blog_site_generators.xhtml</id><published>2009-03-26T20:00:00.000000-04:00</published><updated>2009-03-26T20:00:00.000000-04:00</updated><published>2009-03-26T20:00:00.000000-04:00</published><category scheme="http://hugoduncan.github.com/cl-blog-generator/content/site/tags" term="cl-blog-generator"/><category scheme="http://hugoduncan.github.com/cl-blog-generator/content/site/tags" term="lisp"/><category scheme="http://hugoduncan.github.com/cl-blog-generator/content/site/tags" term="blog"/><summary type="xhtml"><div xmlns="http://www.w3.org/1999/xhtml"><p>
I recently uploaded some links to my <a href="http://github.com/hugoduncan/cl-blog-generator">cl-blog-generator</a> project, and have been getting some feedback with comparisons to other blog site generators, or compilers, such as <a href="http://www.advogato.org/person/Stevey/">Steve Kemp</a>'s <a href="http://www.steve.org.uk/Software/chronicle/">Chronicle</a>, or <a href="http://github.com/mojombo/jekyll">Jekyll</a> as used on <a href="http://github.com/blog/272-github-pages">GitHub Pages</a>. Compared to these, cl-blog-generator is immature, but takes a different approach in several areas that <a href="http://advogato.org/person/chalst/">Charles Stewart</a> suggested might be worth exploring. I look forward to any comments you might have.
View
22 content/site/tag/lisp.xhtml
@@ -13,10 +13,24 @@
<div id="container">
<div id="banner"><h1>cl-blog-generator :</h1></div>
<div id="centercontent">
-<div id="posts"><div class="post-synopsis"><span class="post-link"><a href="/Users/duncan/projects/blog/content/site/post/2009/blog_site_generators.xhtml">Blog Site Generators</a></span><p>
+<div class="posts">
+ <div class="post-link-with-synopsis">
+ <span class="post-link"><a href="/Users/duncan/projects/blog/content/site/post/2009/blog_site_generators.xhtml">Blog Site Generators</a></span> ·
+ <span class="post-synopsis"><p>
I recently uploaded some links to my <a href="http://github.com/hugoduncan/cl-blog-generator">cl-blog-generator</a> project, and have been getting some feedback with comparisons to other blog site generators, or compilers, such as <a href="http://www.advogato.org/person/Stevey/">Steve Kemp</a>'s <a href="http://www.steve.org.uk/Software/chronicle/">Chronicle</a>, or <a href="http://github.com/mojombo/jekyll">Jekyll</a> as used on <a href="http://github.com/blog/272-github-pages">GitHub Pages</a>. Compared to these, cl-blog-generator is immature, but takes a different approach in several areas that <a href="http://advogato.org/person/chalst/">Charles Stewart</a> suggested might be worth exploring. I look forward to any comments you might have.
-</p></div><div class="post-synopsis"><span class="post-link"><a href="/Users/duncan/projects/blog/content/site/post/2009/blog_generator_configuration.xhtml">Blog Generator Configuration</a></span><p>The blog generator is intended to be quite flexible, within the design constraints, which has lead to a large number of possible configurations, both on the lisp side, and for Emacs. Drafts can be written using any editor, but I shall describe use with Emacs. The package has only been tested with SBCL, but should work with any common lisp implentation.</p></div><div class="post-synopsis"><span class="post-link"><a href="/Users/duncan/projects/blog/content/site/post/2009/blog_generator_design.xhtml">Blog Generator Design</a></span><p>I want to be able publish posts easily to a statically served site. I am sure that there are lots of blog site generators out there, but I could not find one that I liked, and which was in a language I would enjoy hacking, and so I wrote my own.</p></div></div>
-<div id="footer"/>
+</p></span>
+ </div>
+
+ <div class="post-link-with-synopsis">
+ <span class="post-link"><a href="/Users/duncan/projects/blog/content/site/post/2009/blog_generator_configuration.xhtml">Blog Generator Configuration</a></span> ·
+ <span class="post-synopsis"><p>The blog generator is intended to be quite flexible, within the design constraints, which has lead to a large number of possible configurations, both on the lisp side, and for Emacs. Drafts can be written using any editor, but I shall describe use with Emacs. The package has only been tested with SBCL, but should work with any common lisp implentation.</p></span>
+ </div>
+
+ <div class="post-link-with-synopsis">
+ <span class="post-link"><a href="/Users/duncan/projects/blog/content/site/post/2009/blog_generator_design.xhtml">Blog Generator Design</a></span> ·
+ <span class="post-synopsis"><p>I want to be able publish posts easily to a statically served site. I am sure that there are lots of blog site generators out there, but I could not find one that I liked, and which was in a language I would enjoy hacking, and so I wrote my own.</p></span>
+ </div>
+</div>
</div>
<div id="rightcontent">
@@ -30,7 +44,7 @@ I recently uploaded some links to my <a href="http://github.com/hugoduncan/cl-bl
</a></div>
</div>
<hr/>
-Related Tags: <div class="tags-related"><ul><li><span class="tag"><a href="/cl-blog-generator/content/site/tag/clbloggenerator.xhtml">cl-blog-generator</a></span></li><li><span class="tag"><a href="/cl-blog-generator/content/site/tag/generator.xhtml">generator</a></span></li><li><span class="tag"><a href="/cl-blog-generator/content/site/tag/blog.xhtml">blog</a></span></li></ul></div>
+Related Tags: <div class="tags-related"><ul><li><a href="/cl-blog-generator/content/site/tag/clbloggenerator.xhtml">cl-blog-generator</a></li><li><a href="/cl-blog-generator/content/site/tag/generator.xhtml">generator</a></li><li><a href="/cl-blog-generator/content/site/tag/blog.xhtml">blog</a></li></ul></div>
</div>
</div>
</body>
View
8 content/template/index.xhtml
@@ -13,8 +13,12 @@
<div id='container'>
<div id='banner'><h1>cl-blog-generator</h1></div>
<div id='centercontent'>
-<div id='posts'/>
-<div id='footer'></div>
+<div class='posts'>
+ <div class="post-link-with-synopsis">
+ <span class="post-link"/> &#xb7;
+ <span class="post-synopsis"/>
+ </div>
+</div>
</div>
<div id='rightcontent'>
View
6 content/template/post.xhtml
@@ -28,7 +28,11 @@
<div id='post-title'></div>
<div>Written: <span id='post-when'></span></div>
<div><span id='post-updated'></span></div>
-Tags: <div class="post-tags"></div>
+Tags: <div id="post-tags">
+<ul class="post-tags">
+ <li class="post-tag"/>
+</ul>
+</div>
</div>
</div>
</div>
View
8 content/template/tag.xhtml
@@ -13,8 +13,12 @@
<div id='container'>
<div id='banner'><h1>cl-blog-generator :</h1></div>
<div id='centercontent'>
-<div id='posts'/>
-<div id='footer'></div>
+<div class='posts'>
+ <div class="post-link-with-synopsis">
+ <span class="post-link"/> &#xb7;
+ <span class="post-synopsis"/>
+ </div>
+</div>
</div>
<div id='rightcontent'>
View
62 src/comment-mail.lisp
@@ -0,0 +1,62 @@
+;;;; Comment mail processor
+
+;;; Process incoming comments from a mailbox
+
+(in-package #:cl-blog-generator)
+
+(defvar *unmoderated* nil)
+(defvar *mailbox-type* nil)
+(defvar *mailbox-args* nil)
+
+;;; Top level moderate function
+(defun moderate ()
+ (with-open-store ()
+ (process-mailbox)))
+
+;;;# Process Mailbox
+;;; Processes all incoming comments
+(defun process-mailbox ()
+ "Process each mail in the inbox"
+ (mapc #'process-message (mel:messages (open-mailbox)))
+ (values nil))
+
+;;; Open the configured mailbox
+(defun open-mailbox ()
+ "Open the configured mailbox"
+ (let ((fun (ecase *mailbox-type*
+ (:imap #'mel.folders.imap:make-imap-folder))))
+ (apply fun *mailbox-args*)))
+
+;;; Process a single comment message
+(defun process-message (message)
+ "Process a comment message"
+ (restart-case
+ (flet ((field (name)
+ (string-left-trim '(#\Space) (mel:field name message))))
+ (let ((name (field :x-blogen-name))
+ (id (field :x-blogen-id))
+ (mail (field :x-blogen-mail))
+ (ip (field :x-blogen-ip-address))
+ (uri (field :x-blogen-uri))
+ (when (local-time:parse-rfc3339-timestring
+ (field :x-blogen-when)))
+ (text (with-output-to-string (out)
+ (with-open-stream (stream (mel:message-body-stream message))
+ (loop for c = (read-char stream nil nil)
+ while c do (write-char c out))))))
+
+ (if id
+ (if (or *unmoderated* (moderate-message id ip name mail uri when text))
+ (add-comment id ip name mail uri (local-time:timestamp-to-universal when) text)))))
+ (delete-offending-message () nil))
+ (mel:delete-message message))
+
+;;; Moderate a message
+(defun moderate-message (id ip name mail uri when text)
+ "Moderate a message"
+ (format
+ t "date: ~A~%id: ~A~%name: ~A~%mail: ~A~%uri: ~A~%ip: ~A~%Text:~%~A~%~%~%Enter with no content to post, anything to delete."
+ (local-time:format-rfc3339-timestring t when) id name mail uri ip text)
+ (let ((l (read-line)))
+ (zerop (length l))))
+
View
13 src/config.lisp
@@ -24,18 +24,7 @@
(:template-path . #p"/Users/duncan/projects/blog/test/template/"))
"My test environment")
- (defparameter *production-environment*
- '((:blog-title . "Hugo Duncan")
- (:blog-db-spec . (:postmodern (:postgresql "127.0.0.1" "blog" "duncan" "")))
- (:blog-domain . "hugoduncan.org")
- (:blog-root-path . "/") ;; should end in /
- (:site-path . #p"/Users/duncan/Sites/")
- (:published-path . #p"/Users/duncan/blog/published/")
- (:template-path . #p"/Users/duncan/blog/template/"))
- "My production environment")
-
(set-environment :test *test-environment*)
(set-environment :development *development-environment*)
- (set-environment :production *production-environment*)
- (configure :production))
+ (configure :test))
View
5 src/package.lisp
@@ -6,11 +6,14 @@
#:generate-site
#:set-environment
#:configure
+ #:moderate
#:*blog-db-spec*
#:*blog-domain*
#:*blog-root-path*
#:*site-path*
#:*published-path*
#:*template-path*
- #:*relative-path-fn*))
+ #:*relative-path-fn*
+ #:*mailbox-type*
+ #:*mailbox-args*))
View
580 src/post.lisp
@@ -25,7 +25,6 @@
(defvar *template-path* nil
"The local directory that contains the xhtml templates.")
-
;;; Optional configuration for customising the behaviour of the system
(defvar *id-generator-fn* nil
"Function used to generate a unique id for an item.")
@@ -41,6 +40,8 @@
"Default path list for PAGE content.")
(defvar *tag-page-path* '("tag")
"Default path list for TAG-PAGE content.")
+(defvar *comment-path* '("comment")
+ "Default path list for COMMENT.")
(defvar *blog-post-template* "post"
"Template to use for each blog-post")
@@ -50,7 +51,8 @@
(defvar *templated-content-file-types*
'((page . "page")
- (blog-post . "post"))
+ (blog-post . "post")
+ (comment . "comment"))
"Default file extensions for the published content.")
(defvar *category-scheme-uri* nil
@@ -94,15 +96,41 @@
"ID of element to contain the post when date")
(defparameter *post-updated-id* "post-updated"
"ID of element to contain the post updated date")
-(defparameter *post-posts-id* "posts"
- "ID of element to contain the posts list")
+(defparameter *post-posts-class* "posts"
+ "Class of element to contain the posts list")
+(defparameter *post-synopsis-class* "post-synopsis"
+ "Class of element to contain a post's synopsis")
+(defparameter *post-link-class* "post-link"
+ "Class of element to contain a post's link")
(defparameter *post-tags-class* "post-tags"
"Class of element to contain the post's tags")
+(defparameter *post-tag-class* "post-tag"
+ "Class of element to contain a post tags")
+
(defparameter *tag-name-class* "tag-name"
"Class of element to contain the tag's name")
(defparameter *tag-related-class* "tags-related"
"Class of element to contain the tag's related tags")
+(defparameter *comment-count-class* "comment-count"
+ "Class of element to contain the count of the comments")
+(defparameter *comments-class* "comments-list"
+ "Class of element to contain the comments")
+(defparameter *comment-class* "comment-entry"
+ "Class of element to contain a comment")
+
+(defparameter *comment-id-class* "comment-id"
+ "Class of element to contain a comment id")
+(defparameter *comment-link-class* "comment-link"
+ "Class of element to contain a comment's link")
+(defparameter *comment-from-class* "comment-from"
+ "Class of element to contain a comment's originator")
+(defparameter *comment-when-class* "comment-when"
+ "Class of element to contain a comment's timestamp")
+
+(defparameter *post-slug-hidden-input-class* "post-slug-hidden-input"
+ "Class of element to contain a hidden input element containing the page slug")
+
(defparameter *publish-xml-indentation* nil)
@@ -210,16 +238,17 @@
(defun %copy-current-element-content (source sink)
"When called with an un-output start-element, copy the content of the element.
The end-element event will be consumed but not output."
- (klacks:consume source)
+;; (klacks:consume source)
(loop with depth = 1
for key = (klacks:peek source)
do
(when (and (eql key :end-element) (zerop (decf depth)))
(return nil))
- (when (eql key :end-element)
+ (when (eql key :start-element)
(incf depth))
(klacks:serialize-event source sink))
- (klacks:consume source))
+;; (klacks:consume source)
+ )
(defun %copy-current-element (source sink)
"When called with an un-output start-element, copy the current element."
@@ -272,7 +301,7 @@ The end-element event will be consumed but not output."
(defun %copy-to-next-start-element (source sink lname)
"Find the next LNAME element in the SOURCE outputting up to the found element
-to SINK."
+to SINK. Returns the attributes of the element found."
(loop for (key ns ln) = (multiple-value-list (klacks:peek source))
while key
do
@@ -280,6 +309,15 @@ to SINK."
(return (%capture-attributes source)))
(klacks:serialize-event source sink)))
+(defun %skip-to-next-start-element (source lname)
+ "Find the next LNAME element in the SOURCE."
+ (loop for (key ns ln) = (multiple-value-list (klacks:peek source))
+ while key
+ do
+ (when (and (eql key :start-element) (string= lname ln))
+ (return key))
+ (klacks:consume source)))
+
;;; A debugging function to dump the current event
(defun %format-peek (source)
@@ -395,6 +433,48 @@ to SINK."
"The blog title is returned as empty in the expectation that it is specified in the template"
"")
+;;;### Tag pages
+(defclass tag-page (generated-content)
+ ((filename :initarg :filename :reader content-filename)
+ (tag :initarg :tag :initform nil :reader tag-page-tag :index t)
+ (related-tags :initarg :related-tags :initform nil :accessor tag-page-related-tags)
+ (feed :accessor content-feed :transient t))
+ (:metaclass elephant:persistent-metaclass)
+ (:documentation "Page for content matching a tag."))
+
+(defmethod shared-initialize :after
+ ((tag-page tag-page) slot-names &key &allow-other-keys)
+ (with-slots (feed tag filename) tag-page
+ (setf filename (%sanitise-title tag))
+ (unless (and (slot-boundp tag-page 'feed) feed)
+ (setf feed
+ (make-instance 'atom-feed
+ :title (format nil "~A : ~A" *blog-title* tag)
+ :uri (url-for tag-page)
+ :content-page tag-page)))))
+
+
+(defmethod relative-path-for ((tag-page tag-page))
+ "Relative path for a tag page"
+ *tag-page-path*)
+
+(defmethod path-for ((tag-page tag-page))
+ (format nil "~A~A~A.xhtml" *blog-root-path*
+ (relative-namestring-for tag-page)
+ (content-filename tag-page)))
+
+(defmethod site-file-path-for ((tag-page tag-page))
+ "Find the site file path for the specified TAG-PAGE."
+ (ensure-directories-exist
+ (merge-pathnames
+ (make-pathname :directory (relative-directory-for tag-page)
+ :name (content-filename tag-page)
+ :type "xhtml") *site-path*)))
+
+(defmethod content-title ((tag-page tag-page))
+ (tag-page-tag tag-page))
+
+
;;;### Templated content
;;; All content that uses a template to merge user written content.
(defclass templated-content (generated-content)
@@ -429,15 +509,15 @@ to SINK."
(setf description (%sanitise-synopsis synopsis))))))
-(defmethod published-file-path-for ((templated-content templated-content))
+(defmethod published-file-path-for (published-content)
"Find the publish file path for the specified TEMPLATED-CONTENT."
- (let ((type (cdr (assoc (type-of templated-content)
+ (let ((type (cdr (assoc (type-of published-content)
*templated-content-file-types*))))
(assert type)
(ensure-directories-exist
(merge-pathnames
- (make-pathname :directory (relative-directory-for templated-content)
- :name (content-filename templated-content)
+ (make-pathname :directory (relative-directory-for published-content)
+ :name (content-filename published-content)
:type type)
*published-path*))))
@@ -457,52 +537,13 @@ to SINK."
(defun content-year (templated-content)
"Returns the year of the blog post."
- (destructuring-bind (day month year) (decode-date (content-when templated-content))
+ (destructuring-bind (day month year)
+ (decode-date (content-when templated-content))
(declare (ignore day month))
(values year)))
-;;;### Tag pages
-(defclass tag-page (generated-content)
- ((filename :initarg :filename :reader content-filename)
- (tag :initarg :tag :initform nil :reader tag-page-tag :index t)
- (related-tags :initarg :related-tags :initform nil :accessor tag-page-related-tags)
- (feed :accessor content-feed :transient t))
- (:metaclass elephant:persistent-metaclass)
- (:documentation "Page for content matching a tag."))
-
-(defmethod shared-initialize :after
- ((tag-page tag-page) slot-names &key &allow-other-keys)
- (with-slots (feed tag filename) tag-page
- (setf filename (%sanitise-title tag))
- (unless (and (slot-boundp tag-page 'feed) feed)
- (setf feed
- (make-instance 'atom-feed
- :title (format nil "~A : ~A" *blog-title* tag)
- :uri (url-for tag-page)
- :content-page tag-page)))))
-
-
-(defmethod relative-path-for ((tag-page tag-page))
- "Relative path for a tag page"
- *tag-page-path*)
-
-(defmethod path-for ((tag-page tag-page))
- (format nil "~A~A~A.xhtml" *blog-root-path*
- (relative-namestring-for tag-page)
- (content-filename tag-page)))
-
-(defmethod site-file-path-for ((tag-page tag-page))
- "Find the site file path for the specified TAG-PAGE."
- (ensure-directories-exist
- (merge-pathnames
- (make-pathname :directory (relative-directory-for tag-page)
- :name (content-filename tag-page)
- :type "xhtml") *site-path*)))
-
-(defmethod content-title ((tag-page tag-page))
- (tag-page-tag tag-page))
;;;### Page
;;; A user written page that is meant to be updated over time, and is not a blog post
@@ -524,12 +565,41 @@ to SINK."
(cxml:attribute *href* (or url (path-for page)))
(cxml:text (content-title page)))))
+;;;### Comment for a blog post
+(defclass comment ()
+ ((content-page :initarg :content-page :reader content-page)
+ (filename :initarg :filename :reader content-filename)
+ (ip :initarg :ip :reader comment-ip)
+ (name :initarg :name :reader comment-name)
+ (email :initarg :email :reader comment-email)
+ (uri :initarg :uri :reader comment-uri)
+ (when :initarg :when :reader comment-when))
+ (:metaclass elephant:persistent-metaclass)
+ (:documentation "Metadata for comments"))
+
+(defmethod shared-initialize :after
+ ((comment comment) slot-names &key &allow-other-keys)
+ (with-slots (filename name when) comment
+ ;; default to current time
+ (unless when
+ (setf when (get-universal-time)))
+ ;; create a sanitised filename
+ (setf filename (format nil "~A_~A" when (%sanitise-title name)))))
+
+(defmethod relative-path-for ((comment comment))
+ "Relative path for a comment."
+ (append *comment-path*
+ (list (content-filename (content-page comment)))))
+
+(defmethod path-for ((comment comment))
+ (concatenate 'simple-string (path-for (content-page comment)) "#" (content-filename comment)))
;;;### Blog post
;;; A blog post is content with a template of "post" which is the default template.
(defclass blog-post (templated-content)
- ((template :initform *blog-post-template* :reader content-template :allocation :class :transient t))
+ ((template :initform *blog-post-template* :reader content-template :allocation :class :transient t)
+ (comments :initform (elephant:make-btree) :reader content-comments))
(:metaclass elephant:persistent-metaclass)
(:documentation "Metadata for blog-posts"))
@@ -547,18 +617,14 @@ to SINK."
(append *blog-post-path* (list (format nil "~A" (content-year blog-post)))))
(defmethod link-for ((blog-post blog-post) &key url)
- (cxml:with-element "span"
- (cxml:attribute "class" "post-link")
- (cxml:with-element "a"
- (cxml:attribute *href* (or url (path-for blog-post)))
- (cxml:text (content-title blog-post)))))
+ (cxml:with-element "a"
+ (cxml:attribute *href* (or url (path-for blog-post)))
+ (cxml:text (content-title blog-post))))
(defmethod link-for ((tag-page tag-page) &key url)
- (cxml:with-element "span"
- (cxml:attribute "class" "tag")
- (cxml:with-element "a"
- (cxml:attribute *href* (or url (path-for tag-page)))
- (cxml:text (tag-page-tag tag-page)))))
+ (cxml:with-element "a"
+ (cxml:attribute *href* (or url (path-for tag-page)))
+ (cxml:text (tag-page-tag tag-page))))
(defmethod content-feed ((blog-post blog-post))
(content-feed (index-page)))
@@ -648,6 +714,14 @@ to SINK."
(values prior next))))
+(defun %btree-length (btree)
+ "Counts the number of entries in BTREE"
+ (let ((count 0))
+ (flet ((inc-counter (key value)
+ (declare (ignore key value))
+ (incf count)))
+ (elephant:map-btree #'inc-counter btree)
+ count)))
;;;# Publishing
@@ -686,6 +760,67 @@ the path to the published file and the site path."
(url-for templated-content)
(path-for templated-content)))))
+;;;## Add a comment
+;;; Adds comment metadata to the database and writes a published comment file
+(defun add-comment (post-slug ip name email uri when text)
+ "Create a comment TEXT on the post identified by POST-SLUG, originating from
+ NAME with EMAIL and URI. TEXT is plain text."
+ (macrolet ((with-each-paragraph ((var text) &body body)
+ (let ((paras (gensym)))
+ `(let ((,paras (cl-ppcre:split "(?:\\r\\n|\\n|\\r){2,}" ,text)))
+ (loop for ,var in ,paras
+ do ,@body)))))
+ (labels ((htmlify (para)
+ (let ((i 0))
+ (cl-ppcre:do-scans (ms me rs re "(https?|mailto)://[\\S-/]+/\\S*" para)
+ (when (> ms i)
+ (cxml:text (subseq para i ms)))
+ (let ((link (subseq para ms me)))
+ (cxml:with-element "a"
+ (cxml:attribute "href" link)
+ (cxml:attribute "rel" "nofollow")
+ (cxml:text link)))
+ (setf i me))
+ (when (< i (length para))
+ (cxml:text (subseq para i)))))
+ (output-text-as-html (text)
+ "Output text converted to simple HTML"
+ (with-each-paragraph (paragraph text)
+ (cxml:with-element "p"
+ (htmlify paragraph)))))
+ (let ((blog-post
+ (elephant::get-instance-by-value 'blog-post 'filename post-slug)))
+ (unless blog-post
+ (error "Unknown post ~A" post-slug))
+ (let ((comment (make-instance 'comment :content-page blog-post :ip ip :name
+ name :email email :uri uri :when when)))
+ (setf (elephant:get-value (content-filename comment)
+ (content-comments blog-post))
+ comment)
+ (setf (dirty blog-post) t)
+ (with-open-file (stream (published-file-path-for comment)
+ :element-type '(unsigned-byte 8)
+ :direction :output :if-does-not-exist :create)
+ (let ((output (cxml:make-octet-stream-sink stream :canonical nil
+ :indentation nil
+ :omit-xml-declaration-p t)))
+ (cxml:with-xml-output output
+ (cxml:with-element "comment"
+ (cxml:with-element "ip"
+ (cxml:text ip))
+ (cxml:with-element "name"
+ (cxml:text name))
+ (cxml:with-element "email"
+ (cxml:text email))
+ (cxml:with-element "uri"
+ (cxml:text uri))
+ (cxml:with-element "when"
+ (cxml:text (local-time:format-rfc3339-timestring
+ nil (local-time:universal-to-timestamp when))))
+ (cxml:with-element "text"
+ (output-text-as-html text))))))
+ (values comment))))))
+
(defun make-metadata (title when updated tags filename description
synopsis template)
"Create metadata of the appropriate type"
@@ -843,17 +978,18 @@ when (day month year), updated (day month year), tags, linkname, description, an
(elephant:map-class #'(lambda (post) (setf (dirty post) t)) 'tag-page))
-(defun %ensure-tag-page (tag tags)
+(defun %ensure-tag-page (tag &optional tags)
(let ((tag-page (or (elephant:get-instance-by-value 'tag-page 'tag tag)
(make-instance 'tag-page :tag tag))))
(setf (dirty tag-page) t)
- (setf (tag-page-related-tags tag-page)
- (delete tag
- (remove-duplicates
- (merge 'list (tag-page-related-tags tag-page)
- (copy-seq tags) #'string<)
- :test #'string=)
- :test #'string=))
+ (when tags
+ (setf (tag-page-related-tags tag-page)
+ (delete tag
+ (remove-duplicates
+ (merge 'list (tag-page-related-tags tag-page)
+ (copy-seq tags) #'string<)
+ :test #'string=)
+ :test #'string=)))
(values tag-page)))
(defun %ensure-tag-pages-for (content)
@@ -986,8 +1122,11 @@ the templates)."
(path-for (index-page)))))
;;;## Output functions
-;;; Used to output content
+
+;;; Used to output the current element from the template, executing the macro's
+;;; body before writing the end element tag
(defmacro with-existing-element ((template output) &body body)
+ "Ouput the template, executing body before closing the current element."
(let ((tp (gensym))
(o (gensym))
(k (gensym)))
@@ -999,6 +1138,74 @@ the templates)."
,@body
(klacks:serialize-event ,tp ,o))))
+;;; Ouput the template, executing body before closing the current element. The
+;;; content of the template element is expected to be a format template and is
+;;; not output verbatim.
+(defmacro with-existing-element-as-format-template ((format-var template output) &body body)
+ "Execute BODY with the current element, assigning the inner content of the
+element to FORMAT-VAR."
+ (let ((tp (gensym))
+ (o (gensym))
+ (k (gensym))
+ (d (gensym)))
+ `(let ((,tp ,template)
+ (,o ,output)
+ (,format-var ""))
+ (klacks:serialize-event ,tp ,o)
+ (loop for (,k ,d) = (multiple-value-list (klacks:peek ,tp))
+ while (not (eql ,k :end-element))
+ do (when (eql ,k :characters)
+ (setf ,format-var (concatenate 'simple-string ,format-var ,d)))
+ (klacks:consume-characters ,tp))
+ ,@body
+ (klacks:serialize-event ,tp ,o))))
+
+
+(defun merge-assoc (a b &key (test #'eql))
+ "Merge association lists A and B, such that values from B take precedence."
+ (loop with result = (copy-seq a)
+ for kv in b
+ for assoc = (assoc (car kv) a :test test)
+ do
+ (if assoc
+ (setf (cdr assoc) (cdr kv))
+ (setf result (acons (car kv) (cdr kv) result)))
+ finally
+ (return result)))
+
+
+;;; Ouput the template, executing body before closing the current element. The
+;;; content of the template element is expected to be a format template and is
+;;; not output verbatim.
+(defmacro with-existing-element-setting-attributes ((content template output old-attributes new-attributes) &body body)
+ "Execute BODY with the current element, ensuring that the specified
+NEW-ATTRIBUTES are merged with OLD-ATTRIBUTES and appear on the element."
+ (let ((co (gensym))
+ (tp (gensym))
+ (o (gensym))
+ (oa (gensym))
+ (na (gensym))
+ (k (gensym))
+ (ns (gensym))
+ (d (gensym)))
+ `(let ((,co ,content)
+ (,tp ,template)
+ (,o ,output)
+ (,oa ,old-attributes)
+ (,na ,new-attributes))
+ (multiple-value-bind (,k ,ns ,d) (klacks:consume ,tp)
+ (declare (ignore ,ns ,k))
+ (assert (eql ,k :start-element))
+ (cxml:with-element ,d
+ (mapc #'(lambda (x) (cxml:attribute (car x) (cdr x)))
+ (merge-assoc ,oa ,na :test #'string=))
+ (cxml:text "")
+ (output-with-rewrite ,co ,tp ,o)
+ ,@body))
+ (klacks:consume ,tp))))
+
+
+
(defun output-post-content-no-template (blog-post output)
(klacks:with-open-source
@@ -1026,7 +1233,7 @@ the templates)."
(with-existing-element (template output)
(cxml:text (content-title blog-post))))
-(defun output-post-link (content template output attributes)
+(defun output-post-meta-link (content template output attributes)
"Output link element for feed"
(let ((rel (assoc "rel" attributes :test #'string=))
(type (assoc "type" attributes :test #'string=)))
@@ -1056,7 +1263,7 @@ the templates)."
(cxml:attribute "id" "post-updated-date")
(cxml:text (format nil "~{~A~^-~}" (decode-date updated))))))))
-(defun output-post-synopsis (blog-post output)
+(defun write-post-synopsis (blog-post output)
"Output the synopsis"
(klacks:with-open-source
(source (cxml:make-source (content-synopsis blog-post) :entity-resolver #'null-resolver))
@@ -1067,18 +1274,6 @@ the templates)."
(defparameter *index-collection* nil)
-(defun output-post-synopses-with-links (content template output attributes)
- (declare (ignore attributes))
- (flet ((output-post-link (blog-post)
- (cxml:with-element "div"
- (cxml:attribute "class" "post-synopsis")
- (link-for blog-post
- :url (enough-namestring
- (site-file-path-for blog-post)
- (site-file-path-for content)))
- (output-post-synopsis blog-post output))))
- (with-existing-element (template output)
- (mapc #'output-post-link *index-collection*))))
;;; Table mapping element id's to the corresponding output function
(defparameter *id-dispatch-table*
@@ -1086,8 +1281,7 @@ the templates)."
(cons *post-content-id* #'output-post-content)
(cons *post-title-id* #'output-post-title)
(cons *post-when-id* #'output-post-when)
- (cons *post-updated-id* #'output-post-updated)
- (cons *post-posts-id* #'output-post-synopses-with-links))
+ (cons *post-updated-id* #'output-post-updated))
"Map elements with specific id atributes to content.")
@@ -1103,6 +1297,7 @@ attribute."
'(page blog-post))))
(when linked-content
(setf (cdr href-entry) (url-for linked-content))))
+ (klacks:serialize-event template output)
(cxml:with-element "a"
(mapc #'(lambda (x)
(cxml:attribute (car x) (cdr x))
@@ -1112,19 +1307,45 @@ attribute."
) ;; not sure why we have to copy this
attributes)
(cxml:text "")
- (%copy-current-element-content template output)))
+ (%copy-current-element-content template output)
+ (klacks:serialize-event template output)))
+
+;;; Create a template from the current element. To be valid XML the template
+;;; needs to include a wrapping element, but this will not be output.
+(defun current-element-as-template (source)
+ "Create an octect vector from the content of the current element"
+ (let ((template-sink
+ (cxml:make-octet-vector-sink :canonical nil :indentation
+ nil :omit-xml-declaration-p t)))
+ (cxml:with-xml-output template-sink
+ (cxml:with-element "div"
+ (cxml:text "") ; force output of div
+ (%copy-current-element-content source template-sink)
+ (sax:end-document template-sink)))))
+
+(defun output-content-using-template (content template output)
+ (klacks:with-open-source
+ (source (cxml:make-source template :entity-resolver #'null-resolver))
+ (loop for key = (klacks:consume source)
+ until (eql key :start-element)) ; consume the start element
+ (output-with-rewrite content source output)
+ (klacks:consume source))) ; consume the end element
+(defun output-post-tag (tag template output attributes)
+ (declare (ignore attributes))
+ (with-existing-element (template output)
+ (let ((tag-page (%ensure-tag-page tag)))
+ (link-for tag-page))))
+
(defun output-tags-for (content template output attributes)
(declare (ignore attributes))
- (let ((tags (content-tags content)))
- (flet ((output-post-tag (tag)
- (cxml:with-element "li"
- (let ((tag-page (%ensure-tag-page tag tags)))
- (link-for tag-page)))))
- (with-existing-element (template output)
- (cxml:with-element "ul"
- (mapc #'output-post-tag tags))))))
+ (klacks:serialize-event template output) ; start element
+ (let ((tag-template (current-element-as-template template)))
+ (flet ((output-tag (tag)
+ (output-content-using-template tag tag-template output)))
+ (mapc #'output-tag (content-tags content))))
+ (klacks:serialize-event template output))
(defun output-tag-name (content template output attributes)
(declare (ignore attributes))
@@ -1143,13 +1364,162 @@ attribute."
(cxml:with-element "ul"
(mapc #'output-post-tag tags))))))
+(defvar *collection-route-path* nil)
+
+(defun output-post-synopsis (blog-post template output attributes)
+ "Output a link to the specified BLOG-POST, using the post's title as link
+ text."
+ (declare (ignore attributes))
+ (with-existing-element (template output)
+ (write-post-synopsis blog-post output)))
+
+(defun output-post-link (blog-post template output attributes)
+ "Output a link to the specified BLOG-POST, using the post's title as link
+ text."
+ (declare (ignore attributes))
+ (with-existing-element (template output)
+ (if *collection-route-path*
+ (link-for blog-post
+ :url (enough-namestring
+ (site-file-path-for blog-post)
+ *collection-route-path*))
+ (link-for blog-post))))
+
+(defun output-posts (content template output attributes)
+ "Output posts"
+ (declare (ignore attributes))
+ (klacks:serialize-event template output) ; start element
+ (let ((post-template (current-element-as-template template)))
+ (flet ((output-post (post)
+ (output-content-using-template post post-template output)))
+ (let ((*collection-route-path* (site-file-path-for content)))
+ (mapc #'output-post *index-collection*))))
+ (klacks:serialize-event template output)) ; end element
+
+
+(defun split-fmt (fmt)
+ (when fmt
+ (setf fmt (string-trim '(#\Space #\Tab #\Newline #\Return) fmt))
+ (when (plusp (length fmt))
+ (let ((i 0) (result) (n (length fmt)))
+ (cl-ppcre:do-scans (ms me rs re "\\|" fmt)
+ (push (subseq fmt i ms) result)
+ (setf i me)
+ (when (= n me)
+ (push "" result)))
+ (when (< i n)
+ (push (subseq fmt i) result))
+ (values (nreverse result))))))
+
+(defun output-comment-count (content template output attributes)
+ "Output a count of the comments for content"
+ (declare (ignore attributes))
+ (flet ((write-fmt (template count)
+ (cl-ppcre:regex-replace "#" template (format nil "~D" count))))
+ (with-existing-element-as-format-template (fmt template output)
+ (setf fmt (split-fmt fmt))
+ (cxml:text
+ (if fmt
+ (let ((components (length fmt))
+ (count (%btree-length (content-comments content))))
+ (cond
+ ((= 1 components)
+ (write-fmt (first fmt) count))
+ ((= 2 components)
+ (if (= 1 count)
+ (write-fmt (second fmt) count)
+ (write-fmt (first fmt) count)))
+ (t
+ (if (= 1 count)
+ (write-fmt (second fmt) count)
+ (if (zerop count)
+ (write-fmt (third fmt) count)
+ (write-fmt (first fmt) count))))))
+ (format nil "~D" (%btree-length (content-comments content))))))))
+
+
+(defun output-comments (content template output attributes)
+ (declare (ignore attributes))
+ (klacks:serialize-event template output) ; start element
+ (let ((comment-template (current-element-as-template template)))
+ (flet ((output-comment (filename comment)
+ (declare (ignore filename))
+ (output-content-using-template comment comment-template output)))
+ (elephant:map-btree #'output-comment (content-comments content))))
+ (klacks:serialize-event template output)) ; end element
+
+(defun output-comment (content template output attributes)
+ (declare (ignore attributes))
+ (with-open-file (stream (published-file-path-for content)
+ :element-type '(unsigned-byte 8))
+ (klacks:with-open-source (source (cxml:make-source stream))
+ (%skip-to-next-start-element source "text")
+ (with-existing-element (template output)
+ (%copy-current-element-content source output)))))
+
+(defun output-comment-from (content template output attributes)
+ (declare (ignore attributes))
+ (with-existing-element (template output)
+ (cxml:with-element "a"
+ (cxml:attribute "href" (comment-uri content))
+ (cxml:text (comment-name content)))))
+
+(defun output-comment-when (content template output attributes)
+ (declare (ignore attributes))
+ (with-existing-element (template output)
+ (cxml:text
+ (local-time:format-timestring
+ nil
+ (local-time:universal-to-timestamp (comment-when content))
+ :format
+ '(:day #\Space :long-month #\Space :year #\, #\Space :hour #\: :min)))))
+
+(defun output-comment-link (content template output attributes)
+ (declare (ignore attributes))
+ (with-existing-element-as-format-template (fmt template output)
+ (cxml:with-element "a"
+ (cxml:attribute "href" (url-for content))
+ (cxml:text fmt))))
+
+(defun output-comment-id (content template output attributes)
+ (with-existing-element-setting-attributes
+ (content template output attributes
+ (list (cons "id" (content-filename content))))))
+
+
+(defun output-post-slug-value-attr (content template output attributes)
+ "Output a value attribute containing the post slug"
+ (if (assoc "value" attributes :test #'string=)
+ (setf (cdr (assoc "value" attributes :test #'string=))
+ (content-filename content))
+ (setf attributes (acons "value" (content-filename content) attributes)))
+ (multiple-value-bind (key ns lname) (klacks:consume template)
+ (declare (ignore key ns))
+ (cxml:with-element lname
+ (mapc #'(lambda (x)
+ (cxml:attribute (car x) (cdr x)))
+ attributes)
+ (%copy-current-element-content template output))
+ (klacks:consume template)))
(defparameter *class-dispatch-table*
(list
+ (cons *post-posts-class* #'output-posts)
+ (cons *post-synopsis-class* #'output-post-synopsis)
+ (cons *post-link-class* #'output-post-link)
(cons *page-link-for* #'output-link-for)
(cons *post-tags-class* #'output-tags-for)
+ (cons *post-tag-class* #'output-post-tag)
(cons *tag-name-class* #'output-tag-name)
- (cons *tag-related-class* #'output-tag-related))
+ (cons *tag-related-class* #'output-tag-related)
+ (cons *comment-count-class* #'output-comment-count)
+ (cons *comments-class* #'output-comments)
+ (cons *comment-class* #'output-comment)
+ (cons *comment-from-class* #'output-comment-from)
+ (cons *comment-when-class* #'output-comment-when)
+ (cons *comment-id-class* #'output-comment-id)
+ (cons *comment-link-class* #'output-comment-link)
+ (cons *post-slug-hidden-input-class* #'output-post-slug-value-attr))
"Map elements with specific class atributes to content.")
@@ -1181,7 +1551,7 @@ attribute."
(defparameter *element-dispatch-table*
(list
(cons *post-title* #'output-post-title)
- (cons *post-link* #'output-post-link))
+ (cons *post-link* #'output-post-meta-link))
"Map specific elements to content.")
(defmacro with-each-word ((var string) &body body)
@@ -1408,7 +1778,7 @@ only the current element."
(cxml:with-element "div"
(cxml:attribute "xmlns" *xhtml-xmlns*)
(cxml:text "") ; force end of div start tag
- (output-post-synopsis blog-post output)))
+ (write-post-synopsis blog-post output)))
(cxml:with-element "content"
(cxml:attribute "type" "xhtml")
(cxml:with-element "div"
@@ -1467,6 +1837,14 @@ only the current element."
"Ensure tag pages exist for existing posts"
(with-open-store ()
(elephant:map-class #'%ensure-tag-pages-for 'blog-post)))
+
+(defun ensure-comments-for-existing-blog-posts ()
+ "Ensure tag pages exist for existing posts"
+ (with-open-store ()
+ (flet ((ensure-comments-for-post (post)
+ (when (not (slot-boundp post 'comments))
+ (setf (slot-value post 'comments) (elephant:make-btree)))))
+ (elephant:map-class #'ensure-comments-for-post 'blog-post))))
;;; ensure pbook output is as intended:
;; Local Variables:
View
154 test/post.lisp
@@ -18,6 +18,15 @@
(is (string= expected (cl-blog-generator::%sanitise-title input)))))
+(defvar *fake-names*
+ '("Aaliyah" "Aaron" "Abagail" "Abbey" "Abbie" "Abbigail" "Abby" "Abdiel" "Abdul" "Abdullah" "Abe" "Abel" "Abelardo" "Abigail" "Abigale" "Abigayle" "Abner" "Abraham" "Ada" "Adah" "Adalberto" "Adaline" "Adam" "Adan" "Addie" "Addison" "Adela" "Adelbert" "Adele" "Adelia" "Adeline" "Adell" "Adella" "Adelle" "Aditya" "Adolf" "Adolfo" "Adolph" "Adolphus" "Adonis" "Adrain" "Adrian" "Adriana" "Adrianna" "Adriel" "Adrien" "Adrienne" "Afton" "Aglae" "Agnes" "Agustin" "Agustina" "Ahmad" "Ahmed" "Aida" "Aidan" "Aiden" "Aileen" "Aimee" "Aisha" "Aiyana" "Akeem" "Al" "Alaina" "Alan" "Alana" "Alanis" "Alanna" "Alayna" "Alba" "Albert" "Alberta" "Albertha" "Alberto" "Albin" "Albina" "Alda" "Alden" "Alec" "Aleen" "Alejandra" "Alejandrin" "Alek" "Alena" "Alene" "Alessandra" "Alessandro" "Alessia" "Aletha" "Alex" "Alexa" "Alexander" "Alexandra" "Alexandre" "Alexandrea" "Alexandria" "Alexandrine" "Alexandro" "Alexane" "Alexanne" "Alexie" "Alexis" "Alexys" "Alexzander" "Alf" "Alfonso" "Alfonzo" "Alford" "Alfred" "Alfreda" "Alfredo" "Ali" "Alia" "Alice" "Alicia" "Alisa" "Alisha" "Alison" "Alivia" "Aliya" "Aliyah" "Aliza" "Alize" "Allan" "Allen" "Allene" "Allie"))
+
+(defun random-element (list)
+ (nth (random (length list)) list))
+
+(defun fake-name ()
+ (random-element *fake-names*))
+
(defmacro with-test-db (&body body)
`(progn
(configure :test)
@@ -28,17 +37,12 @@
;;;# Fixtures to revert output state
(defun drop-all ()
(with-test-db
- (elephant:drop-instances
- (elephant:get-instances-by-class (find-class 'cl-blog-generator::blog-post)))
- (elephant:drop-instances
- (elephant:get-instances-by-class (find-class 'cl-blog-generator::page)))
- (elephant:drop-instances
- (elephant:get-instances-by-class 'cl-blog-generator::index-page))
- (elephant:drop-instances
- (elephant:get-instances-by-class 'cl-blog-generator::tag-page))
- (elephant:drop-instances
- (elephant:get-instances-by-class 'cl-blog-generator::generated-content)
- )))
+ (loop for class in '(cl-blog-generator::blog-post cl-blog-generator::page
+ cl-blog-generator::index-page cl-blog-generator::tag-page
+ cl-blog-generator::generated-content cl-blog-generator::comment)
+ do (elephant:drop-instances
+ (elephant:get-instances-by-class class)))
+ ( )))
(defun draft-path (filename &key (type "post"))
(merge-pathnames
@@ -52,18 +56,72 @@
(defixture delete-all-fixture
(:setup
(drop-all)
- (cl-fad:walk-directory *site-path* #'delete-file)
- (cl-fad:walk-directory *published-path* #'delete-file)))
+ (loop for dir in (list *site-path* *published-path*)
+ do
+ (ensure-directories-exist dir)
+ (cl-fad:walk-directory dir #'delete-file))))
(defixture test-environment-fixture
(:setup
(configure :test)))
(defun synopsis= (a b)
- (declare (ignore a b))
- ;; need to work out the type of the sysnopsis...
- ;; (is (string= "<p>My first post. Mainly to have something to use in developing the code.</p>" synopsis))
- t)
+ (is (string= a (babel:octets-to-string b :encoding :utf-8))))
+
+(defparameter *template-tests*
+ '("fred<span>blogs</span>xxx"))
+
+
+(deftest test-split-fmt ()
+ (let ((components (cl-blog-generator::split-fmt nil)))
+ (is (null components)))
+ (let ((components (cl-blog-generator::split-fmt "one component")))
+ (is (listp components))
+ (is (= 1 (length components)))
+ (is (string= "one component" (first components))))
+ (let ((components (cl-blog-generator::split-fmt "first component|second component")))
+ (is (listp components))
+ (is (= 2 (length components)))
+ (is (string= "first component" (first components)))
+ (is (string= "second component" (second components))))
+ (let ((components (cl-blog-generator::split-fmt "first component|second component|third component")))
+ (is (listp components))
+ (is (= 3 (length components)))
+ (is (string= "first component" (first components)))
+ (is (string= "second component" (second components)))
+ (is (string= "third component" (third components))))
+ (let ((components (cl-blog-generator::split-fmt "first|second|")))
+ (is (listp components))
+ (is (= 3 (length components)))
+ (is (string= "first" (first components)))
+ (is (string= "second" (second components)))
+ (is (string= "" (third components)))))
+
+
+(deftest test-merge-assoc ()
+ (is (equalp '((:a . :a) (:b . :bb) (:c . :cc))
+ (sort (cl-blog-generator::merge-assoc '((:a . :a) (:b . :b))
+ '((:b . :bb) (:c . :cc)))
+ #'(lambda (x y)
+ (string< (symbol-name (car x))
+ (symbol-name (car y)))))))
+ (is (equalp '(("a" . "a") ("b" . "bb") ("c" . "cc"))
+ (sort (cl-blog-generator::merge-assoc '(("a" . "a") ("b" . "b"))
+ '(("b" . "bb") ("c" . "cc"))
+ :test #'string=)
+ #'(lambda (x y)
+ (string< (car x) (car y)))))))
+
+(deftest test-output-content-using-template-case (content)
+ (let ((template (babel:string-to-octets (format nil "<div>~A</div>" content)))
+ (output (cxml:make-octet-vector-sink)))
+ (cl-blog-generator::output-content-using-template nil template output)
+ (let ((result (sax:end-document output)))
+ (is (string= content (babel:octets-to-string result :encoding :utf-8))))))
+
+(deftest test-output-content-using-template ()
+ (loop for i in *template-tests* do (test-output-content-using-template-case i)))
+
(deftest test-%parse-post-info-first ()
(with-fixture test-environment-fixture
@@ -242,13 +300,14 @@
(funcall cl-blog-generator::*id-generator-fn* blog-post)))
- (multiple-value-bind (title when updated tags linkname synopsis)
+ (multiple-value-bind (title when updated tags linkname description synopsis)
(cl-blog-generator::%parse-post-info output-path)
- (is (string= title "My Second Blog Post"))
+ (is (string= "My Second Blog Post" title))
(is (equalp '(26 02 2009) when))
(is (equalp '("lisp" "blog") tags))
- (is (string= linkname "a_second_blog_post_with_an_explicit_linkname"))
+ (is (string= "a_second_blog_post_with_an_explicit_linkname" linkname))
(is (equalp '(27 02 2009) updated))
+ (is (string= "A description" description))
(is (synopsis=
"<p>My second post. With an explicit linkname, and an updated tag.</p>"
synopsis))))))))
@@ -389,4 +448,57 @@
(is tag-page)
(is (= 1 (length (cl-blog-generator::tag-page-related-tags tag-page))))
(is (= 1 (length (cl-blog-generator::%tag-posts tag))))
- (is (equal (first (cl-blog-generator::%tag-posts tag)) blog-post)))))))
+ (is (equal (first (cl-blog-generator::%tag-posts tag)) blog-post)))))))
+
+
+(defvar *comment-texts*
+ '("This is a comment"
+ "This is a multi-paragraph comment
+
+Another paragraph."
+ "This is a multi-paragraph comment with http://somedomain.com/links .
+
+Another paragraph http://somedomain.com/links."))
+
+(defvar *comment-regexes*
+ '("<p>This is a comment</p>"
+ "<p>This is a multi-paragraph comment</p><p>Another paragraph.</p>"
+ "<a href=\"http://somedomain.com/links\">http://somedomain.com/links</a>"))
+
+
+(deftest test-add-comment ()
+ (with-fixture delete-all-fixture
+ (with-test-db
+ (multiple-value-bind (output-path blog-post)
+ (cl-blog-generator::%publish-draft (draft-path "first"))
+ (declare (ignore output-path))
+ (loop for comment-text in *comment-texts*
+ for comment-regex in *comment-regexes*
+ do
+ (let* ((name (fake-name))
+ (comment (cl-blog-generator::add-comment
+ (cl-blog-generator::content-filename blog-post)
+ "123.123.123.123"
+ name
+ "ab.cd@ef.com"
+ "http://freds domain"
+ (get-universal-time)
+ comment-text)))
+ (is (eql blog-post (cl-blog-generator::content-page comment)))
+;; (format *debug-io* "~A~%" (namestring (cl-blog-generator::published-file-path-for comment)))
+ (is (string= name (cl-blog-generator::comment-name comment)))
+ (is (string= (format nil "~A~{~A/~}~A/~A_~A.comment"
+ *published-path*
+ *comment-path*
+ (cl-blog-generator::content-filename blog-post)
+ (cl-blog-generator::comment-when comment)
+ (cl-blog-generator::%sanitise-title name))
+ (namestring (cl-blog-generator::published-file-path-for comment))))
+ (is (probe-file (cl-blog-generator::published-file-path-for comment)))
+ (with-open-file (stream (cl-blog-generator::published-file-path-for comment))
+ (let ((line (read-line stream)))
+ (is (cl-ppcre:scan comment-regex line))))))
+ (is (= 3 (cl-blog-generator::%btree-length (cl-blog-generator::content-comments blog-post))))
+ (cl-blog-generator::generate blog-post)))))
+
+
View
10 test/template/index.xhtml
@@ -1,9 +1,15 @@
<?xml version="1.0" encoding="UTF-8" ?>
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head>
-<title>Hugo Duncan</title>
+<title>Test Index</title>
</head>
<body>
-<div id='posts'/>
+<div class='posts'>
+ <div class='my-post'>
+ <span class='post-link'/>
+ <span class='post-synopsis'/>
+ <span class='comment-count'/>
+ </div>
+</div>
</body>
</html>
View
2  test/template/page.xhtml
@@ -1,7 +1,7 @@
<?xml version="1.0" encoding="UTF-8" ?>
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head>
-<title>PAGE: </title>
+<title>Test Page: </title>
</head>
<body>
<div id='post-title'/>
View
6 test/template/post.xhtml
@@ -1,12 +1,16 @@
<?xml version="1.0" encoding="UTF-8" ?>
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head>
-<title>Hugo Duncan</title>
+<title>Test Post</title>
</head>
<body>
<div id='post-title'/>
<div id='post'/>
<div id='post-when'/>
<div id='post-updated'/>
+<div class='comment-count'/>
+<div class='comments-list'>
+ <div class='comment-entry'/>
+</div>
</body>
</html>
View
10 test/template/tag.xhtml
@@ -1,9 +1,15 @@
<?xml version="1.0" encoding="UTF-8" ?>
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head>
-<title>Hugo Duncan</title>
+<title>Test Tag</title>
</head>
<body>
-<div id='posts'/>
+<div class='posts'>
+ <div class='my-post'>
+ <span class='post-link'/>
+ <span class='post-synopsis'/>
+ <span class='comment-count'/>
+ </div>
+</div>
</body>
</html>
Please sign in to comment.
Something went wrong with that request. Please try again.