another checkpoint, la la la

tekuti/git.scm

@@ -122,7 +122,8 @@
 (define (git-ls-tree treeish path)
   (match-lines (git "ls-tree" treeish (or path "."))
                "^(.+) (.+) (.+)\t(.+)$" (_ mode type object name)
-               (list mode type object name)))
+               ;; reversed for assoc
+               (list name object type mode)))
 
 (define (git-ls-subdirs treeish path)
   (match-lines (git "ls-tree" treeish (or path "."))

tekuti/page.scm

@@ -26,6 +26,7 @@
 
 (define-module (tekuti page)
   #:use-module (tekuti config)
+  #:use-module (tekuti util)
   #:use-module (tekuti git)
   #:use-module (tekuti post)
   #:use-module (tekuti url)
@@ -65,41 +66,55 @@
                   (p "Path handler not yet implemented: "
                      ,(rref request 'path-str)))))
 
-;; thought: url mapping for post modification? probably including git sha1
+(define (post-editing-form post)
-
-(define (relform path . body)
   `(form (@ (method "POST")
-            (action ,(string-append *public-url-base* path)))
+            (action ,(string-append *public-url-base* 
-      ,@body))
+                                    (if post
+                                        (string-append "admin/modify-post/"
+                                                       (url:encode (assq-ref post 'key)))
+                                        "admin/new-post"))))
+         (p "title: "
+            (input (@ (name "title") (type "text")
+                      (value ,(if post (assq-ref post 'title) "")))))
+         (div (textarea (@ (name "body") (rows "20") (cols "80"))
+                        ,(if post (post-raw-content post) "")))
+         (input (@ (type "submit")
+                   (value ,(if post "edit post" "new post"))))))
+
+(define (sidebar-ul body)
+  `(div (@ (id "menu"))
+        (ul ,@body)))
 
 (define (page-admin request index)
   ;; here we need to be giving a dashboard view instead of this
-  (define (post-headers)
+  (define (post-links n)
-    (map (lambda (post)
+    (mapn (lambda (post)
-           ;; double-encoding is a hack to trick apache
+            `(li ,(admin-post-link post)))
-           `(li ,(relurl (string-append "admin/posts/" (url:encode (assq-ref post 'key)))
+          (assq-ref index 'posts)
-                         (assq-ref post 'title))))
+          n))
-         (assq-ref index 'posts)))
   (rcons* request
-          'body `((h2 "all your posts")
+          'body `(,(sidebar-ul `((li (h2 ,(relurl "admin/posts" "posts"))
-                  (ul ,@(post-headers))
+                                     (ul ,@(post-links 10)))
-                  (h2 "are belong to tekuti")
+                                 (li (h2 "recent comments")
-                  ,(apply
+                                     (p "ain't got none"))))
-                    relform
+                  (h2 "new post")
-                    "admin/new-post"
+                  ,(post-editing-form #f))))
-                    `((div "title" (input (@ (name "title") (type "text"))))
+
-                      (div (textarea (@ (name "body") (rows "20") (cols "80"))
+(define (admin-post-link post)
-                                     ""))
+  (relurl (string-append "admin/posts/"
-                      (input (@ (type "submit") (value "new post"))))))))
+                         (url:encode (assq-ref post 'key)))
+          (assq-ref post 'title)))
+
+(define (post-link post)
+  (relurl (string-append "archives/" (url:decode (assq-ref post 'key)))
+          (assq-ref post 'title)))
 
 (define (page-admin-posts request index)
   (define (post-headers)
     (map (lambda (post)
-           ;; double encoding is a hack
+           ;; double-encoding is a hack to trick apache
-           `(div (h3 ,(relurl (string-append "admin/posts/"
+           `(h3 ,(relurl (string-append "admin/posts/" (url:encode (assq-ref post 'key)))
-                                             (url:encode (assq-ref post 'key)))
+                         (assq-ref post 'title))))
-                              (assq-ref post 'title)))
-                 (p "This is a post")))
          (assq-ref index 'posts)))
   (rcons* request
           'body `((h1 "all your posts are belong to tekuti")
@@ -110,7 +125,7 @@
     (pk 'foo post)
     (rcons* request
           'body `((h1 ,(assq-ref post 'title))
-                  "foo?"))))
+                  ,(post-editing-form post)))))
 
 (define (decode-form-data request)
   (let-request request (headers post-data)
@@ -140,15 +155,22 @@
                     (p "Created new post: " ,(assoc-ref form-data "title"))
                     (pre ,(assoc-ref form-data "body"))))))
 
+(define (show-post post)
+  `((h2 (@ (class "storytitle"))
+        ,(post-link post))
+    (div (@ (class "post"))
+         (h3 (@ (class "meta"))
+             ,(post-readable-date post)
+             " (" ,@(list-intersperse (post-category-links post)
+                                      " | ")
+             ")")
+         (div (@ (class "storycontent"))
+              ,(post-sxml-content post)))))
 
 ;;                     (a (@ (href ,new-url)) ,new-url)
 
-(define (page-new-post request index)
+(define (page-admin-modify-post request index key)
-  ()
+  (not-implemented request index))
-  not-implemented)
-(define (page-modify-post request index)
-  ()
-  not-implemented)
 (define page-new-comment not-implemented)
 (define page-delete-comment not-implemented)
 (define page-delete-post not-implemented)
@@ -161,11 +183,10 @@
        (git-rev-parse (string-append (assq-ref index 'master) ":" slug)))
       => (lambda (tree)
            (let ((post (post-from-tree slug tree)))
+             (pk post)
              (rcons* request
-                     'title "post"
+                     'title (assq-ref post 'title)
-                     'body `((pre ,(with-output-to-string
+                     'body (show-post post)))))
-                                     (lambda ()
-                                       (write post)))))))))
      (else
       (page-not-found request index)))))
 

tekuti/post.scm

@@ -31,7 +31,10 @@
   #:use-module (tekuti comment)
   #:use-module (tekuti git)
   #:use-module (srfi srfi-1)
-  #:export (reindex-posts post-from-tree post-from-key post-categories all-published-posts))
+  #:use-module (srfi srfi-19)
+  #:export (reindex-posts post-from-tree post-from-key post-categories
+            post-sxml-content post-raw-content all-published-posts
+            post-readable-date post-category-links))
   
 ;; introducing new assumption: post urls like yyyy/dd/mm/post; post dirnames the urlencoded post
 
@@ -51,8 +54,25 @@
     (title . ,identity)))
 
 (define (post-from-tree encoded-name sha1)
+  (let ((treels (git-ls-tree sha1 #f)))
     (acons 'key encoded-name
-         (parse-metadata (string-append sha1 ":" "metadata") *post-spec*)))
+           (acons 'content-sha1 (and=> (assoc "content" treels) cadr)
+                  (parse-metadata (and=> (assoc "metadata" treels) cadr)
+                                  *post-spec*)))))
+
+(define (post-raw-content post)
+  (git "cat-file" "blob" (assq-ref post 'content-sha1)))
+
+(define (post-sxml-content post)
+  `(pre ,(post-raw-content post)))
+
+(define (post-readable-date post)
+  (let ((date (time-utc->date
+               (make-time time-utc 0 (assq-ref post 'timestamp)))))
+    (date->string date "~e ~B ~Y ~l:~M ~p")))
+
+(define (post-category-links post)
+  (post-categories post))
 
 (define (post-from-key master key)
   (let ((pairs (git-ls-subdirs master key)))

tekuti/template.scm

@@ -0,0 +1,63 @@
+;; Tekuti
+;; Copyright (C) 2008 Andy Wingo <wingo at pobox dot com>
+
+;; This program is free software; you can redistribute it and/or    
+;; modify it under the terms of the GNU General Public License as   
+;; published by the Free Software Foundation; either version 3 of   
+;; the License, or (at your option) any later version.              
+;;                                                                  
+;; This program is distributed in the hope that it will be useful,  
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of   
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the    
+;; GNU General Public License for more details.                     
+;;                                                                  
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, contact:
+;;
+;; Free Software Foundation           Voice:  +1-617-542-5942
+;; 59 Temple Place - Suite 330        Fax:    +1-617-542-2652
+;; Boston, MA  02111-1307,  USA       gnu@gnu.org
+
+;;; Commentary:
+;;
+;; This is the main script that will launch tekuti.
+;;
+;;; Code:
+
+(define-module (tekuti template)
+  #:use-module (tekuti request)
+  #:use-module (tekuti config)
+  #:export (templatize))
+
+(define (templatize request)
+  (define (href . args)
+    `(href ,(apply string-append *public-url-base* args)))
+  (define (list-join l infix)
+    "Infixes @var{infix} into list @var{l}."
+    (if (null? l) l
+        (let lp ((in (cdr l)) (out (list (car l))))
+          (cond ((null? in) (reverse out))
+                (else (lp (cdr in) (cons* (car in) infix out)))))))
+  (define (make-navbar)
+    `(div (@ (id "navbar"))
+          ,@(list-join
+             (map (lambda (x) `(a (@ ,(href x "/")) ,x))
+                  '("about" "software" "writings" "photos"))
+             " | ")))
+  `(html
+    (head (title ,(rref request 'title "wingolog"))
+          (meta (@ (name "Generator")
+                   (content "The Guile SXML Toolkit")))
+          (link (@ (rel "stylesheet")
+                   (type "text/css")
+                   (media "screen")
+                   (href "/base.css")))) ;fixme
+    (body
+     (div (@ (id "rap"))
+          (h1 (@ (id "header"))
+              (a (@ ,(href "")) "wingolog"))
+          ,(make-navbar)
+          (div (@ (id "content"))
+               ,@(rref request 'body '(p "what")))
+          (div (@ (id "footer"))
+               "powered by sxml")))))

tekuti/util.scm

@@ -28,7 +28,8 @@
   #:use-module (match-bind)
   #:use-module (srfi srfi-1)
   #:export (expanduser match-lines dbg unwind-protect dbg dsu-sort
-            hash-push! list-has-length? list-head-match))
+            hash-push! list-has-length? list-head-match mapn
+            list-intersperse))
 
 (define (expanduser path)
   (let ((parts (string-split path #\/)))
@@ -78,3 +79,15 @@
    ((null? l2) #f)
    ((not (equal? (car l1) (car l2))) #f)
    (else (list-head-match (cdr l1) (cdr l2) (1- n)))))
+
+(define (mapn proc l nmax)
+  (let lp ((in l) (out '()) (n nmax))
+    (if (or (null? in) (zero? n))
+        (reverse out)
+        (lp (cdr in) (cons (proc (car in)) out) (1- n)))))
+
+(define (list-intersperse src-l elem)
+  (if (null? src-l) src-l
+      (let loop ((l (cdr src-l)) (dest (cons (car src-l) '())))
+        (if (null? l) (reverse dest)
+            (loop (cdr l) (cons (car l) (cons elem dest)))))))

wordpress-to-dir.py

@@ -0,0 +1,72 @@
+#!/usr/bin/env python
+
+import sys
+import tempfile
+import MySQLdb as db
+import os
+
+cxn = None
+
+def all_posts():
+  `ID` bigint(20) unsigned NOT NULL auto_increment,
+  `post_author` bigint(20) NOT NULL default '0',
+  `post_date` datetime NOT NULL default '0000-00-00 00:00:00',
+  `post_date_gmt` datetime NOT NULL default '0000-00-00 00:00:00',
+  `post_content` longtext NOT NULL,
+  `post_title` text NOT NULL,
+  `post_category` int(4) NOT NULL default '0',
+  `post_excerpt` text NOT NULL,
+  `post_lat` float default NULL,
+  `post_lon` float default NULL,
+  `post_status` enum('publish','draft','private','static','object','attachment') NOT NULL default 'publish',
+  `comment_status` enum('open','closed','registered_only') NOT NULL default 'open',
+  `ping_status` enum('open','closed') NOT NULL default 'open',
+  `post_password` varchar(7) NOT NULL default '',
+  `post_name` varchar(67) NOT NULL default '',
+  `to_ping` text NOT NULL,
+  `pinged` text NOT NULL,
+  `post_modified` datetime NOT NULL default '0000-00-00 00:00:00',
+  `post_modified_gmt` datetime NOT NULL default '0000-00-00 00:00:00',
+  `post_content_filtered` text NOT NULL,
+  `post_parent` bigint(20) NOT NULL default '0',
+  `guid` varchar(85) NOT NULL default '',
+  `menu_order` int(11) NOT NULL default '0',
+  `post_type` varchar(34) NOT NULL default '',
+  `post_mime_type` varchar(34) NOT NULL default '',
+  `comment_count` bigint(20) NOT NULL default '0',
+  PRIMARY KEY  (`ID`),
+  KEY `post_date` (`post_date`),
+  KEY `post_date_gmt` (`post_date_gmt`),
+  KEY `post_name` (`post_name`),
+  KEY `post_status` (`post_status`)
+    cur = cxn.cursor()
+    sql = ('select ID, post_author, post_date_gmt, post_content,'
+           '       post_title, post_status, comment_status, post_name,'
+           '       post_modified_gmt, post_content_filtered'
+           '  from wp_posts')
+    cur.execute(sql)
+    while True:
+        row = cur.fetchone()
+        if row:
+            keys = ('id', 'author', 'date', 'content', 'title',
+                    'status', 'comment_status', 'name', 'modified',
+                    'content_filtered')
+            yield dict(zip(keys, row))
+        else:
+            break
+
+def write_post(post):
+    print post['name']
+
+def main(args):
+    global cxn
+    d = tempfile.mkdtemp(prefix='wp2dir')
+    print 'writing dir', d
+    os.chdir(d)
+    _, host, user, passwd, db = args
+    cxn = db.connect(host=host, user=user, passwd=passwd, db=db)
+    for post in all_posts():
+        write_post (post, post_categories (post), post_comments (post))
+    
+if __name__ == '__main__':
+    main(sys.argv)