タイトル

隙があればlispを詰め込んで行きたい (3)

平成22年6月22日(火) 10時13分38秒

区分

LISP

報告者:

chiba

隙があればlispを詰め込んで行きたい日々ですが、今回はウェブ上のHTMLの内容確認の仕事です。
具体的には、h1、title、meta keywords、meta descriptionが記述されたCSV形式のファイルがあり、これの内容どおりになっているかをチェックする、という内容。
とりあえず、HTMLのタグの抜き出しには、Drakmaと、closure-htmlを使って、欲しいタグの内容を抜き出す関数を作成してみました。
|((:h1 ...) (:keywords ...) (:description ...) (:title ...))|という変な名前ですが、title keywords description h1を抜き出して返す関数名が思い付かなかったので返す結果の形をそのまま名前にしています。Common Lispは名前に記号も使えるので思考が停止したときに便利ですね。

(defun |((:h1 ...) (:keywords ...) (:description ...) (:title ...))| (url)
  (let* ((page (drakma:http-request url))
         (doc (chtml:parse page (cxml-stp:make-builder)))
         (ans () ))
    (stp:do-recursively (a doc)
      (when (and (typep a 'stp:element)
                 (or (string-equal (stp:local-name a) "title")
                     (string-equal (stp:local-name a) "meta")
                     (string-equal (stp:local-name a) "h1")))
        (let* ((kwd-or-dsc (cond ((string-equal (stp:attribute-value a "name")
                                                "description")
                                  `(:description
                                    ,(stp:attribute-value a "content")))
                                 ((string-equal (stp:attribute-value a "name")
                                                "keywords")
                                  `(:keywords
                                    ,(stp:attribute-value a "content")))))
               (tag (intern (string-upcase (stp:local-name a)) :keyword))
               (svalue (stp:string-value a))
               (tem () ))
          (cond ((and (string= "" svalue)
                      (eq :meta tag))
                 :nop)
                ('T (push svalue tem)
                    (push tag tem)))
          (when kwd-or-dsc
            (push (cadr kwd-or-dsc) tem)
            (push (car kwd-or-dsc) tem))
          (and tem (push tem ans))
          )))
    ans))

この|((:h1 ...) (:keywords ...) (:description ...) (:title ...))|を使って

(progn
  (print '////////////////////////////////////////////////////////////////)
  (dolist (x (fare-csv:read-csv-file "foo.csv"))
    (destructuring-bind (url title kwd dsc h1) x
      (let* ((url (ppcre:regex-replace "://www.example.com" ;CSVファイルのURL
                                       url
                                       "://www.example.net")) ;実際のサーバーのURL
             (q (|((:h1 ...) (:keywords ...) (:description ...) (:title ...))| url)))
        (flet ((*check (var key)
                 (string= var (second (assoc key q)))))
          (cond ((and (*check h1 :h1)
                      (*check kwd :keywords)
                      (*check dsc :description)
                      (*check title :title))
                 :nop)
                ('t
                 (flet ((frob (var key)
                          (list key
                                (if (*check var key)
                                    :ok
                                    (list :ng var (second (assoc key q)))))))
                   (print '*******************************************)
                   (print url)
                   (print (frob h1 :h1))
                   (print (frob kwd :keywords))
                   (print (frob dsc :description))
                   (print (frob title :title))))))))))

のように殴り書きしてみました。キーワードが一致していないと

////////////////////////////////////////////////////////////////
*******************************************
"http://www.example.com/foo/bar" 
(:H1 (:NG "こんにちは" "Routing Error")) 
(:KEYWORDS (:NG "なるほど" NIL)) 
(:DESCRIPTION (:NG "なんのことですか？" NIL)) 
(:TITLE (:NG "ｍｊｄ！" "Action Controller: Exception caught")) 
...

のような結果がREPLに出てきます。
なんだか長いですけど、Common Lispで書いても実行を確認しながら書けるので、そんなに大変でもありません。
■

トップページに戻る