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

区分
LISP
報告者

隙があれば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 "mjd!" "Action Controller: Exception caught")) 
...

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

トップページに戻る

技師部隊からの
お知らせ

【求人】エンジニア募集しています。

本頁の来客数
八十七万千百七十六名以上(計測停止中)

メンバー一覧

アクトインディ技師部隊員名簿

アクトインディ技師部元隊員

アクトインディへ

カテゴリー

アクトインディ

aaaa