From 99162ab839adcfd0dbdf583e5bd6fecd3e5882d7 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Wed, 20 Feb 2008 09:24:18 +0100 Subject: another checkpoint, la la la --- tekuti/git.scm | 3 +- tekuti/page.scm | 95 ++++++++++++++++++++++++++++++++--------------------- tekuti/post.scm | 26 +++++++++++++-- tekuti/template.scm | 63 +++++++++++++++++++++++++++++++++++ tekuti/util.scm | 15 ++++++++- wordpress-to-dir.py | 72 ++++++++++++++++++++++++++++++++++++++++ 6 files changed, 232 insertions(+), 42 deletions(-) create mode 100644 tekuti/template.scm create mode 100644 wordpress-to-dir.py diff --git a/tekuti/git.scm b/tekuti/git.scm index 09f339e..11f739c 100644 --- a/tekuti/git.scm +++ b/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 ".")) diff --git a/tekuti/page.scm b/tekuti/page.scm index 5671c53..cbc2696 100644 --- a/tekuti/page.scm +++ b/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 (relform path . body) +(define (post-editing-form post) `(form (@ (method "POST") - (action ,(string-append *public-url-base* path))) - ,@body)) + (action ,(string-append *public-url-base* + (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) - (map (lambda (post) - ;; double-encoding is a hack to trick apache - `(li ,(relurl (string-append "admin/posts/" (url:encode (assq-ref post 'key))) - (assq-ref post 'title)))) - (assq-ref index 'posts))) + (define (post-links n) + (mapn (lambda (post) + `(li ,(admin-post-link post))) + (assq-ref index 'posts) + n)) (rcons* request - 'body `((h2 "all your posts") - (ul ,@(post-headers)) - (h2 "are belong to tekuti") - ,(apply - relform - "admin/new-post" - `((div "title" (input (@ (name "title") (type "text")))) - (div (textarea (@ (name "body") (rows "20") (cols "80")) - "")) - (input (@ (type "submit") (value "new post")))))))) + 'body `(,(sidebar-ul `((li (h2 ,(relurl "admin/posts" "posts")) + (ul ,@(post-links 10))) + (li (h2 "recent comments") + (p "ain't got none")))) + (h2 "new post") + ,(post-editing-form #f)))) + +(define (admin-post-link post) + (relurl (string-append "admin/posts/" + (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 - `(div (h3 ,(relurl (string-append "admin/posts/" - (url:encode (assq-ref post 'key))) - (assq-ref post 'title))) - (p "This is a post"))) + ;; double-encoding is a hack to trick apache + `(h3 ,(relurl (string-append "admin/posts/" (url:encode (assq-ref post 'key))) + (assq-ref post 'title)))) (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) - () - not-implemented) -(define (page-modify-post request index) - () - not-implemented) +(define (page-admin-modify-post request index key) + (not-implemented request index)) (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" - 'body `((pre ,(with-output-to-string - (lambda () - (write post))))))))) + 'title (assq-ref post 'title) + 'body (show-post post))))) (else (page-not-found request index))))) diff --git a/tekuti/post.scm b/tekuti/post.scm index d2f9a88..afa420f 100644 --- a/tekuti/post.scm +++ b/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) - (acons 'key encoded-name - (parse-metadata (string-append sha1 ":" "metadata") *post-spec*))) + (let ((treels (git-ls-tree sha1 #f))) + (acons 'key encoded-name + (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))) diff --git a/tekuti/template.scm b/tekuti/template.scm new file mode 100644 index 0000000..aea0694 --- /dev/null +++ b/tekuti/template.scm @@ -0,0 +1,63 @@ +;; Tekuti +;; Copyright (C) 2008 Andy Wingo + +;; 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"))))) diff --git a/tekuti/util.scm b/tekuti/util.scm index d594f28..edd8dba 100644 --- a/tekuti/util.scm +++ b/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))))))) diff --git a/wordpress-to-dir.py b/wordpress-to-dir.py new file mode 100644 index 0000000..e92bd80 --- /dev/null +++ b/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) -- cgit v1.2.3-54-g00ecf