generator.lisp - cl-yag - Common Lisp Yet Another website Generator
HTML git clone git://bitreich.org/cl-yag/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/cl-yag/
DIR Log
DIR Files
DIR Refs
DIR Tags
DIR README
DIR LICENSE
---
generator.lisp (20812B)
---
1 ;;;; GLOBAL VARIABLES
2
3 (defparameter *articles* '())
4 (defparameter *converters* '())
5 (defparameter *days* '("Monday" "Tuesday" "Wednesday" "Thursday"
6 "Friday" "Saturday" "Sunday"))
7 (defparameter *months* '("January" "February" "March" "April"
8 "May" "June" "July" "August" "September"
9 "October" "November" "December"))
10
11 ;; structure to store links
12 (defstruct article title tag date id tiny author rawdate converter)
13 (defstruct converter name command extension)
14
15 ;;;; FUNCTIONS
16
17 (require 'asdf)
18
19 ;; return the day of the week
20 (defun get-day-of-week(day month year)
21 (multiple-value-bind
22 (second minute hour date month year day-of-week dst-p tz)
23 (decode-universal-time (encode-universal-time 0 0 0 day month year))
24 (declare (ignore second minute hour date month year dst-p tz))
25 day-of-week))
26
27 ;; parse the date to
28 (defun date-parse(date)
29 (if (= 8 (length date))
30 (let* ((year (parse-integer date :start 0 :end 4))
31 (monthnum (parse-integer date :start 4 :end 6))
32 (daynum (parse-integer date :start 6 :end 8))
33 (day (nth (get-day-of-week daynum monthnum year) *days*))
34 (month (nth (- monthnum 1) *months*)))
35 (list
36 :dayname day
37 :daynumber daynum
38 :monthname month
39 :monthnumber monthnum
40 :year year))
41 nil))
42
43 (defun post(&optional &key title tag date id (tiny nil) (author (getf *config* :webmaster)) (converter nil))
44 (push (make-article :title title
45 :tag tag
46 :date (date-parse date)
47 :rawdate date
48 :tiny tiny
49 :author author
50 :id id
51 :converter converter)
52 *articles*))
53
54 ;; we add a converter to the list of the one availables
55 (defun converter(&optional &key name command extension)
56 (setf *converters*
57 (append
58 (list name
59 (make-converter :name name
60 :command command
61 :extension extension))
62 *converters*)))
63
64 ;; load data from metadata and load config
65 (load "data/articles.lisp")
66 (setf *articles* (reverse *articles*))
67
68
69 ;; common-lisp don't have a replace string function natively
70 (defun replace-all (string part replacement &key (test #'char=))
71 (with-output-to-string (out)
72 (loop with part-length = (length part)
73 for old-pos = 0 then (+ pos part-length)
74 for pos = (search part string
75 :start2 old-pos
76 :test test)
77 do (write-string string out
78 :start old-pos
79 :end (or pos (length string)))
80 when pos do (write-string replacement out)
81 while pos)))
82
83 ;; common-lisp don't have a split string function natively
84 (defun split-str(text &optional (separator #\Space))
85 "this function split a string with separator and return a list"
86 (let ((text (concatenate 'string text (string separator))))
87 (loop for char across text
88 counting char into count
89 when (char= char separator)
90 collect
91 ;; we look at the position of the left separator from right to left
92 (let ((left-separator-position (position separator text :from-end t :end (- count 1))))
93 (subseq text
94 ;; if we can't find a separator at the left of the current, then it's the start of
95 ;; the string
96 (if left-separator-position (+ 1 left-separator-position) 0)
97 (- count 1))))))
98
99 ;; load a file as a string
100 ;; we escape ~ to avoid failures with format
101 (defun load-file(path)
102 (if (probe-file path)
103 (with-open-file (stream path)
104 (let ((contents (make-string (file-length stream))))
105 (read-sequence contents stream)
106 contents))
107 (progn
108 (format t "ERROR : file ~a not found. Aborting~%" path)
109 (quit))))
110
111 ;; save a string in a file
112 (defun save-file(path data)
113 (with-open-file (stream path :direction :output :if-exists :supersede)
114 (write-sequence data stream)))
115
116 ;; simplify the str replace work
117 (defmacro template(before &body after)
118 `(progn
119 (setf output (replace-all output ,before ,@after))))
120
121 ;; get the converter object of "article"
122 (defmacro with-converter(&body code)
123 `(progn
124 (let ((converter-name (if (article-converter article)
125 (article-converter article)
126 (getf *config* :default-converter))))
127 (let ((converter-object (getf *converters* converter-name)))
128 ,@code))))
129
130 ;; generate the html file from the source file
131 ;; using the converter associated with the post
132 (defun use-converter-to-html(filename &optional (converter-name nil))
133 (let* ((converter-object (getf *converters*
134 (or converter-name
135 converter-name
136 (getf *config* :default-converter))))
137 (output (converter-command converter-object))
138 (src-file (format nil "~a~a" filename (converter-extension converter-object)))
139 (dst-file (format nil "temp/data/~a.html" filename ))
140 (full-src-file (format nil "data/~a" src-file)))
141 ;; skip generating if the destination exists
142 ;; and is more recent than source
143 (unless (and
144 (probe-file dst-file)
145 (>=
146 (file-write-date dst-file)
147 (file-write-date full-src-file)))
148 (ensure-directories-exist "temp/data/")
149 (template "%IN" src-file)
150 (template "%OUT" dst-file)
151 (format t "~a~%" output)
152 (uiop:run-program output))))
153
154 ;; format the date
155 (defun date-format(format date)
156 (let ((output format))
157 (template "%DayName" (getf date :dayname))
158 (template "%DayNumber" (format nil "~2,'0d" (getf date :daynumber)))
159 (template "%MonthName" (getf date :monthname))
160 (template "%MonthNumber" (format nil "~2,'0d" (getf date :monthnumber)))
161 (template "%Year" (write-to-string (getf date :year )))
162 output))
163
164 ;; simplify the declaration of a new page type
165 (defmacro prepare(template &body code)
166 `(progn
167 (let ((output (load-file ,template)))
168 ,@code
169 output)))
170
171 ;; simplify the file saving by using the layout
172 (defmacro generate(name &body data)
173 `(progn
174 (save-file ,name (generate-layout ,@data))))
175
176 ;; generate a gemini index file
177 (defun generate-gemini-index(articles)
178 (let ((output (load-file "templates/gemini_head.tpl")))
179 (dolist (article articles)
180 (setf output
181 (string
182 (concatenate 'string output
183 (format nil "=> ~a/articles/~a.gmi ~a-~2,'0d-~2,'0d ~a~%"
184 (getf *config* :gemini-path)
185 (article-id article)
186 (getf (article-date article) :year)
187 (getf (article-date article) :monthnumber)
188 (getf (article-date article) :daynumber)
189 (article-title article))))))
190 output))
191
192 ;; generate a gopher index file
193 (defun generate-gopher-index(articles)
194 (let ((output (load-file "templates/gopher_head.tpl")))
195 (dolist (article articles)
196 (setf output
197 (string
198 (concatenate 'string output
199 (format nil (getf *config* :gopher-format)
200 0 ;;;; gopher type, 0 for text files
201 ;; here we create a 80 width char string with title on the left
202 ;; and date on the right
203 ;; we truncate the article title if it's too large
204 (let ((title (format nil "~80a"
205 (if (< 80 (length (article-title article)))
206 (subseq (article-title article) 0 80)
207 (article-title article)))))
208 (replace title (article-rawdate article) :start1 (- (length title) (length (article-rawdate article)))))
209 (concatenate 'string
210 (getf *config* :gopher-path) "/article-" (article-id article) ".txt")
211 (getf *config* :gopher-server)
212 (getf *config* :gopher-port)
213 )))))
214 output))
215
216 ;; generate the list of tags
217 (defun articles-by-tag()
218 (let ((tag-list))
219 (loop for article in *articles* do
220 (when (article-tag article) ;; we don't want an error if no tag
221 (loop for tag in (split-str (article-tag article)) do ;; for each word in tag keyword
222 (setf (getf tag-list (intern tag "KEYWORD")) ;; we create the keyword is inexistent and add ID to :value
223 (list
224 :name tag
225 :value (push (article-id article) (getf (getf tag-list (intern tag "KEYWORD")) :value)))))))
226 (loop for i from 1 to (length tag-list) by 2 collect ;; removing the keywords
227 (nth i tag-list))))
228
229 ;; generates the html of the list of tags for an article
230 (defun get-tag-list-article(&optional article)
231 (apply #'concatenate 'string
232 (mapcar #'(lambda (item)
233 (prepare "templates/one-tag.tpl" (template "%%Name%%" item)))
234 (split-str (article-tag article)))))
235
236 ;; generates the html of the whole list of tags
237 (defun get-tag-list()
238 (apply #'concatenate 'string
239 (mapcar #'(lambda (item)
240 (prepare "templates/one-tag.tpl"
241 (template "%%Name%%" (getf item :name))))
242 (articles-by-tag))))
243
244
245 ;; generates the html of only one article
246 ;; this is called in a loop to produce the homepage
247 (defun create-article(article &optional &key (tiny t) (no-text nil))
248 (prepare "templates/article.tpl"
249 (template "%%Author%%" (let ((author (article-author article)))
250 (or author (getf *config* :webmaster))))
251 (template "%%Date%%" (date-format (getf *config* :date-format)
252 (article-date article)))
253 (template "%%Raw-Date%%" (article-rawdate article))
254 (template "%%Title%%" (article-title article))
255 (template "%%Id%%" (article-id article))
256 (template "%%Tags%%" (get-tag-list-article article))
257 (template "%%Date-Url%%" (date-format "%Year-%MonthNumber-%DayNumber"
258 (article-date article)))
259 (template "%%Text%%" (if no-text
260 ""
261 (if (and tiny (article-tiny article))
262 (format nil "<p>~a</p>" (article-tiny article))
263 (load-file (format nil "temp/data/~d.html" (article-id article))))))))
264
265 ;; return a html string
266 ;; produce the code of a whole page with title+layout with the parameter as the content
267 (defun generate-layout(body &optional &key (title nil))
268 (prepare "templates/layout.tpl"
269 (template "%%Title%%" (if title title (getf *config* :title)))
270 (template "%%Tags%%" (get-tag-list))
271 (template "%%Body%%" body)
272 output))
273
274
275 ;; html generation of index homepage
276 (defun generate-semi-mainpage(&key (tiny t) (no-text nil))
277 (apply #'concatenate 'string
278 (loop for article in *articles* collect
279 (create-article article :tiny tiny :no-text no-text))))
280
281 ;; html generation of a tag homepage
282 (defun generate-tag-mainpage(articles-in-tag)
283 (apply #'concatenate 'string
284 (loop for article in *articles*
285 when (member (article-id article) articles-in-tag :test #'equal)
286 collect (create-article article :tiny t))))
287
288 ;; xml generation of the items for the rss
289 (defun generate-rss-item(&key (gopher nil))
290 (apply #'concatenate 'string
291 (loop for article in *articles*
292 for i from 1 to (min (length *articles*) (getf *config* :rss-item-number))
293 collect
294 (prepare "templates/rss-item.tpl"
295 (template "%%Title%%" (article-title article))
296 (template "%%Description%%" (load-file (format nil "temp/data/~d.html" (article-id article))))
297 (template "%%Date%%" (format nil
298 (date-format "~a, %DayNumber ~a %Year 00:00:00 GMT"
299 (article-date article))
300 (subseq (getf (article-date article) :dayname) 0 3)
301 (subseq (getf (article-date article) :monthname) 0 3)))
302 (template "%%Url%%"
303 (if gopher
304 (format nil "gopher://~a:~d/0~a/article-~a.txt"
305 (getf *config* :gopher-server)
306 (getf *config* :gopher-port)
307 (getf *config* :gopher-path)
308 (article-id article))
309 (format nil "~d~d-~d.html"
310 (getf *config* :url)
311 (date-format "%Year-%MonthNumber-%DayNumber"
312 (article-date article))
313 (article-id article))))))))
314
315
316 ;; Generate the rss xml data
317 (defun generate-rss(&key (gopher nil))
318 (prepare "templates/rss.tpl"
319 (template "%%Description%%" (getf *config* :description))
320 (template "%%Title%%" (getf *config* :title))
321 (template "%%Url%%" (getf *config* :url))
322 (template "%%Items%%" (generate-rss-item :gopher gopher))))
323
324 ;; We do all the website
325 (defun create-html-site()
326
327 ;; produce each article file
328 (loop for article in *articles*
329 do
330 ;; use the article's converter to get html code of it
331 (use-converter-to-html (article-id article) (article-converter article))
332
333 (generate (format nil "output/html/~d-~d.html"
334 (date-format "%Year-%MonthNumber-%DayNumber"
335 (article-date article))
336 (article-id article))
337 (create-article article :tiny nil)
338 :title (concatenate 'string (getf *config* :title) " : " (article-title article))))
339
340 ;; produce index.html
341 (generate "output/html/index.html" (generate-semi-mainpage))
342
343 ;; produce index-titles.html where there are only articles titles
344 (generate "output/html/index-titles.html" (generate-semi-mainpage :no-text t))
345
346 ;; produce index file for each tag
347 (loop for tag in (articles-by-tag) do
348 (generate (format nil "output/html/tag-~d.html" (getf tag :NAME))
349 (generate-tag-mainpage (getf tag :VALUE))))
350
351 ;; generate rss gopher in html folder if gopher is t
352 (when (getf *config* :gopher)
353 (save-file "output/html/rss-gopher.xml" (generate-rss :gopher t)))
354
355 ;;(generate-file-rss)
356 (save-file "output/html/rss.xml" (generate-rss)))
357
358 ;; we do all the gemini capsule
359 (defun create-gemini-capsule()
360
361 ;; produce the index.gmi file
362 (save-file (concatenate 'string "output/gemini/" (getf *config* :gemini-index))
363 (generate-gemini-index *articles*))
364
365 ;; produce a tag list menu
366 (let* ((directory-path "output/gemini/_tags_/")
367 (index-path (concatenate 'string directory-path (getf *config* :gemini-index))))
368 (ensure-directories-exist directory-path)
369 (save-file index-path
370 (let ((output (load-file "templates/gemini_head.tpl")))
371 (loop for tag in
372 ;; sort tags per articles in it
373 (sort (articles-by-tag) #'>
374 :key #'(lambda (x) (length (getf x :value))))
375 do
376 (setf output
377 (string
378 (concatenate
379 'string output
380 (format nil "=> ~a/~a/index.gmi ~a ~d~%"
381 (getf *config* :gemini-path)
382 (getf tag :name)
383 (getf tag :name)
384 (length (getf tag :value)))))))
385 output)))
386
387 ;; produce each tag gemini index
388 (loop for tag in (articles-by-tag) do
389 (let* ((directory-path (concatenate 'string "output/gemini/" (getf tag :NAME) "/"))
390 (index-path (concatenate 'string directory-path (getf *config* :gemini-index)))
391 (articles-with-tag (loop for article in *articles*
392 when (member (article-id article) (getf tag :VALUE) :test #'equal)
393 collect article)))
394 (ensure-directories-exist directory-path)
395 (save-file index-path (generate-gemini-index articles-with-tag))))
396
397 ;; produce each article file (adding some headers)
398 (loop for article in *articles*
399 do
400 (with-converter
401 (let ((id (article-id article)))
402 (save-file (format nil "output/gemini/articles/~a.gmi" id)
403 (format nil "~{~a~}"
404 (list
405 "Title : " (article-title article) #\Newline
406 "Author: " (article-author article) #\Newline
407 "Date : " (date-format (getf *config* :date-format) (article-date article)) #\Newline
408 "Tags : " (article-tag article) #\Newline #\Newline
409 (load-file (format nil "data/~d~d" id (converter-extension converter-object))))))))))
410
411 ;; we do all the gopher hole
412 (defun create-gopher-hole()
413
414 ;;(generate-file-rss)
415 (save-file "output/gopher/rss.xml" (generate-rss :gopher t))
416
417 ;; produce the gophermap file
418 (save-file (concatenate 'string "output/gopher/" (getf *config* :gopher-index))
419 (generate-gopher-index *articles*))
420
421 ;; produce a tag list menu
422 (let* ((directory-path "output/gopher/_tags_/")
423 (index-path (concatenate 'string directory-path (getf *config* :gopher-index))))
424 (ensure-directories-exist directory-path)
425 (save-file index-path
426 (let ((output (load-file "templates/gopher_head.tpl")))
427 (loop for tag in
428 ;; sort tags per articles in it
429 (sort (articles-by-tag) #'>
430 :key #'(lambda (x) (length (getf x :value))))
431 do
432 (setf output
433 (string
434 (concatenate
435 'string output
436 (format nil (getf *config* :gopher-format)
437 1 ;; gopher type, 1 for menus
438 ;; here we create a 72 width char string with title on the left
439 ;; and number of articles on the right
440 ;; we truncate the article title if it's too large
441 (let ((title (format nil "~72a"
442 (if (< 72 (length (getf tag :NAME)))
443 (subseq (getf tag :NAME) 0 80)
444 (getf tag :NAME))))
445 (article-number (format nil "~d article~p" (length (getf tag :value)) (length (getf tag :value)))))
446 (replace title article-number :start1 (- (length title) (length article-number))))
447 (concatenate 'string
448 (getf *config* :gopher-path) "/" (getf tag :NAME) "/")
449 (getf *config* :gopher-server)
450 (getf *config* :gopher-port)
451 )))))
452 output)))
453
454 ;; produce each tag gophermap index
455 (loop for tag in (articles-by-tag) do
456 (let* ((directory-path (concatenate 'string "output/gopher/" (getf tag :NAME) "/"))
457 (index-path (concatenate 'string directory-path (getf *config* :gopher-index)))
458 (articles-with-tag (loop for article in *articles*
459 when (member (article-id article) (getf tag :VALUE) :test #'equal)
460 collect article)))
461 (ensure-directories-exist directory-path)
462 (save-file index-path (generate-gopher-index articles-with-tag))))
463
464 ;; produce each article file (adding some headers)
465 (loop for article in *articles*
466 do
467 (with-converter
468 (let ((id (article-id article)))
469 (save-file (format nil "output/gopher/article-~d.txt" id)
470 (format nil "Title: ~a~%Author: ~a~%Date: ~a~%Tags: ~a~%============~%~%~a"
471 (article-title article)
472 (article-author article)
473 (date-format (getf *config* :date-format) (article-date article))
474 (article-tag article)
475 (load-file (format nil "data/~d~d" id (converter-extension converter-object)))))))))
476
477
478 ;; This is function called when running the tool
479 (defun generate-site()
480 (if (getf *config* :html)
481 (create-html-site))
482 (if (getf *config* :gemini)
483 (create-gemini-capsule))
484 (if (getf *config* :gopher)
485 (create-gopher-hole)))
486
487 ;;;; EXECUTION
488
489 (generate-site)
490
491 (quit)