gistfile1.scm

#!/usr/bin/env dfsch-repl
;;; ublog - incredibly stupid blog engine
;;; Copyright (c) 2009 Ales Hakl
;;;
;;; Permission is hereby granted, free of charge, to any person obtaining
;;; a copy of this software and associated documentation files (the
;;; "Software"), to deal in the Software without restriction, including
;;; without limitation the rights to use, copy, modify, merge, publish,
;;; distribute, sublicense, and/or sell copies of the Software, and to
;;; permit persons to whom the Software is furnished to do so, subject to
;;; the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be
;;; included in all copies or substantial portions of the Software.
;;; 
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
;;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
;;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
;;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.


(require 'sxml)
(require 'unix)
(require 'cmdopts)

(define-class <blog-entry> () (name title contents ctime author))
(define-method <blog-entry> (initialize-instance self))

(define (process-entry-attributte entry attr value)
  (case attr
    ((name) (slot-set! entry 'name value))
    ((title) (slot-set! entry 'title value))
    ((contents) (slot-set! entry 'contents value))
    ((ctime) (slot-set! entry 'ctime value))
    ((author) (slot-set! entry 'author value))

(define (read-entry filename name)
  (let ((file (load:read-scm filename))
        (ctime ((unix:stat filename) 'ctime))
        (entry (make-instance <blog-entry>)))
    (slot-set! entry 'name name)
    (slot-set! entry 'ctime ctime)
    (slot-set! entry (configuration-value 'default-author))
    (let loop ((i entry))
      (unless (null? i)
              (process-entry-attribute entry (caar i) (cdar i))
              (loop (cdr i))))
    
    )
  
  )

(define (read-directory directory)
  (let ((dd (unix:opendir directory)))
    (let loop ((list ()))
      (let ((dirent (unix:readdir dd)))
        (if (null? dirent)
            list
            (if (eq? (string-ref dirent 0) #\.)
                (loop list)
                (loop (cons (read-entry (string-append directory "/" dirent)
                                        dirent)
                            list))))))))