cl-sanitize

Написал cl-sanitize - библиотеку для очистки HTML от нежелательного содержания. Точнее, не написал, а портирова Sanitize (Ruby). Хотя "портировал" тоже не совсем верное слово, ибо реализация алгоритма очистки тривиальна и его я написал сам (это просто быстрее, чем разбирать код на Ruby), но вот самое важное - конфигурационные данные и набор тестов взял из Sanitize.

cl-sanitize основана на cl-libxml2. Я сомневался некоторое время, что взять за основу cxml или cl-libxml2 (сомнения тем более оправданны, что cxml и cl-libxml2 плохо совместимы между собой из-за конфликта имён), но всё таки решил использовать cl-libxml2. Во-первых, оригинальная версия основанна на libxml2, так что это позволило легко получить идентичные результаты на тестах. Во-вторых, я не имею такого доверия к "Closure HTML", как к libxml2. А это очень важный момент, ибо после просмотра тестов мне стало немного страшно ходить в интерент.

В процессе пришлось немного допилить cl-libxml2 - как то мне сейчас несколько страшновато заглядывать внутрь, всё таки это был фактически мой первый серьёзный опыт использования CL, отрефракторить бы её основательно, да боюсь, что до этого руки у меня не скоро дойдут.

Ценителям поэзии

Есть в рунете замечательный сайт - www.stihi.ru, на котором помимо графоманов довольно много и интересных, хороших авторов. Если какой-то автор вам особенно понравился, то все его стихи выкачать и аккуратно сложить по папочкам (в соответствии с классификацией автора) можно с помощью такого кода на Common Lisp:

(defun load-poem (url dir &key verbose)
  (html:with-parse-html (page url :encoding "cp1251")
    (let* ((index (xpath:find-single-node page "/html/body/index"))
           (title (xpath:find-string index "h1")))
    (when verbose
      (format t "Load ~A (~A)~%" url title))
    (with-open-file (out (make-pathname :directory (pathname-directory dir)
                                        :name title
                                        :type "txt")
                         :direction :output :if-exists :supersede)
      (iter (for br in (xpath:find-list index "div[@class='text']/br"))
            (write-line (string-trim #(#\Newline)
                                     (xtree:text-content (xtree:prev-sibling br)))
                        out))))))
                 
(defun load-all-poems (url target &key verbose (recursive t))
  (ensure-directories-exist target)
  (html:with-parse-html (page url :encoding "cp1251")
    (iter (for node in (xpath:find-list page "//ul/li/a"))
          (load-poem (puri:merge-uris (puri:parse-uri (xtree:attribute-value node "href"))
                                      url)
                     target
                     :verbose verbose))
    (when recursive
      (iter (for node in (xpath:find-list page "//div[@id='bookheader']/a"))
            (let ((title (xtree:text-content node)))
              (when verbose
                (format t "~%Load book ~A~%" title))
              (load-from-stihiru (puri:merge-uris (puri:parse-uri (xtree:attribute-value node "href"))
                                                  url)
                                 (merge-pathnames (make-pathname :directory (list :relative title))
                                                  target)
                                 :recursive nil
                                 :verbose verbose))))))

Выделение содержательной части из html-страниц весьма тривиально и реализуется за счёт использования языка запросов XPath. Теперь скачать, например, все стихи моей жены можно таким вызовом:

(load-all-poems #U"http://www.stihi.ru/avtor/mari_mishon"
                #P"/var/kubart/poems/"

При написании данного кода я обнаружил, что libxml2 не может правильно определить кодировку страниц стихиры, так что пришлось несколько доработать cl-libxml2, добавив возможность явно указывать кодировку html-страниц.

cl-libxml2 в gentoo-lisp-overlay

cl-libxml2 теперь доступна пользователям Gentoo Linux через gentoo-lisp-overlay. Добиться этого оказалось чрезвычайно просто. Сначала я написал хозяину репозитория этого оверелея, но он предложил мне сделать заявку через Bugzilla, что я и сделал: зашёл на bugs.gentoo.org (я уже давно там зарегестрирован, как-то сообщал о проблеме с xalan-c) , выбрал действие "New-Ex", выбрал продукт "Gentoo Linux", в качестве компонента указал "Ebuilds", параметр "Severity" установил в "enhancement", в "Keywords" добавил "InOverlay", ввёл прочую информацию типа Url, Summary и Description, а в дополнительные подписчики ("CC") добавил common-lisp@gentoo.org (это, насколько я понимаю, существенно ускорило обработку), теперь "Commit" и следующим шагом приатачил ebuild-файл. Ну и появился в irc-канале #gentoo-lisp на FreeNode.

Может я правильно оформил заявку, а может там вообще ребята оперативные, но не прошло и двух часов, как Stelian Ionescu сообщил о том, что он добавил мои ebuild-файлы (их было два, для garbage-pools и cl-libxml2) в оверлей (а заодно и пропатчил мой Makefile для вспомогательной библиотеки).

cl-libxml2-0.3.1

Выпустил новую версию cl-libxml2. Ключевые изменения:

• Смена лицензии на Lisp LGPL
• Перемещение исходного кода на github (об это я уже писал)
• Добавление системы xfactory, которая позволяет достаточно просто генерить xml
• Ну и ещё несколько небольших изменений

Пример использования XFACTORY:

(xtree:with-object (doc (xfactory:with-document-factory 
                            ((XUL "http://www.mozilla.org/keymaster/gatekeeper/there.is.only.xul" "xul")
                             (SVG "http://www.w3.org/2000/svg" "svg"))
                          (xfactory:process-instruction "xml-stylesheet" "href=\"style.css\" type=\"text/css\"")
                          (XUL "window"
                               (xfactory:namespace "http://www.w3.org/1999/xlink" "xlink")
                               (XUL "vbox"
                                    (xfactory:attributes :flex 1
                                                         :width 500)
                                    (loop for i from 1 to 3
                                       do (XUL "label" 
                                               (xfactory:text "text ~A" i)))
                                    (SVG "svg"
                                         (xfactory:attributes :width "500px"
                                                              :height "500px")
                                         (SVG "a"
                                              (xfactory:attributes "xlink:href" "http://www.w3.org")
                                              (SVG "rect"
                                                   (xfactory:attributes :x 100
                                                                        :y 100
                                                                        :width 300
                                                                        :height 200
                                                                        :fill "red"))))))))
  (xtree:serialize doc *standard-output* :pretty-print t))
==>
<?xml version="1.0" encoding="utf-8"?>
<?xml-stylesheet href="style.css" type="text/css"?>
<xul:window xmlns:xul="http://www.mozilla.org/keymaster/gatekeeper/there.is.only.xul" xmlns:xlink="http://www.w3.org/1999/xlink">
<xul:vbox flex="1" width="500">
<xul:label>text 1</xul:label>
<xul:label>text 2</xul:label>
<xul:label>text 3</xul:label>
<svg:svg xmlns:svg="http://www.w3.org/2000/svg" width="500px" height="500px">
  <svg:a xlink:href="http://www.w3.org">
    <svg:rect x="100" y="100" width="300" height="200" fill="red"/>
  </svg:a>
</svg:svg>
</xul:vbox>
</xul:window> 

Исходный код cl-libxml2 теперь на github

В общем, окончательно принял решение переводить все свои открытые проекты на git. Поскольку Project Hosting on Google Code не поддерживает git (а mercurial я не хочу), то решил воспользоваться github. Подобный перевод требует некоторого времени, поэтому буду переходить поэтапно, первая "жертва" - cl-libxml2. Т.е. проект по прежнему будет жить на Project Hosting on Google Code, но исходный код на github. Посмотреть его (исходный код) сейчас можно здесь, а получить так:

git clone git://github.com/archimag/cl-libxml2.git

В принципе, svn я не выкидываю полностью, документация (хотя её сейчас и откровенно мало), как и раньше, будет публиковаться через неё (svn), сейчас её можно смотреть здесь

Документация к cl-libxml2

Решил немного улучшить ситуацию с документирование cl-libxml2. Встал вопрос: как документировать? Основное моё требование - возможность просматривать документацию on-line, без скачивания пакета. На хостинге проектов Google Code (где, собственно, и базируется cl-libxml2) для этих целей имеется в наличие wiki-движок, который меня, мягко говоря, не вдохновил. Доступа к другим ресурсам, на которых можно было бы опубликовать документацию, у меня нет. Немного поразмышляв, решил, что наилучший выход - воспользоваться возможностью http-доступа к репозиторию Subversion (который предоставляет Google Code). Т.е. можно просто добавить документацию в формате html к исходному коду, выставить для этих файлов свойство svn:mime-type в "text/html" и опубликовать ссылку на эти файлы. На мой взгляд, это очень удобная возможностью Subversion.

Но откуда возьмутся html-файлы? В принципе, для меня совершенно не проблема писать документацию сразу в виде xhtml (часто приходиться слышать о трудности редактирования xml, но я использую nxml-mode и считаю это исключительно лёгким занятием), но html не предоставляет вменяемых инструментов для "повторного использования" фрагментов разметки. Использование какой-либо системы публикации (типа Emacs Muse) меня тоже не прельщает: необходимо сначала изменить исходник документации, потом сгенерить html и наконец закомитить все изменённые файлы - слишком сложная для меня процедура :-), тем более, что я хотел бы обновлять документации гораздо чаще, чем делать релизы.

В итоге, решил остановиться на решении, которое мне представляется наиболее "концептуальным" для данного проекта: написании документации в виде xml-файлов, которым, посредством инструкции обработки <?xml-stylesheet type="text/xsl"..., сопоставленно xls-преобразование (предоставляющее механизмы повторного использования элементов разметки), преобразующее xml-данные в html-разметку. Это даёт возможность писать документацию в xml, который можно сразу, без дополнительной генерации html, просматривать в браузере. В итоге, в репозиторий кладутся xml-файлы и таблицы стилей xsl и css.

Что получилось можно посмотреть здесь.

cl-libxml2-0.3

Обновил версию cl-libxml2 до 0.3.

Основные изменения в этом релизе:

• Появилась обработка ошибок, генерируемых библиотекой libxslt.
• Появились функции для работы с html: неверифицирующий парсер и серилизация (ну и ещё пара мелочей)
• Исправлено некоторое количество ошибок.

К сожалению, в состав библиотеки пришлось включить немного, но всё же кода на C. Мера совершенно вынужденная и обязана функции xsltSetGenericErrorFunc, которая требует callback с сингатурой в стиле printf.

garbage-pools-0.1.1

Добавил в garbage-pools одну функцию: cancel-object-cleanup, которая позволяет отменить регистрацию ранее зарегистрированного в пуле объетка. Это приём в стиле C++ : вообще-то, удалять ресурс не собираемся, но в случае возникновения исключения он должен быть удалён, поэтому готовим его к удалению, а в после успешного прохождения опасной зоны спасаем и используем по назначению.

Поскольку успел заюзать эту функцию в cl-libxml2, то в связи с её новым релизом, пришлось строчо выпустить garbage-pools версии 0.1.1 (чуть не забыл это сделать).

cl-libxml2-0.2.5

Выпустил cl-libxml2 версии 0.2.5. В этой версии:

1. Появилась обработка ошибок: теперь все ошибки, генерируемые libxml2, транслируются в conditions или warnings (для нефатальных ошибок).
   
2. Кроме того, понаводил порядка в исходниках, что вылилось в достаточно заметное изменение их структуры.
   
3. В результате выполнения предыдущих двух пунктов вылезло на свет некоторое колличество багов, которые и были исправлены.
   

Как личное достижение могу отметить то, что на данный момент ознакомился с исходным кодом libxml2 процентов на 30% - документации по библиотеке, я бы сказал, не вполне вменяема, пока код не посмотришь - ничего толком не поймёшь. Так же обнаружил, что в некоторых местах html-документация "не совсем" соответствует комментариям в исходниках, что немного насторожило...

А тем временем, в gentoo-lisp-overlay появилась Xuriella XSLT, а ещё немного ранее уже был добавлен Plexippus XPath. Появись это хотя бы на полгода раньше, то вероятно начинать cl-libxml2 я бы не стал. Однако, теперь забрасывать этот проект не при каких обстоятельствах не собираюсь: полноценная поддержка xml критически важна для меня, а упомянутые проекты ещё сыроваты (им ведь в самом деле приходится писать реализация, а я только обёртку делаю для давно и хорошо известной библиотекой).

cl-libxml2 и exslt

Раздумываю над тем, чтобы реализовать exslt с помощью Common Lisp и cl-libxml2, ибо:

• это даст возможность отладить соответствующие возможности cl-libxml2
• libexslt не реализует многие полезные функции

Но, есть некоторые сомнения насчёт того, хватит ли мне желания/времени заниматься этим, ведь руки чешутся заняться некоторыми другими проектами, в частности, написать на CL подобие routes (что, в свою очередь, является Python-реализацией Rails routes system): а это последнее, что отделяет меня от непосредственной работы над сервером-приложений, который я уже несколько раз упоминал.

P.S. В последнее время решительно не хватает времени, из-за этого часто трачу его впустую, шарахаясь из стороны в сторону.

cl-libxml2-0.2.1

Выпустил небольшой релиз cl-libxml2-0.2.1, сделал страницу с примерами кода и все таки, наконец, завел отдельную страницу на cliki: http://www.cliki.net/cl-libxml2.

cl-libxml2-0.2

Сегодня выпустил cl-libxml2 версии 0.2

Основное внимание при разработке этого релиза было уделено возможностям расширения, это:

• Custom URL resolve


• XPath extension functions


• XSLT extension elements

Custom URL resolve

Позволяет подсовывать парсеру, когда он желает загрузить какие-то внешние данные, свои данные. Это может потребоваться для реализации какого-то нестандартного протокола, либо, например, для поддержки авторизации, ну да много для чего. Выглядит это примерно так:

CL-USER> (in-package #:libxml2.tree)
#<PACKAGE "LIBXML2.TREE">
TREE> (defun my-resolve-1 (url id ctxt)
      (declare (ignore url id))
      (resolve-string "<node />" ctxt))
MY-RESOLVE-1
TREE> (defun my-resolve-2 (url id ctxt)
      (declare (ignore id))
      (if (eql (puri:uri-scheme url) :my)
          (resolve-string (format nil "<node>~A</node>" url) ctxt)))

MY-RESOLVE-2
TREE> (with-custom-resolvers (#'my-resolve-2 #'my-resolve-1)
      (with-parse-document (doc "<root xmlns:xi=\"http://www.w3.org/2001/XInclude\">
  <xi:include href=\"my:doc\" />
  <xi:include href=\"my2:doc\" />
</root>")
        (process-xinclude doc)
        (serialize doc :to-string)))
"<?xml version=\"1.0\" encoding=\"utf-8\"?>
<root xmlns:xi=\"http://www.w3.org/2001/XInclude\">
  <node>my://doc</node>
  <node/>
</root>
"

XPath extension functions

XPath мощный инструмент, но часто встроенной функциональности не хватает. В таком случае можно добавить пару своих функций:

TREE> (in-package #:libxml2.xpath)
#<PACKAGE "LIBXML2.XPATH">
XPATH> (define-xpath-function hello-world ()
       "Hello world!")
HELLO-WORLD
XPATH> (define-xpath-function echo (msg)
       msg)
ECHO
XPATH> (define-xpath-function join (delimiter &rest strs)
       (iter (for str in strs)
             (reducing str
                       by (lambda (s x) (concatenate 'string s delimiter x)))))
JOIN
XPATH> (with-xpath-functions ((hello-world "hello-world")
                            (echo "echo")
                            (join "join"))
       (with-parse-document (doc "<root />")
         (find-string doc "join('//', hello-world(), '---', echo('Buy!'))")))

"Hello world!//---//Buy!"

XSLT extension elements

Я очень люблю писать на XSLT, совершенно удивительный инструмент, однако и здесь набор имеющихся средств далеко не полон. Не беда, дописать необходимые элементы можно и самому. Например, встроенную функцию copy-of можно реализовать так:

XPATH> (in-package #:libxml2.xslt)
#<PACKAGE "LIBXML2.XSLT">
XSLT> (define-xslt-element copy-of (self input output)
      (iter (for node in-xpath-result (attribute-value self "select")  on input)
            (append-child output (copy node))))

COPY-OF
XSLT> (with-xslt-elements ((copy-of "copy-of" "www.sample.org"))
      (with-stylesheet (style "<?xml version=\"1.0\"?>
<xsl:stylesheet xmlns:xsl=\"http://www.w3.org/1999/XSL/Transform\" xmlns:my=\"www.sample.org\"  extension-element-prefixes=\"my\" version=\"1.0\">
  <xsl:template match=\"/root\">
      <result><my:copy-of select=\"node()[@attr]\" /></result>
  </xsl:template>
</xsl:stylesheet>")
        (with-parse-document (doc "<root><a attr=\"1\"/><b /><c attr=\"2\"/><d /></root>")
          (with-transfom-result (res (style doc))
            (serialize res :to-string)))))

"<?xml version=\"1.0\" encoding=\"utf-8\"?>
<result>
<a attr="1"/>
<c attr="2"/>
</result>

Резюме

Кстати, "custom URL resolving" и "XPath extension functions" работают и внутри XSLT.
Когда-то меня впечатлили соответствующие возможности библиотеки lxml: оказалось что реализовать сопоставимый функционал не так уж и сложно :-)

Lisp Logo

Довольно случайно наткнулся на забавный Lisp Logo. Выглядит это так (на самом деле там несколько вариантов):



Такая картинка показалась мне гораздо интереснее, чем унылый



Посему, оное "страшное" предупреждение и было добавлено на главную страницу cl-libxml2 :-)