root/lang/gauche/oldtype/trunk/command/blog @ 10149

#!/usr/local/bin/gosh

(use srfi-1)
(use oldtype.util)


(define ot-new-entry-limit 10)


(define ot-blog (format "~a/!~a.blog"
                        (oldtype:editpath)
                        (oldtype:user-local)))

(define ot-blog-header (format "~a.blog_header.ot"
                               (oldtype:user-local)))

(define (ot-blog-entrylist)
  (reverse
   (sort
    (oldtype:get-pagelist (string-append
                           (oldtype:user-local)
                           "[.]([0-9]+)")))))

(define (output-blog save-filename entrylist)
  (with-output-to-file save-filename
    (lambda ()
      (for-each
       (lambda (filename)
         (with-input-from-file (string-append (oldtype:editpath) "/" filename)
           (lambda ()
             (when (#/[.][0-9]+/ filename)
               (display "----") (newline)
               (display 
                (string-append "* [[" (oldtype:otpath->wikiname filename) "]]")))
             (for-each print (port->string-list (current-input-port))))))
       entrylist))))


(define (output-blog-list save-filename entrylist)
  (with-output-to-file save-filename
    (lambda ()
      (for-each
       (lambda (filename)
         (with-input-from-file (string-append (oldtype:editpath) "/" filename)
           (lambda ()
             (when (#/[.][0-9]+/ filename)
               (display
                (string-append "- [[" (oldtype:otpath->wikiname filename) "]]"))
               (print (car (port->string-list (current-input-port))))))))
       entrylist))))


(define (main argv)
  (output-blog (string-append ot-blog ".ot")
               (cons
                ot-blog-header
                (take (ot-blog-entrylist) ot-new-entry-limit)))
  (output-blog (string-append ot-blog ".past.ot")
               (cons
                ot-blog-header
                (drop (ot-blog-entrylist) ot-new-entry-limit)))
  (output-blog-list (string-append ot-blog ".list.ot")
                    (ot-blog-entrylist)))