another checkpoint, la la la
This commit is contained in:
Andy Wingo
parent
c2580a017d
commit
99162ab839
6 changed files with 232 additions and 42 deletions
|
|
@ -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 "."))
|
||||
|
|
|
|||
|
|
@ -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)))))
|
||||
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
63
tekuti/template.scm
Normal file
63
tekuti/template.scm
Normal file
|
|
@ -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")))))
|
||||
|
|
@ -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)))))))
|
||||
|
|
|
|||
72
wordpress-to-dir.py
Normal file
72
wordpress-to-dir.py
Normal file
|
|
@ -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)
|
||||
Loading…
Reference in a new issue