424 lines
17 KiB
Common Lisp
424 lines
17 KiB
Common Lisp
;;;; GLOBAL VARIABLES
|
|
|
|
(defparameter *articles* '())
|
|
(defparameter *converters* '())
|
|
(defparameter *days* '("Monday" "Tuesday" "Wednesday" "Thursday"
|
|
"Friday" "Saturday" "Sunday"))
|
|
(defparameter *months* '("January" "February" "March" "April"
|
|
"May" "June" "July" "August" "September"
|
|
"October" "November" "December"))
|
|
|
|
;; structure to store links
|
|
(defstruct article title tag date id tiny author rawdate converter)
|
|
(defstruct converter name command extension)
|
|
|
|
;;;; FUNCTIONS
|
|
|
|
(require 'asdf)
|
|
|
|
;; return the day of the week
|
|
(defun get-day-of-week(day month year)
|
|
(multiple-value-bind
|
|
(second minute hour date month year day-of-week dst-p tz)
|
|
(decode-universal-time (encode-universal-time 0 0 0 day month year))
|
|
(declare (ignore second minute hour date month year dst-p tz))
|
|
day-of-week))
|
|
|
|
;; parse the date to
|
|
(defun date-parse(date)
|
|
(if (= 8 (length date))
|
|
(let* ((year (parse-integer date :start 0 :end 4))
|
|
(monthnum (parse-integer date :start 4 :end 6))
|
|
(daynum (parse-integer date :start 6 :end 8))
|
|
(day (nth (get-day-of-week daynum monthnum year) *days*))
|
|
(month (nth (- monthnum 1) *months*)))
|
|
(list
|
|
:dayname day
|
|
:daynumber daynum
|
|
:monthname month
|
|
:monthnumber monthnum
|
|
:year year))
|
|
nil))
|
|
|
|
(defun post(&optional &key title tag date id (tiny nil) (author (getf *config* :webmaster)) (converter nil))
|
|
(push (make-article :title title
|
|
:tag tag
|
|
:date (date-parse date)
|
|
:rawdate date
|
|
:tiny tiny
|
|
:author author
|
|
:id id
|
|
:converter converter)
|
|
*articles*))
|
|
|
|
;; we add a converter to the list of the one availables
|
|
(defun converter(&optional &key name command extension)
|
|
(setf *converters*
|
|
(append
|
|
(list name
|
|
(make-converter :name name
|
|
:command command
|
|
:extension extension))
|
|
*converters*)))
|
|
|
|
;; load data from metadata and load config
|
|
(load "data/articles.lisp")
|
|
(setf *articles* (reverse *articles*))
|
|
|
|
|
|
;; common-lisp don't have a replace string function natively
|
|
(defun replace-all (string part replacement &key (test #'char=))
|
|
(with-output-to-string (out)
|
|
(loop with part-length = (length part)
|
|
for old-pos = 0 then (+ pos part-length)
|
|
for pos = (search part string
|
|
:start2 old-pos
|
|
:test test)
|
|
do (write-string string out
|
|
:start old-pos
|
|
:end (or pos (length string)))
|
|
when pos do (write-string replacement out)
|
|
while pos)))
|
|
|
|
;; common-lisp don't have a split string function natively
|
|
(defun split-str(text &optional (separator #\Space))
|
|
"this function split a string with separator and return a list"
|
|
(let ((text (concatenate 'string text (string separator))))
|
|
(loop for char across text
|
|
counting char into count
|
|
when (char= char separator)
|
|
collect
|
|
;; we look at the position of the left separator from right to left
|
|
(let ((left-separator-position (position separator text :from-end t :end (- count 1))))
|
|
(subseq text
|
|
;; if we can't find a separator at the left of the current, then it's the start of
|
|
;; the string
|
|
(if left-separator-position (+ 1 left-separator-position) 0)
|
|
(- count 1))))))
|
|
|
|
;; load a file as a string
|
|
;; we escape ~ to avoid failures with format
|
|
(defun load-file(path)
|
|
(if (probe-file path)
|
|
(replace-all
|
|
(apply #'concatenate 'string
|
|
(with-open-file (stream path)
|
|
(loop for line = (read-line stream nil)
|
|
while line
|
|
collect
|
|
(format nil "~a~%" line))))
|
|
"~" "~~")
|
|
(progn
|
|
(format t "ERROR : file ~a not found. Aborting~%" path)
|
|
(quit))))
|
|
|
|
;; save a string in a file
|
|
(defun save-file(path data)
|
|
(with-open-file (stream path :direction :output :if-exists :supersede)
|
|
(format stream data)))
|
|
|
|
;; simplify the str replace work
|
|
(defmacro template(before &body after)
|
|
`(progn
|
|
(setf output (replace-all output ,before ,@after))))
|
|
|
|
;; get the converter object of "article"
|
|
(defmacro with-converter(&body code)
|
|
`(progn
|
|
(let ((converter-name (if (article-converter article)
|
|
(article-converter article)
|
|
(getf *config* :default-converter))))
|
|
(let ((converter-object (getf *converters* converter-name)))
|
|
,@code))))
|
|
|
|
;; generate the html file from the source file
|
|
;; using the converter associated with the post
|
|
(defun use-converter-to-html(article)
|
|
(with-converter
|
|
(let ((output (converter-command converter-object)))
|
|
(let* ((src-file (format nil "~a~a" (article-id article) (converter-extension converter-object)))
|
|
(dst-file (format nil "temp/data/~a.html" (article-id article) ))
|
|
(full-src-file (format nil "data/~a" src-file)))
|
|
;; skip generating if the destination exists
|
|
;; and is more recent than source
|
|
(unless (and
|
|
(probe-file dst-file)
|
|
(>=
|
|
(file-write-date dst-file)
|
|
(file-write-date full-src-file)))
|
|
(ensure-directories-exist "temp/data/")
|
|
(template "%IN" src-file)
|
|
(template "%OUT" dst-file)
|
|
(format t "~a~%" output)
|
|
(uiop:run-program output))))))
|
|
|
|
;; format the date
|
|
(defun date-format(format date)
|
|
(let ((output format))
|
|
(template "%DayName" (getf date :dayname))
|
|
(template "%DayNumber" (format nil "~2,'0d" (getf date :daynumber)))
|
|
(template "%MonthName" (getf date :monthname))
|
|
(template "%MonthNumber" (format nil "~2,'0d" (getf date :monthnumber)))
|
|
(template "%Year" (write-to-string (getf date :year )))
|
|
output))
|
|
|
|
;; simplify the declaration of a new page type
|
|
(defmacro prepare(template &body code)
|
|
`(progn
|
|
(let ((output (load-file ,template)))
|
|
,@code
|
|
output)))
|
|
|
|
;; simplify the file saving by using the layout
|
|
(defmacro generate(name &body data)
|
|
`(progn
|
|
(save-file ,name (generate-layout ,@data))))
|
|
|
|
;; generate a gopher index file
|
|
(defun generate-gopher-index(articles)
|
|
(let ((output (load-file "templates/gopher_head.tpl")))
|
|
(dolist (article articles)
|
|
(setf output
|
|
(string
|
|
(concatenate 'string output
|
|
(format nil (getf *config* :gopher-format)
|
|
0 ;;;; gopher type, 0 for text files
|
|
;; here we create a 80 width char string with title on the left
|
|
;; and date on the right
|
|
;; we truncate the article title if it's too large
|
|
(let ((title (format nil "~80a"
|
|
(if (< 80 (length (article-title article)))
|
|
(subseq (article-title article) 0 80)
|
|
(article-title article)))))
|
|
(replace title (article-rawdate article) :start1 (- (length title) (length (article-rawdate article)))))
|
|
(concatenate 'string
|
|
(getf *config* :gopher-path) "/article-" (article-id article) ".txt")
|
|
(getf *config* :gopher-server)
|
|
(getf *config* :gopher-port)
|
|
)))))
|
|
output))
|
|
|
|
;; generate the list of tags
|
|
(defun articles-by-tag()
|
|
(let ((tag-list))
|
|
(loop for article in *articles* do
|
|
(when (article-tag article) ;; we don't want an error if no tag
|
|
(loop for tag in (split-str (article-tag article)) do ;; for each word in tag keyword
|
|
(setf (getf tag-list (intern tag "KEYWORD")) ;; we create the keyword is inexistent and add ID to :value
|
|
(list
|
|
:name tag
|
|
:value (push (article-id article) (getf (getf tag-list (intern tag "KEYWORD")) :value)))))))
|
|
(loop for i from 1 to (length tag-list) by 2 collect ;; removing the keywords
|
|
(nth i tag-list))))
|
|
|
|
;; generates the html of the list of tags for an article
|
|
(defun get-tag-list-article(&optional article)
|
|
(apply #'concatenate 'string
|
|
(mapcar #'(lambda (item)
|
|
(prepare "templates/one-tag.tpl" (template "%%Name%%" item)))
|
|
(split-str (article-tag article)))))
|
|
|
|
;; generates the html of the whole list of tags
|
|
(defun get-tag-list()
|
|
(apply #'concatenate 'string
|
|
(mapcar #'(lambda (item)
|
|
(prepare "templates/one-tag.tpl"
|
|
(template "%%Name%%" (getf item :name))))
|
|
(articles-by-tag))))
|
|
|
|
|
|
;; generates the html of only one article
|
|
;; this is called in a loop to produce the homepage
|
|
(defun create-article(article &optional &key (tiny t) (no-text nil))
|
|
(prepare "templates/article.tpl"
|
|
(template "%%Author%%" (let ((author (article-author article)))
|
|
(or author (getf *config* :webmaster))))
|
|
(template "%%Date%%" (date-format (getf *config* :date-format)
|
|
(article-date article)))
|
|
(template "%%Raw-Date%%" (article-rawdate article))
|
|
(template "%%Title%%" (article-title article))
|
|
(template "%%Id%%" (article-id article))
|
|
(template "%%Tags%%" (get-tag-list-article article))
|
|
(template "%%Date-Url%%" (date-format "%Year-%MonthNumber-%DayNumber"
|
|
(article-date article)))
|
|
(template "%%Text%%" (if no-text
|
|
""
|
|
(if (and tiny (article-tiny article))
|
|
(article-tiny article)
|
|
(load-file (format nil "temp/data/~d.html" (article-id article))))))))
|
|
|
|
;; return a html string
|
|
;; produce the code of a whole page with title+layout with the parameter as the content
|
|
(defun generate-layout(body &optional &key (title nil))
|
|
(prepare "templates/layout.tpl"
|
|
(template "%%Title%%" (if title title (getf *config* :title)))
|
|
(template "%%Tags%%" (get-tag-list))
|
|
(template "%%Body%%" body)
|
|
output))
|
|
|
|
|
|
;; html generation of index homepage
|
|
(defun generate-semi-mainpage(&key (tiny t) (no-text nil))
|
|
(apply #'concatenate 'string
|
|
(loop for article in *articles* collect
|
|
(create-article article :tiny tiny :no-text no-text))))
|
|
|
|
;; html generation of a tag homepage
|
|
(defun generate-tag-mainpage(articles-in-tag)
|
|
(apply #'concatenate 'string
|
|
(loop for article in *articles*
|
|
when (member (article-id article) articles-in-tag :test #'equal)
|
|
collect (create-article article :tiny t))))
|
|
|
|
;; xml generation of the items for the rss
|
|
(defun generate-rss-item(&key (gopher nil))
|
|
(apply #'concatenate 'string
|
|
(loop for article in *articles*
|
|
for i from 1 to (min (length *articles*) (getf *config* :rss-item-number))
|
|
collect
|
|
(prepare "templates/rss-item.tpl"
|
|
(template "%%Title%%" (article-title article))
|
|
(template "%%Description%%" (load-file (format nil "temp/data/~d.html" (article-id article))))
|
|
(template "%%Date%%" (format nil
|
|
(date-format "~a, %DayNumber ~a %Year 00:00:00 GMT"
|
|
(article-date article))
|
|
(subseq (getf (article-date article) :dayname) 0 3)
|
|
(subseq (getf (article-date article) :monthname) 0 3)))
|
|
(template "%%Url%%"
|
|
(if gopher
|
|
(format nil "gopher://~a:~d/0~a/article-~a.txt"
|
|
(getf *config* :gopher-server)
|
|
(getf *config* :gopher-port)
|
|
(getf *config* :gopher-path)
|
|
(article-id article))
|
|
(format nil "~d~d-~d.html"
|
|
(getf *config* :url)
|
|
(date-format "%Year-%MonthNumber-%DayNumber"
|
|
(article-date article))
|
|
(article-id article))))))))
|
|
|
|
|
|
;; Generate the rss xml data
|
|
(defun generate-rss(&key (gopher nil))
|
|
(prepare "templates/rss.tpl"
|
|
(template "%%Description%%" (getf *config* :description))
|
|
(template "%%Title%%" (getf *config* :title))
|
|
(template "%%Url%%" (getf *config* :url))
|
|
(template "%%Items%%" (generate-rss-item :gopher gopher))))
|
|
|
|
;; We do all the website
|
|
(defun create-html-site()
|
|
|
|
;; produce each article file
|
|
(loop for article in *articles*
|
|
do
|
|
;; use the article's converter to get html code of it
|
|
(use-converter-to-html article)
|
|
|
|
(generate (format nil "output/html/~d-~d.html"
|
|
(date-format "%Year-%MonthNumber-%DayNumber"
|
|
(article-date article))
|
|
(article-id article))
|
|
(create-article article :tiny nil)
|
|
:title (concatenate 'string (getf *config* :title) " : " (article-title article))))
|
|
|
|
;; produce index.html
|
|
(generate "output/html/index.html" (generate-semi-mainpage))
|
|
|
|
;; produce index-titles.html where there are only articles titles
|
|
(generate "output/html/index-titles.html" (generate-semi-mainpage :no-text t))
|
|
|
|
;; produce index file for each tag
|
|
(loop for tag in (articles-by-tag) do
|
|
(generate (format nil "output/html/tag-~d.html" (getf tag :NAME))
|
|
(generate-tag-mainpage (getf tag :VALUE))))
|
|
|
|
;; generate rss gopher in html folder if gopher is t
|
|
(when (getf *config* :gopher)
|
|
(save-file "output/html/rss-gopher.xml" (generate-rss :gopher t)))
|
|
|
|
;;(generate-file-rss)
|
|
(save-file "output/html/rss.xml" (generate-rss)))
|
|
|
|
;; we do all the gopher hole
|
|
(defun create-gopher-hole()
|
|
|
|
;;(generate-file-rss)
|
|
(save-file "output/gopher/rss.xml" (generate-rss :gopher t))
|
|
|
|
;; produce the gophermap file
|
|
(save-file (concatenate 'string "output/gopher/" (getf *config* :gopher-index))
|
|
(generate-gopher-index *articles*))
|
|
|
|
;; produce a tag list menu
|
|
(let* ((directory-path "output/gopher/_tags_/")
|
|
(index-path (concatenate 'string directory-path (getf *config* :gopher-index))))
|
|
(ensure-directories-exist directory-path)
|
|
(save-file index-path
|
|
(let ((output (load-file "templates/gopher_head.tpl")))
|
|
(loop for tag in
|
|
;; sort tags per articles in it
|
|
(sort (articles-by-tag) #'>
|
|
:key #'(lambda (x) (length (getf x :value))))
|
|
do
|
|
(setf output
|
|
(string
|
|
(concatenate
|
|
'string output
|
|
(format nil (getf *config* :gopher-format)
|
|
1 ;; gopher type, 1 for menus
|
|
;; here we create a 72 width char string with title on the left
|
|
;; and number of articles on the right
|
|
;; we truncate the article title if it's too large
|
|
(let ((title (format nil "~72a"
|
|
(if (< 72 (length (getf tag :NAME)))
|
|
(subseq (getf tag :NAME) 0 80)
|
|
(getf tag :NAME))))
|
|
(article-number (format nil "~d article~p" (length (getf tag :value)) (length (getf tag :value)))))
|
|
(replace title article-number :start1 (- (length title) (length article-number))))
|
|
(concatenate 'string
|
|
(getf *config* :gopher-path) "/" (getf tag :NAME) "/")
|
|
(getf *config* :gopher-server)
|
|
(getf *config* :gopher-port)
|
|
)))))
|
|
output)))
|
|
|
|
;; produce each tag gophermap index
|
|
(loop for tag in (articles-by-tag) do
|
|
(let* ((directory-path (concatenate 'string "output/gopher/" (getf tag :NAME) "/"))
|
|
(index-path (concatenate 'string directory-path (getf *config* :gopher-index)))
|
|
(articles-with-tag (loop for article in *articles*
|
|
when (member (article-id article) (getf tag :VALUE) :test #'equal)
|
|
collect article)))
|
|
(ensure-directories-exist directory-path)
|
|
(save-file index-path (generate-gopher-index articles-with-tag))))
|
|
|
|
;; produce each article file (adding some headers)
|
|
(loop for article in *articles*
|
|
do
|
|
(with-converter
|
|
(let ((id (article-id article)))
|
|
(save-file (format nil "output/gopher/article-~d.txt" id)
|
|
(format nil "~{~a~}"
|
|
(list
|
|
"Title: " (article-title article) "~%"
|
|
"Author: " (article-author article) "~%"
|
|
"Date: " (date-format (getf *config* :date-format) (article-date article)) "~%"
|
|
"Tags: " (article-tag article) "~%"
|
|
"==========~%~%"
|
|
(load-file (format nil "data/~d~d" id (converter-extension converter-object))))))))))
|
|
|
|
|
|
;; This is function called when running the tool
|
|
(defun generate-site()
|
|
(if (getf *config* :html)
|
|
(create-html-site))
|
|
(if (getf *config* :gopher)
|
|
(create-gopher-hole)))
|
|
|
|
;;;; EXECUTION
|
|
|
|
(generate-site)
|
|
|
|
(quit)
|