簡易外部リンククローラ
あるサイトからの外部リンク一覧を取得する簡単なクローラ(もどき)をsbclで作成。
;;;; sbcl-1.0.37 (require :puri) ; ver1.5.1 (require :drakma) ; ver1.0.0: HTTPクライアント (require :cl-ppcre) ; ver2.0.1: 正規表現 (require :sb-queue) ; A thread-safe lockless FIFO queues ;; 引数のURLをクロールし、内部リンクと外部リンクを集める ;; => (values 内部リンクのURIリスト ;; 外部リンクのURIリスト ;; (or nil 関数内部でエラーが発生した場合は、そのエラー(コンディション)オブジェクト)) (defun per-crawl (root &key (timeout 10)) (handler-case (let ((root-uri (puri:parse-uri root)) (internal-links) (external-links)) (cl-ppcre:do-register-groups (link) ("<a[^>]*\\shref\\s*=\\s*['\"]([^'\"]+)" ; URLを集める (sb-ext:with-timeout timeout (drakma:http-request root-uri))) ; 時間制限付きでHTMLを取得する (let ((link-uri (puri:merge-uris link root-uri))) (if (string= (puri:uri-host root-uri) (puri:uri-host link-uri)) (push link-uri internal-links) ; ホスト名が等しいなら、内部リンクと判断 (push link-uri external-links)))) (values (delete-duplicates internal-links :test #'puri:uri=) ; 重複は除去 (delete-duplicates external-links :test #'puri:uri=) ; 重複は除去 nil)) ((or error timeout) (c) (values nil nil c)))) ;;;;;; ;;; 例 > (per-crawl "http://www.sbcl.org/") ;; 内部リンク --> (#<PURI:URI http://www.sbcl.org/news.html#1.0.38> #<PURI:URI http://www.sbcl.org> #<PURI:URI http://www.sbcl.org/links.html> #<PURI:URI http://www.sbcl.org/manual/> #<PURI:URI http://www.sbcl.org/porting.html> #<PURI:URI http://www.sbcl.org/history.html> #<PURI:URI http://www.sbcl.org/getting.html> #<PURI:URI http://www.sbcl.org/keys.html> #<PURI:URI http://www.sbcl.org/platform-table.html> #<PURI:URI http://www.sbcl.org/news.html> #<PURI:URI http://www.sbcl.org/index.html>) ;; 外部リンク (#<PURI:URI https://lists.sourceforge.net/lists/listinfo/sbcl-bugs> #<PURI:URI http://downloads.sourceforge.net/project/sbcl/sbcl/1.0.38/sbcl-1.0.38-source.tar.bz2> #<PURI:URI http://sourceforge.net> #<PURI:URI https://bugs.launchpad.net/sbcl> #<PURI:URI http://www.sourceforge.net/projects/sbcl/>) ;; エラーなし NIL) > (per-crawl "http://www.sbcl.org/" :timeout 0.1) --> NIL NIL #<TIMEOUT {B5C5C31}> ; タイムアウト
;; URIオブジェクトから、(ハッシュの)キーとなる文字列を作成する ;; - パス + パラメータを使う (defun uri-key (uri) (format nil "~:[/~;~:*~A~]~@[?~A~]" (puri:uri-path uri) (puri:uri-query uri))) > (uri-key (puri:parse-uri "http://www.sbcl.org/news.html#1.0.38")) --> "/news.html" > (uri-key (puri:parse-uri "http://www.sbcl.org/news.html?a=b#1.0.38")) --> "/news.html?a=b"
;; 外部リンククロール ;; - root-url: クロールを開始するURL。start-urlの方が適切かも。 ;; - thread-count: 同時にHTTPリクエストを行うスレッドの数 ;; - crawl-page-limit: クロール対象となるページ数(URL)の上限 (defun crawl-external-link (root-url &key (thread-count 5) (crawl-page-limit 100)) (let ((smp (sb-thread:make-semaphore :count 1)) (uri-que (sb-queue:make-queue :initial-contents `(,(puri:parse-uri root-url)))) ; クロール対象となるURIを保持するキュー (crawled-uris (make-hash-table :test #'equal :synchronized t)) ; 重複クロールチェック (external-link-uris (sb-queue:make-queue))) ; 外部リンク (setf (gethash (uri-key (puri:parse-uri root-url)) crawled-uris) t) (labels ((per-crawl-with-filter (uri) (multiple-value-bind (internals externals) (per-crawl uri :timeout 5) (values (sb-ext:with-locked-hash-table (crawled-uris) ;; 内部リンクから、既にクロール済みのもの及び、上限を越えているものを除外する (delete-if (lambda (uri) (or (>= (hash-table-count crawled-uris) crawl-page-limit) #1=(gethash (uri-key uri) crawled-uris) (progn (setf #1# t) nil))) ; 重複フラグを付ける internals)) externals))) ;; クロール(スレッド)用関数 ;; - 全スレッドに共通のURIキュー(uri-que)から、クロール対象のURIを取得しクロールを行う ;; - 作業中のスレッドが存在せず、かつURIキューが空の場合は処理を終了する (crawl-fn () (loop FOR uri = (progn (sb-thread:wait-on-semaphore smp) ; キューからURIを取得 (sb-queue:dequeue uri-que)) UNTIL (null uri) ; キューが空なら終了 DO (multiple-value-bind (internals externals) (per-crawl-with-filter uri) (dolist (uri externals) (sb-queue:enqueue uri external-link-uris)) ; ページ内の外部リンクを追加 (dolist (uri internals) (sb-queue:enqueue uri uri-que)) ; ページ内の内部リンクを追加 (if (zerop (length internals)) (when (= (1- thread-count) (sb-thread::semaphore-waitcount smp)) (sb-thread:signal-semaphore smp thread-count)) ; 全てのクロールが終了したので、キューが空の状態で待機スレッドを起こす (sb-thread:signal-semaphore smp (length internals))))))) ; 追加された内部リンクの数だけ、セマフォのカウンタを増やす (loop REPEAT thread-count COLLECT (sb-thread:make-thread #'crawl-fn) INTO threads ; クロール用スレッドの作成 FINALLY (mapc #'sb-thread:join-thread threads))) ; join (delete-duplicates (sb-queue:list-queue-contents external-link-uris) :test #'puri:uri=))) ; 重複を除去して、集めた外部リンクのリストを返す ;;;;;; ;;; 例 > (crawl-external-link "http://www.sbcl.org/" :crawl-page-limit 3) --> (#<PURI:URI https://lists.sourceforge.net/lists/listinfo/sbcl-bugs> #<PURI:URI http://downloads.sourceforge.net/project/sbcl/sbcl/1.0.38/sbcl-1.0.38-source.tar.bz2> #<PURI:URI http://www.lispworks.com/reference/HyperSpec/> #<PURI:URI http://planet.lisp.org> #<PURI:URI http://www.cliki.net> #<PURI:URI http://sbcl.boinkor.net/bench/> #<PURI:URI http://planet.sbcl.org> #<PURI:URI http://sbcl-internals.cliki.net> #<PURI:URI http://sourceforge.net/projects/sbcl> #<PURI:URI https://bugs.launchpad.net/sbcl/+bug/542174> #<PURI:URI https://bugs.launchpad.net/sbcl/+bug/458354> ;; ... 略 ... #<PURI:URI https://bugs.launchpad.net/sbcl/+bug/540413> #<PURI:URI https://bugs.launchpad.net/sbcl/+bug/547095> #<PURI:URI http://sourceforge.net/project/showfiles.php?group_id=1373> #<PURI:URI http://sourceforge.net> #<PURI:URI https://bugs.launchpad.net/sbcl> #<PURI:URI http://www.sourceforge.net/projects/sbcl/>)
これ単独だとあまり有用ではないけど、別の何か似たようなことをしたい場合の雛形としては使えるのではないかと思う。
ただ、これまであまり使ったことがないパッケージを多用しているので、ちゃんと動いてくれるかが少し不安。
