diff options
Diffstat (limited to 'tekuti/boot.scm')
| -rw-r--r-- | tekuti/boot.scm | 123 |
1 files changed, 123 insertions, 0 deletions
diff --git a/tekuti/boot.scm b/tekuti/boot.scm new file mode 100644 index 0000000..4d42fd4 --- /dev/null +++ b/tekuti/boot.scm @@ -0,0 +1,123 @@ +#! /bin/bash +# -*- scheme -*- +exec guile $GUILE_FLAGS -l $0 -e main -- "$@" +!# +;; 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: + +;;hack! + +(define-module (tekuti boot) + #:use-module (ice-9 format) + #:use-module (ice-9 getopt-long) + #:use-module (ice-9 threads) + #:use-module (tekuti git) + #:use-module (tekuti page) + #:use-module (tekuti util) + #:use-module (tekuti post) + #:use-module (tekuti url) + #:use-module (tekuti request) + #:use-module (tekuti categories) + #:use-module (tekuti mod-lisp) + #:use-module (tekuti web) + #:export (boot)) + +(define (make-post-slug y m day post) + (url:encode (format #f "~a/~a/~a" y m (url:encode post)))) + +(define (show-post slug index) + `(sxml . (p "hello" ,slug))) + +(define (handle-request request index) + ((request-path-case + request + ((POST admin new-post) page-new-post) + ((POST admin modify-post) page-modify-post) + ((POST admin new-comment) page-new-comment) + ((POST admin delete-comment) page-delete-comment) + ((POST admin delete-post) page-delete-post) + ((GET) page-index) + ((GET archives year? month? day?) page-archives) + ((GET archives year? month? day? post?) page-show-post) + ((GET debug) page-debug) + ((POST search) page-search) + (else page-not-found)) + request index)) + +(define (maybe-reindex old-master old-index) + (let ((master (git-rev-parse "master"))) + (values + master + (if (equal? master old-master) + old-index + (acons 'master master + (map (lambda (k reindex) + (cons k (reindex master))) + (list 'posts 'categories) + (list reindex-posts reindex-categories))))))) + +(define *option-grammar* '((gds) + (usage) + (version (single-char #\v)) + (help (single-char #\h)))) + +(define (usage) + ;; trying out `format'. mixed results. + (define (repr-option opt) + (let ((required (and=> (assq 'required (cdr opt)) cadr))) + (format #f "~:[[~;~]--~a~@*~:[]~;~]" + (assq 'required? (cdr opt)) (car opt)))) + + (format #t "usage: tekuti ~{~a~^ ~}~%" + (map repr-option *option-grammar*))) + +(define (version) + (format #t "tekuti version 0.1" (car (program-arguments)))) + +;; krap code +(define (parse-options args) + (let ((opts (getopt-long args '((gds) + (usage) + (version (single-char #\v)) + (help (single-char #\h)))))) + (if (or (option-ref opts 'usage #f) + (option-ref opts 'help #f) + (not (null? (option-ref (cdr opts) '() '())))) + (begin + (usage) + (exit 0))) + (if (option-ref opts 'version #f) + (begin + (version) + (exit 0))) + (if (option-ref opts 'gds #f) + (make-thread (@ (ice-9 gds-client) run-utility))) + opts)) + +(define (boot args) + (let ((options (parse-options args))) + (ensure-git-repo) + (event-loop handle-request maybe-reindex))) |