aliens/tekuti
1
0
Fork 0
Code Activity

incremental reindexing, import charset fixes, other thingies

Browse source
This commit is contained in:
Andy Wingo 2008-02-27 21:42:10 +01:00
parent bc57e2a655
commit 227bc9cea1
9 changed files with 93 additions and 77 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
tekuti/categories.scm
View file

@ -41,5 +41,5 @@
posts)
hash))
(define (reindex-categories index)
(define (reindex-categories old-index index)
(compute-categories (assq-ref index 'posts)))

31
tekuti/comment.scm
View file

@ -220,9 +220,9 @@
(assert-added-files-not-present (map cadr ladd) dents)
(assert-referenced-files-present
(append (map cdr lremove) (map caar lchange)) dents)
(pk 'make-tree-deep treeish add remove change)
; (trc 'make-tree-deep treeish add remove change)
(make-tree-full
(pk 'making (append
(append
(map cdr ladd)
(filter-map
(lambda (dent)
@ -234,7 +234,6 @@
((and (equal? (caddr dent) "tree")
(member (car dent)
(map caar (append dadd dremove dchange))))
(pk 'hi! dent (map caar (append dadd dremove dchange)))
(let ((level-down (lambda (x)
(if (equal? (caar x) (car dent))
(cons (cdar x) (cdr x))
@ -248,9 +247,9 @@
(else dent)))
(append (filter-map (lambda (x)
(and (not (assoc (caar x) dents))
(list x "tree" #f #f))
dadd))
dents)))))))
(list (caar x) #f "tree" #f)))
dadd)
dents))))))
(define (mutate-tree master add remove change message)
(let ((tree (make-tree-deep master add remove change)))
@ -258,19 +257,6 @@
(git* `("commit-tree" ,tree "-p" ,master) #:input message
#:env '("GIT_COMMMITTER=tekuti")))))
(define (update-master proc)
(let lp ((master (git-rev-parse "master")) (count 5))
(let ((commit (proc master)))
(cond
((zero? count)
(error "my god, we looped 5 times" commit))
((false-if-git-error
(git "update-ref" "refs/heads/master" commit master))
commit)
(else
(pk "failed to update the master ref, trying again...")
(lp (git-rev-parse "master") (1- count)))))))
(define (make-new-comment post post-data)
(let ((content (assoc-ref post-data "comment"))
(author (assoc-ref post-data "author"))
@ -291,11 +277,14 @@
(author_url . ,url)))
(display "\n")
(display content))))))
(update-master
(git-update-ref
"refs/heads/master"
(lambda (master)
(mutate-tree master
`(((,(assq-ref post 'key) "comments") . (,sha1 ,sha1 "blob" "100644")))
'()
'()
"new comment"))))))
"new comment"))
5))))

15
tekuti/filters.scm
View file

@ -68,7 +68,7 @@
(scons tail (cdr in)) out)
(lp #f (scons tail (cdr in))
(pclose (scons head p) out)))
(lp (cons (car in) (or p '()))
(lp (scons (car in) p)
(cdr in) out)))
((inline? (caar in))
(lp (scons (car in) p) (cdr in) out))
@ -76,21 +76,18 @@
(lp #f (cdr in)
(cons (car in) (pclose p out))))))))
(wpautop 'div
`((b "foo") "\n\n" (b "bar")))
(define (wordpress->sxml text)
(catch 'parser-error
(lambda ()
(let ((sxml (cadr (with-input-from-string (string-append "<div>" text "</div>")
xml->sxml))))
(pre-post-order
sxml
(pk sxml)
`((*default* . ,(lambda (tag . body)
(if (can-contain-p? tag)
(wpautop tag body)
(cons tag body))))
(*text* . ,(lambda (tag text)
text))))))
(lambda (key . args)
`(pre "parse error: "
,(with-output-to-string (lambda () (write args)))
"\n"
,text))))

20
tekuti/git.scm
View file

@ -39,7 +39,7 @@
git git* ensure-git-repo git-ls-tree git-ls-subdirs
parse-metadata parse-commit commit-utc-timestamp
commit-parents make-tree git-rev-parse make-tree-full
create-blob
create-blob git-update-ref
write-indices read-indices))
@ -63,7 +63,7 @@
(string->list str))
(display #\'))))
(define *debug* #t)
(define *debug* #f)
(define (trc . args)
(if *debug*
(apply pk args)
@ -88,7 +88,8 @@
(ret (close-pipe pipe)))
(case (status:exit-val ret)
((0) (if (eof-object? output) "" output))
(else (raise (condition (&git-condition
(else (trc 'git-error output ret real-args)
(raise (condition (&git-condition
(argv real-args)
(output output)
(status ret))))))))
@ -211,6 +212,19 @@
alist)
"\n" 'suffix))))
(define (git-update-ref refname proc count)
(let* ((ref (git-rev-parse refname))
(commit (proc ref)))
(cond
((zero? count)
(error "my god, we looped 5 times" commit))
((false-if-git-error
(git "update-ref" refname commit ref))
commit)
(else
(pk "failed to update the ref, trying again..." refname)
(git-update-ref (git-rev-parse refname) (1- count))))))
;; fixme: map-pairs
(define (assoc-list-ref alist key n default)

14
tekuti/mod-lisp.scm
View file

@ -147,14 +147,15 @@
(categories ,reindex-categories ,write-hash ,read-hash)))
(use-modules (statprof))
(define (reindex master)
(define (reindex oldindex master)
(with-backtrace
(lambda ()
(with-time-debugging
(lambda ()
(with-statprof #:hz 100
(fold (lambda (pair index)
(acons (car pair) ((cadr pair) index)
(acons (car pair)
((cadr pair) oldindex index)
index))
(acons 'master master '())
indices)))))))
@ -163,9 +164,14 @@
(let ((master (git-rev-parse "master")))
(if (and old-index (equal? (assq-ref (cdr old-index) 'master) master))
old-index
(let ((new-index (reindex master)))
(catch #t
(lambda ()
(let ((new-index (reindex (and=> old-index cdr) master)))
(cons (write-indices new-index (and=> old-index car) indices)
new-index)))))
new-index)))
(lambda (key . args)
(warn "error while reindexing:" key args)
old-index)))))
(define (inner-loop socket index)
(let* ((pair (accept socket))

2
tekuti/page.scm
View file

@ -390,7 +390,7 @@
(else
(rcons* request
'doctype ""
'output-type "application/atom+xml"
'content-type "application/atom+xml"
'sxml `(feed
(@ (xmlns "http://www.w3.org/2005/Atom")
(xml:base ,(relurl "feed/atom")))

22
tekuti/post.scm
View file

@ -166,7 +166,7 @@
,(comment-form post "" "" "" ""))))))
(define (post-n-comments post)
(length (git-ls-subdirs (string-append (assq-ref post 'sha1) ":comments") #f)))
(length (git-ls-tree (string-append (assq-ref post 'sha1) ":comments") #f)))
(define (post-sxml-n-comments post)
`(div (@ (class "feedback"))
@ -175,5 +175,21 @@
"#comments")))
"(" ,(post-n-comments post) ")")))
(define (reindex-posts index)
(all-published-posts (assq-ref index 'master)))
(define (hash-fill proc list)
(let ((table (make-hash-table)))
(for-each (lambda (x) (proc x table))
list)
table))
(define (reindex-posts oldindex newindex)
(let ((old (hash-fill (lambda (post h)
(hash-set! h (assq-ref post 'sha1) post))
(or (assq-ref oldindex 'posts) '()))))
(dsu-sort (map (lambda (dent)
(or (hash-ref old (cadr dent))
(begin (pk 'updated dent)
(post-from-tree (car dent) (cadr dent)))))
(git-ls-tree (assq-ref newindex 'master) #f))
post-timestamp
>)))

13
tekuti/web.scm
View file

@ -52,15 +52,6 @@
"<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" "
"\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n"))
;; what the hell is this
(define (request-output-headers request)
(let-request request ((output-headers '())
(status 200)
(content-type "text/html"))
(acons "Status" (status->string status)
(acons "Content-Type" content-type
output-headers))))
;;; useless macro
(define-macro (let-headers headers bindings . body)
(let ((headers-var (gensym)))
@ -82,7 +73,9 @@
'output-headers
(cons "Status" (status->string (rref request 'status 200)))
'output-headers
(cons "Content-Type" (rref request 'content-type "text/html"))))
(cons "Content-Type"
(string-append (rref request 'content-type "text/html")
"; charset=utf-8"))))
(define (choose-handler request)
(request-path-case

1
wordpress-to-dir.py
View file

@ -98,6 +98,7 @@ def main(args):
os.chdir(d)
_, host, user, passwd, database = args
cxn = db.connect(host=host, user=user, passwd=passwd, db=database)
cxn.cursor().execute("set names 'utf8'")
for post in all_posts():
write_post (post, post_categories (post), post_comments (post))