1 (if (not (find-package :swank
))
2 (asdf:oos
'asdf
:load-op
:swank
))
4 (mapc (lambda (system) (asdf:oos
'asdf
:load-op system
))
5 '(:cxml
:cxml-stp
:arnesi
:cl-ppcre
6 :xml-emitter
:local-time
:cl-fad
:split-sequence
))
8 (defpackage :org.unknownlamer.rss-feed
10 (:use
:cl
:xml-emitter
)
11 (:import-from
:arnesi
:if-bind
:when-bind
:escape-as-uri
:curry
:compose
)
12 (:import-from
:split-sequence
:split-sequence
)
13 (:export
:darcs-
>feed
:run
))
15 (in-package :org.unknownlamer.rss-feed
)
17 (defparameter *repo-path
*
19 :directory
"afs/hcoop.net/user/c/cl/clinton/darcs/unknownlamer.org"))
21 (defparameter *rss-path
*
23 :directory
"afs/hcoop.net/user/c/cl/clinton/feeds/rss"
24 :name
"site-updates"))
26 (defparameter *muse-file-scanner
*
27 (ppcre:create-scanner
"(.+)\\.muse"))
29 (defparameter *special-files
*
30 '(("book-list.lisp" .
"Book List")))
32 ;;; Parse darcs xml changelog
37 ;; :author :date :local_date
39 ;; (comment PATCH-COMMENT)
41 ;; (add_file FILE-NAME)
42 ;; (modify_file FILE-NAME
43 ;; (removed_lines :num)
44 ;; (added_lines :num)))))
46 (defun darcs-changes->stp
(stream)
49 (cxml:make-whitespace-normalizer
(stp:make-builder
))))
51 (defun find-child-named (child-name parent-node
)
52 (stp:find-child-if
(lambda (node)
53 (and (typep node
'stp
:element
)
54 (string= (stp:local-name node
) child-name
)))
57 (defun filter-children-by-name (child-name parent-node
)
58 (stp:filter-children
(lambda (node)
59 (and (typep node
'stp
:element
)
60 (string= (stp:local-name node
) child-name
)))
63 (defun darcs-stp->parsed-list
(document)
64 ;; What must be done: load darcs changes xml, iterate over patches,
65 ;; generate a simpler structure storing (NAME ID DATE COMMENT CHANGES)
66 ;; where COMMENT may be nil and CHANGES is another list of sublists
67 ;; ((ADDED ...) (CHANGED ...)). Deletions may be ignored for now.
70 (list (stp:string-value
(find-child-named "name" patch
))
71 (stp:attribute-value patch
"date")
72 (stp:attribute-value patch
"hash")
73 (when-bind comment
(find-child-named "comment" patch
)
74 (stp:string-value comment
))
75 (let ((summary (find-child-named "summary" patch
)))
79 (compose (curry #'string-trim
82 (filter-children-by-name "add_file" summary
)))
85 (compose (curry #'string-trim
88 (filter-children-by-name "modify_file" summary
)))))))
89 (filter-children-by-name "patch"
90 (stp:first-child document
))))
92 ;;; Parsed changelog accessors
94 (defun patch-name (patch)
97 (defun patch-date (patch)
100 (defun patch-hash (patch)
103 (defun patch-comment (patch)
106 (defun patch-added-files (patch)
107 (cdr (first (fifth patch
))))
109 (defun patch-changed-files (patch)
110 (cdr (second (fifth patch
))))
114 (defun muse-path->html-url
(potential-muse-path)
115 ;; When generating the RSS only *.muse files should have links and
116 ;; these should be translated to the corresponding html
117 (when-bind basename
(or (ppcre:register-groups-bind
(basename)
118 (*muse-file-scanner
* potential-muse-path
)
120 (cdar (member potential-muse-path
*special-files
*
121 :key
#'car
:test
#'string
=)))
122 (format nil
"http://unknownlamer.org/muse/~A.html"
123 (escape-as-uri basename
))))
125 (defun darcs-time->local-time
(timestring)
126 ;; YYYYMMDDHHMMSS UTC
127 (local-time:universal-to-timestamp
128 (encode-universal-time (parse-integer timestring
:start
12 :end
14)
129 (parse-integer timestring
:start
10 :end
12)
130 (parse-integer timestring
:start
8 :end
10)
131 (parse-integer timestring
:start
6 :end
8)
132 (parse-integer timestring
:start
4 :end
6)
133 (parse-integer timestring
:start
0 :end
4)
136 (defun darcs-time->pubdate
(darcs-time)
137 ;; this seems to be correct but at least liferea is taking my time
138 ;; and substracting the tz offset from it ... what the fuck
139 (let ((local-time (darcs-time->local-time darcs-time
)))
140 (local-time:format-timestring
142 :format
'(:short-weekday
", "
143 (:day
2) #\space
:short-month
#\space
(:year
4) #\space
144 (:hour
2) #\
: (:min
2) #\
: (:sec
2) #\space
:timezone
))))
146 (defun darcs-hash->guid
(hash)
149 "http://unknownlamer.org/darcsweb/browse?r=unknownlamer.org;a=commit;h=~A"
152 (defun file-link (file)
155 (if-bind muse-url
(muse-path->html-url file
)
156 (simple-tag "a" file
`(("href" ,muse-url
)))
159 (defun generate-entry-html (patch)
160 (with-output-to-string (string-stream)
161 ;; EVIL, but ... I don't feel like modifying the xml-emitter lib
162 (let ((xml-emitter::*xml-output-stream
* string-stream
))
163 (when-bind comment
(patch-comment patch
)
166 (when-bind added-files
(patch-added-files patch
)
167 (simple-tag "h2" "New Files")
169 (dolist (file added-files
)
171 (when-bind changed-files
(patch-changed-files patch
)
172 (simple-tag "h2" "Modified Files")
174 (dolist (file changed-files
)
175 (file-link file
)))))))
177 (defun generate-feed (entries stream
)
178 (with-rss2 (stream :encoding
"UTF-8")
179 (rss-channel-header "The Home of Your Friendly Neighborhood Terrorist"
180 "http://unknownlamer.org"
181 :description
"Updates to Clinton Ebadi's personal website")
182 (dolist (entry entries
)
183 (rss-item (patch-name entry
)
184 :description
(generate-entry-html entry
)
185 :guid
(darcs-hash->guid
(patch-hash entry
)) ; fix guid
186 :pubdate
(darcs-time->pubdate
(patch-date entry
))))))
190 (defun darcs-changelog-stream ()
192 (let ((dirlist (fad:list-directory
194 (wild-path (make-pathname :type
"muse")))
195 (mapcan (lambda (path)
196 (if (pathname-match-p path wild-path
)
199 (mapcar (lambda (file)
200 ;; note: assumes only one . in the filename
201 ;; (this is true ... for now)
202 (let ((split-file (split-sequence #\.
(car file
))))
204 (make-pathname :name
(first split-file
)
205 :type
(second split-file
))
208 (sb-ext:process-output
209 (sb-ext:run-program
"darcs"
210 `("changes" "--xml" "--summary"
211 ,(format nil
"--repodir=~A" *repo-path
*)
212 "--only-to-files" ,@(mapcar
221 (defun firstn (n list
)
222 ;; yeah yeah really shitty whatever
223 (loop for i from
0 to n collect
(nth i list
)))
225 (defun stream->feed
(input-stream output-stream
)
228 (darcs-stp->parsed-list
(darcs-changes->stp input-stream
)))
231 (defun darcs->feed
()
232 (with-open-file (rss-out *rss-path
*
234 :if-exists
:supersede
235 :if-does-not-exist
:create
)
236 (stream->feed
(darcs-changelog-stream) rss-out
)))