まったく書いてないわけでもないんだけど

PCLの最初のあれを参考にLivedoor Clipのエクスポートファイルをdelicious形式に変換するコードを書いたりしたのだけど、ほぼ使い捨て。そしてxyzzy専用。

(require 'xml-parser-modoki)

(defmacro get-tagname (el)
  `(car ,el))

(defmacro get-attributes (el)
  `(cadr ,el))

(defmacro get-children (el)
  `(cddr ,el))

(defmacro get-contents (el)
  `(caddr ,el))

(defun has-children? (el)
  (consp (get-contents el)))

(defun get-attribute (el attrname)
  (cdr (assoc (get-attributes el) attrname :test #'equal)))

(defun get-elements (root selector &optional recursive?)
  (let (result)
    (labels
        ((collect (node)
           (when (funcall selector node)
             (push node result))
           (when (and recursive?
                      (has-children? node))
             (mapc #'collect (get-children node)))))
      (collect root))
    result))

(defun bytag (tagname)
  #'(lambda (el)
      (string= tagname (get-tagname el))))

(defun byattr (name val)
  #'(lambda (el)
      (string= val (get-attribute el name))))

(defun ldc-item-to-record (item)
  (nconc
   (mapcan #'list
           '(:title :url :comment :date)
           (mapcar #'(lambda (tag)
                       (get-contents (car (get-elements item (bytag tag) t))))
                   '("title" "link" "description" "pubDate")))
   (list :tag
         (mapcar #'(lambda (el) (get-contents el))
                 (get-elements item (bytag "dc:subject") t)))))

(defun dump-ldc (fn)
  (mapcar #'ldc-item-to-record
          (get-elements (car (xmlpm-parse-file fn))
                        (bytag "item") t)))

(defun to-bm (al)
  (let ((url (getf al :url))
        (date (parse-date (getf al :date)))
        (tags (getf al :tag))
        (title (esc (getf al :title)))
        (comment (getf al :comment)))
    (concat
     (format nil "<DT><A href=\"~A\" LAST_VISIT=\"~A\" ADD_DATE=\"~A\" TAGS=\"~{~A~^,~}\">~A</A>"
             url date date tags title)
     (if comment (format nil "<DD>~A~%" (esc comment)) ""))))

(defun ldc-to-delicious (clipfn delfn)
  (with-open-file (s delfn :direction :output)
    (format s "<!DOCTYPE NETSCAPE-Bookmark-file-1>
<META HTTP-EQUIV=\"Content-Type\" CONTENT=\"text/html; charset=UTF-8\">
<TITLE>Bookmarks</TITLE>
<H1>Bookmarks</H1>
<DL><p>
~{~A~%~}
</DL><p>
"          (mapcar #'to-bm (dump-ldc clipfn)))))

(defun esc (str)
  (let ((result (or str "")))
    (mapc #'(lambda (c)
              (setf result (substitute-string result (cdr c) (car c))))
          *xmlpm-special-chars-alist*)
    result))

(defun unesc (str)
  (let ((result (or str "")))
    (mapc #'(lambda (c)
              (setf result (substitute-string result (car c) (cdr c))))
          *xmlpm-special-chars-alist*)
    result))

(let ((utc0 (encode-universal-time 0 0 0 1 1 1970 0)))
  (defun ut2utc (ut)
    (- ut utc0))

  (defun utc2ut (utc)
    (+ utc utc0)))

(defun encode-utc (&rest params)
  (ut2utc (apply #'encode-universal-time params)))

(let* ((mon '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))
       (monfmt (format nil "\\(~{~A~^\\|~}\\)" mon)))
  (defun parse-date (datestr)
    (let ((dmy (cond
               ((string-match "\\([0-9]\\{4\\}\\)[ /\\-]\\([0-9]+\\)[ /\\-]\\([0-9]+\\)" datestr)
                (mapcar #'(lambda (n) (parse-integer (match-string n))) '(3 2 1)))
               ((string-match (concat monfmt "[ /\\-]\\([0-9]+\\)[ /\\-]\\([0-9]\\{4\\}\\)") datestr)
                (list (parse-integer (match-string 2))
                      (1+ (position (match-string 1) mon :test #'equal))
                      (parse-integer (match-string 3))))
               ((string-match (concat "\\([0-9]+\\)[ /\\-]" monfmt "[ /\\-]\\([0-9]\\{4\\}\\)") datestr)
                (list (parse-integer (match-string 1))
                      (1+ (position (match-string 2) mon :test #'equal))
                      (parse-integer (match-string 3))))
                (t '(1 1 1970))))
          (hms (if (string-match "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)" datestr)
                   (mapcar #'(lambda (n) (parse-integer (match-string n))) '(3 2 1))
                   '(0 0 0)))
          (gmt (if (string-match "\\([+\\-][0-9]+\\)" datestr)
                   (let ((d (parse-integer (match-string 1))))
                     (if (< 12 (abs d))
                         (multiple-value-bind (q r) (floor d 100) (+ q (/ r 60)))
                         d))
                   9)))
      (apply #'encode-utc (append hms dmy `(,(- gmt))))))
  )

日付の解析がひどい事に。お決まりのライブラリとかないかな。
これも試してみようと思いつつ、特にいじりたいXMLデータがないのでまだ試していない。