(if (not (find-package :swank)) (asdf:oos 'asdf:load-op :swank)) (mapc (lambda (system) (asdf:oos 'asdf:load-op system)) '(:cxml :cxml-stp :arnesi :cl-ppcre :xml-emitter :local-time :cl-fad :split-sequence)) (defpackage :org.unknownlamer.rss-feed (:nicknames :ul-rss) (:use :cl :xml-emitter) (:import-from :arnesi :if-bind :when-bind :escape-as-uri :escape-as-html :curry :compose) (:import-from :split-sequence :split-sequence) (:export :darcs->feed :run)) (in-package :org.unknownlamer.rss-feed) (defparameter *repo-path* (make-pathname :directory "afs/hcoop.net/user/c/cl/clinton/darcs/unknownlamer.org")) (defparameter *rss-path* (make-pathname :directory "afs/hcoop.net/user/c/cl/clinton/feeds/rss" :name "site-updates")) (defparameter *muse-file-scanner* (ppcre:create-scanner "(.+)\\.muse")) ;; pathname, pathname -> web accesible page (defstruct special-file path conversion) (defparameter *special-files* (list (make-special-file :path (make-pathname :name "book-list" :type "lisp") :conversion (lambda (path) (declare (ignorable path)) "Book List.html")) (make-special-file :path (make-pathname :name :wild :type "qbrew" :directory '(:relative "beer-recipes" :wild)) :conversion (lambda (path) (namestring (merge-pathnames (make-pathname :type "html") path)))) (make-special-file :path (make-pathname :name :wild :type "xml" :directory '(:relative "beer-recipes" :wild)) :conversion (lambda (path) (namestring (merge-pathnames (make-pathname :type "html") path)))))) ;;; Parse darcs xml changelog ;;; structure ;; (changelog ;; (patch ;; :author :date :local_date ;; (name PATCH-NAME) ;; (comment PATCH-COMMENT) ;; (summary ;; (add_file FILE-NAME) ;; (modify_file FILE-NAME ;; (removed_lines :num) ;; (added_lines :num))))) (defun darcs-changes->stp (stream) (cxml:parse-stream stream (cxml:make-whitespace-normalizer (stp:make-builder)))) (defun find-child-named (child-name parent-node) (stp:find-child-if (lambda (node) (and (typep node 'stp:element) (string= (stp:local-name node) child-name))) parent-node)) (defun filter-children-by-name (child-name parent-node) (stp:filter-children (lambda (node) (and (typep node 'stp:element) (string= (stp:local-name node) child-name))) parent-node)) (defun darcs-stp->parsed-list (document) ;; What must be done: load darcs changes xml, iterate over patches, ;; generate a simpler structure storing (NAME ID DATE COMMENT CHANGES) ;; where COMMENT may be nil and CHANGES is another list of sublists ;; ((ADDED ...) (CHANGED ...)). Deletions may be ignored for now. (map 'list (lambda (patch) (list (stp:string-value (find-child-named "name" patch)) (stp:attribute-value patch "date") (stp:attribute-value patch "hash") (when-bind comment (find-child-named "comment" patch) (let ((raw-comment (stp:string-value comment))) (if (and (> (length raw-comment) 12) (string= "Ignore-this:" raw-comment :end2 12)) (subseq raw-comment (or (position #\newline raw-comment) (length raw-comment))) raw-comment))) (let ((summary (find-child-named "summary" patch))) (list (cons :added (map 'list (compose (curry #'string-trim '(#\space #\newline)) #'stp:string-value) (filter-children-by-name "add_file" summary))) (cons :changed (map 'list (compose (curry #'string-trim '(#\space #\newline)) #'stp:string-value) (filter-children-by-name "modify_file" summary))))))) (filter-children-by-name "patch" (stp:first-child document)))) ;;; Parsed changelog accessors (defun patch-name (patch) (first patch)) (defun patch-date (patch) (second patch)) (defun patch-hash (patch) (third patch)) (defun patch-comment (patch) (fourth patch)) (defun patch-added-files (patch) (cdr (first (fifth patch)))) (defun patch-changed-files (patch) (cdr (second (fifth patch)))) ;;; Feed generation (defun muse-path->html-url (potential-muse-path) ;; When generating the RSS only *.muse files should have links and ;; these should be translated to the corresponding html (when-bind basename (or (arnesi:aand (ppcre:register-groups-bind (basename) (*muse-file-scanner* potential-muse-path) basename) (format nil "~A.html" arnesi:it)) (if-bind sf (car (member potential-muse-path *special-files* :key (compose #'namestring #'special-file-path) :test #'pathname-match-p)) (funcall (special-file-conversion sf) potential-muse-path))) (format nil "http://unknownlamer.org/muse/~A" (escape-as-uri basename)))) (defun darcs-time->local-time (timestring) ;; YYYYMMDDHHMMSS UTC (local-time:universal-to-timestamp (encode-universal-time (parse-integer timestring :start 12 :end 14) (parse-integer timestring :start 10 :end 12) (parse-integer timestring :start 8 :end 10) (parse-integer timestring :start 6 :end 8) (parse-integer timestring :start 4 :end 6) (parse-integer timestring :start 0 :end 4) 0))) (defun darcs-time->pubdate (darcs-time) ;; this seems to be correct but at least liferea is taking my time ;; and substracting the tz offset from it ... what the fuck (let ((local-time (darcs-time->local-time darcs-time))) (local-time:format-timestring nil local-time :format '(:short-weekday ", " (:day 2) #\space :short-month #\space (:year 4) #\space (:hour 2) #\: (:min 2) #\: (:sec 2) #\space :timezone)))) (defun darcs-hash->guid (hash) (format nil "http://unknownlamer.org/darcsweb/browse?r=unknownlamer.org;a=commit;h=~A" hash)) (defun file-link (file) (with-tag ("li") (with-tag ("p") (if-bind muse-url (muse-path->html-url file) (simple-tag "a" file `(("href" ,muse-url))) (xml-out file))))) (defun generate-entry-html (patch) (with-output-to-string (string-stream) ;; EVIL, but ... I don't feel like modifying the xml-emitter lib (let ((xml-emitter::*xml-output-stream* string-stream)) (when-bind comment (patch-comment patch) (with-tag ("p") (xml-as-is (reduce (lambda (coll next) (concatenate 'string coll "
" next)) (split-sequence #\newline (escape-as-html comment)))))) (when-bind added-files (patch-added-files patch) (simple-tag "h2" "New Files") (with-tag ("ul") (dolist (file added-files) (file-link file)))) (when-bind changed-files (patch-changed-files patch) (simple-tag "h2" "Modified Files") (with-tag ("ul") (dolist (file changed-files) (file-link file))))))) (defun generate-feed (entries stream) (with-rss2 (stream :encoding "UTF-8") (rss-channel-header "The Home of Your Friendly Neighborhood Terrorist" "http://unknownlamer.org" :description "Updates to Clinton Ebadi's personal website") (dolist (entry entries) (rss-item (patch-name entry) :description (generate-entry-html entry) :guid (darcs-hash->guid (patch-hash entry)) ; fix guid :pubdate (darcs-time->pubdate (patch-date entry)))))) ;;; Call darcs (defun darcs-changelog-stream () (let ((files (append (directory (merge-pathnames (make-pathname :type "muse" :name :wild) *repo-path*)) (alexandria:mappend (lambda (special-file) (directory (merge-pathnames (special-file-path special-file) *repo-path*))) *special-files*)))) #+nil(break "files = ~A" files) (sb-ext:process-output (sb-ext:run-program "darcs" `("changes" "--xml" "--summary" ,(format nil "--repodir=~A" *repo-path*) "--only-to-files" ,@(mapcar #'namestring files)) :search t :output :stream :wait nil)))) ;;; Public Interface (defun firstn (n list) ;; yeah yeah really shitty whatever (loop for i from 0 to n collect (nth i list))) (defun stream->feed (input-stream output-stream) (generate-feed (firstn 15 (darcs-stp->parsed-list (darcs-changes->stp input-stream))) output-stream)) (defun darcs->feed () (with-open-file (rss-out *rss-path* :direction :output :if-exists :supersede :if-does-not-exist :create) (stream->feed (darcs-changelog-stream) rss-out))) (defun run () (darcs->feed) (sb-ext:quit))