日本のWebサイトから情報を取得

Common Lispにより、Webから特定の情報を取得する方法について考えます。

例えば、あるサイトから自分の住んでいる場所の天気だけを取得するような場合です。
私は日本語しかわからないので、当然日本のサイトを対象にします。
そうなるとエンコードの問題が出てきます。

本投稿では、下記のライブラリを用いてWebからの情報取得を行います。

CL-PPCRE
https://edicl.github.io/cl-ppcre/
Drakma
https://edicl.github.io/drakma/
CL-HTML-Parse
https://www.cliki.net/CL-HTML-Parse
Anaphora
https://common-lisp.net/project/anaphora/

自作のライブラリも使います。

strjis
https://github.com/nptcl/strjis
http://nptcl.hatenablog.com/entry/2019/06/13/024132
unmatch
http://nptcl.hatenablog.com/entry/2019/06/13/132538

処理系はsbclを用います。

方法は、htmlファイルをLispオブジェクトに変換してパターンマッチで検索するというものです。
日本語のサイトを対象とするので、エンコードの取り扱いを行わなければなりません。
まずはstrjisでどのように読み込むかを考えます。
そのあとunmatchで検索を行います。

htmlファイルの取得

URIからhttp経由で情報を取得する場合は、drakmaライブラリを使用します。
http-requestを行う時点でexternal-formatを指定できるのですが、 日本語のサイトの場合はhtmlファイルを読み込まないうちは、 一体どのエンコードで記載されているのかがわかりません。

仕方がないのでhttp-requestはbinaryデータを取得することにします。

(defparamter +uri+ "http://.../")
(drakma:http-request +uri+ :force-binary t)
-> #(...)

エンコードタイプは、htmlファイルの中に、

<meta http-equiv="content-type" content="text/html; charset=Shift_JIS">

のような形で記載されています。

【追記】下記の記載方法もあるそうです。

<meta charset="euc-jp">

このフォームの対応は最後にまとめて記載します。

しかし、データを取得する際にはまずエンコード問題を解決しなければなりません。 そこで、取得したbinaryデータを強制的にascii形式に変換することにします。

(setq x (drakma:http-request +uri+ :force-binary t))

(let ((strjis:*recovery-unicode* nil))
  (strjis:coerce-string x :input 'ascii :recovery t))
-> 文字列

変数*recovery-unicode*をnilに設定することで、 asciiコード以外の全て文字を削除することができます。
返却された文字列が正しいhtmlファイルだと仮定して、 cl-parse-htmlに読み込ませます。

(cl-html-parse:parse-html
  (let ((strjis:*recovery-unicode* nil))
    (strjis:coerce-string x :input 'ascii :recovery t)))
-> tree

返却値はhtmlの内容を表したtreeとなります。
ここから、contents-typeを取得する方法を考えます。

パターンマッチ

unmatchを使い、tree構造から特定の内容を検索する機能を追加します。

(defun first-match-list (match body)
  (when (consp body)
    (multiple-value-bind (a b) (funcall match body)
      (or a (if b a
              (or (first-match-list match (car body))
                  (first-match-list match (cdr body))))))))

(defun list-match-list (match body)
  (let (ret)
    (labels ((rec (x) (when (consp x)
                        (multiple-value-bind (a b) (funcall match x)
                          (when (or a b)
                            (push a ret)))
                        (rec (car x))
                        (rec (cdr x)))))
      (rec body))
    (nreverse ret)))

(defun call-match-pattern (proc match data body)
  (let ((g (gensym)))
    `(,proc
       (lambda (,g) (unmatch:ifmatch ,match ,g (progn ,@body)))
       ,data)))

(defmacro first-match (match data &body body)
  (call-match-pattern 'first-match-list match data body))

(defmacro list-match (match data &body body)
  (call-match-pattern 'list-match-list match data body))

マクロfirst-matchとlist-matchはどちらもifmatchと似ていますが、 パターンマッチの対象をtreeとみなして遡って検索していくことが違います。
マクロfirst-matchは、最初にマッチしたものを処理して返却します。
マクロlist-matchは、マッチしたすべてのものを処理してリストとして返却します。

contents-typeを取得する場合は次のようになります。

(defun meta-content-charset (html)
  (first-match (:meta :http-equiv ?x :content ?y) html
    (when (equalp ?x "content-type")
      ?y)))

cl-html-parseの内容を変数treeとしたとき、 実行結果は例えば次のようになります。

(meta-content-charset tree)
-> "text/html; charset=Shift_JIS"

このように、cl-html-parseとunmatchを組み合わせることで、 特定の情報を抽出することができます。

エンコード情報の取得

htmlファイルのbinaryデータから、エンコードタイプを取得するコードを下記に示します。

(defparameter +guess-html-charset-string+
  (cl-ppcre:create-scanner "^.+(?i)charset(?-i)\\s*=\\s*\\\"?(\\S+)\\\"?\\s*$"))
(defun guess-html-charset-string (html)
  (awhen (meta-content-charset html)
    (multiple-value-bind (str group)
      (cl-ppcre:scan-to-strings +guess-html-charset-string+ it)
      (when str
        (elt group 0)))))

(defun guess-html-encoding-string (str)
  (string-upcase
    (remove-if-not #'alphanumericp str)))

(defun guess-html-encoding-windows (str)
  (and (<= 3 (length str))
       (string= (subseq str 0 3) "WIN")))

(defun guess-html-encoding-html (html)
  (awhen (guess-html-charset-string html)
    (let ((str (guess-html-encoding-string it)))
      (cond ((string= str "UTF8") :utf8)
            ((string= str "ASCII") :utf8)
            ((string= str "JIS") :jis)
            ((string= str "ISO2022JP") :jis)
            ((string= str "EUC") :eucjis)
            ((string= str "EUCJP") :eucjis)
            ((string= str "EUCJIS") :eucjis)
            ((string= str "SHIFTJIS") :shiftjis)
            ((string= str "SJIS") :shiftjis)
            ((string= str "CP932") :shiftjis)
            ((string= str "MS932") :shiftjis)
            ((guess-html-encoding-windows str) :shiftjis)))))

(defun guess-html-encoding (x)
  (guess-html-encoding-html
    (cl-html-parse:parse-html
      (let ((strjis:*recovery-unicode* nil))
        (strjis:coerce-string x :input 'ascii :recovery t)))))

使用例を示します。

(setq x (drakma:http-request +uri+ :force-binary t))

(guess-html-encoding x)
-> :SHIFTJIS

htmlファイルの内容取得

エンコードさえ取得できればあとは簡単です。

(defun fetch (uri &key (guess :utf8))
  (let* ((x (drakma:http-request uri :force-binary t))
         (encode (or (guess-html-encoding x) guess)))
    (cl-html-parse:parse-html
      (strjis:coerce-string x :input encode))))

(fetch +uri+)
-> ((:!DOCTYPE ...) (:HTML ...))

エンコード情報の取得は万能ではなく失敗することもあるため、 引数:guessにてデフォルトのエンコードタイプを指定できるようにしています。

では、取得したhtmlからパターンマッチで検索していきます。

検索: 最初にマッチした情報を返却する

次の実行例を考えます。

(first-match ((:form :action _ :method ?x . _) . ?body) (fetch +uri+)
  (when (equalp ?x "post")
    ?body))
-> tree

マッチする内容は、例えば次のようなhtml構文の内容です。

<form action="call.cgi" method="POST" id="callid">
[ここの内容が返却されます]
</form>

first-matchは先頭から検索をしていき、最初にヒットした内容がbody句で処理されます。 パターンマッチの候補が複数あった場合でも、最初の内容だけが対象となります。

検索: マッチした情報を集めてリストで返却

次の実行例を考えます。

(list-match (:a :href ?x . _) (fetch +uri+)
  ?x)
-> list

マッチする内容は、例えば次のようなhtml構文を寄せ集めたリストです。

<a href="ここの内容が返却されます">

例えば下記のようになります。

("/inex.html" "/path/to/" "http://.../")

検索: 最初にマッチした内容から、別の検索で情報を集める

上記二例の複合です。

(first-match ((:form :action _ :method ?x . _) . ?body) (fetch +uri+)
  (when (equalp ?x "post")
    (list-match (:a :href ?x . _) ?body
      ?x)))

最初にマッチした<form...>の内容から、<a href...>を集めてリストとして返却します。

最後に

これらの方法を使うことで、特定の情報を取得することもできますし、 FORMから必要なhidden情報を集めてPOSTしたりすることもできます。 drakmaはcookieに対応しているため、例えばログインを行ったりすることもできます。 作者はこの方法を使って自動化を行っていたことがありました。

ただし、実際にWebの自動化を行う場合は、 たぶん誰かがすでに作っているであろう専門のライブラリを使った方が楽かもしれません。

【追記】別のcharset記載について

charsetの記載方法は下記のフォームもあるそうです。

<meta charset="euc-jp">

対応したLispコードを下記に示します。

;;
;;  guess-html-encoding
;;
(defun guess-html-encoding-upcase (str)
  (string-upcase
    (remove-if-not #'alphanumericp str)))

(defun guess-html-encoding-windows (str)
  (and (<= 3 (length str))
       (string= (subseq str 0 3) "WIN")))

(defun guess-html-encoding-string (x)
  (let ((x (guess-html-encoding-upcase x)))
    (cond ((string= x "UTF8") :utf8)
          ((string= x "ASCII") :utf8)
          ((string= x "JIS") :jis)
          ((string= x "ISO2022JP") :jis)
          ((string= x "EUC") :eucjis)
          ((string= x "EUCJP") :eucjis)
          ((string= x "EUCJIS") :eucjis)
          ((string= x "SHIFTJIS") :shiftjis)
          ((string= x "SJIS") :shiftjis)
          ((string= x "CP932") :shiftjis)
          ((string= x "MS932") :shiftjis)
          ((guess-html-encoding-windows x) :shiftjis))))

(defun guess-html-encoding-charset1 (x)
  ;; <meta charset="euc-jp">
  (first-match (:meta :charset ?x . _) x
    (guess-html-encoding-string ?x)))

(defparameter +guess-html-encoding-charset2+
  (cl-ppcre:create-scanner "^.+(?i)charset(?-i)\\s*=\\s*\\\"?(\\S+)\\\"?\\s*$"))
(defun guess-html-encoding-charset2 (x)
  ;; <meta http-equiv="content-type" content="text/html; charset=Shift_JIS">
  (first-match (:meta :http-equiv ?x :content ?y) x
    (when (and (equalp ?x "content-type")
               (stringp ?y))
      (multiple-value-bind (str group)
        (cl-ppcre:scan-to-strings +guess-html-encoding-charset2+ ?y)
        (when str
          (guess-html-encoding-string
            (elt group 0)))))))

(defun guess-html-encoding-html (x)
  (cl-html-parse:parse-html
    (let ((strjis:*recovery-unicode* nil))
      (strjis:coerce-string x :input 'ascii :recovery t :size #x010000))))

(defun guess-html-encoding (x)
  (let ((x (guess-html-encoding-html x)))
    (or (guess-html-encoding-charset1 x)
        (guess-html-encoding-charset2 x))))


;;  fetch
(defun fetch (uri &key (guess :utf8))
  (let* ((x (drakma:http-request uri :force-binary t))
         (encode (or (guess-html-encoding x) guess)))
    (cl-html-parse:parse-html
      (strjis:coerce-string x :input encode :size #x010000))))