;;;; 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)