切れたリンクを見つける - lisp-cookbook-ja/common-lisp GitHub Wiki

Webオートメーション ライブラリ closure-html drakma puri

切れたリンクを見つける

CLiki:DRAKMAのようなウェブクライアントには一通りの機能が揃っていますので、このようなクライアントとページからのリンクの切り出しを組み合わせて実現できるでしょう。

下記の例では、CLiki:DRAKMACLiki:closure-htmlCLiki:PURIを利用しています。

;; 素朴な実装
(defun churl (url &optional (out *standard-output*))
  (format out "~A:~%" url)
  (dolist (u (get-links url))
    (destructuring-bind (name link) u
      (declare (ignore name))
      (unless (search "mailto:" link)
        (let ((stat (http-request-stat
                     (drakma:http-request (puri:merge-uris link url)
                                          :method :head
                                          :force-binary T))))
          (format out "~2T~A: ~D~%" link stat))))))

(defmacro http-request-stat (req)
  `(nth-value 6 ,req))

(defun get-links (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)
                 (equal (stp:local-name a) "a"))
        (push (list (stp:string-value a)
                    (stp:attribute-value a "href"))
              ans)))
    ans))
;; 実行例
(churl "http://www.lisp.org/alu/home")

;-> http://www.lisp.org/alu/home:
;     http://www.franz.com/support/tech_corner/using-webactions.html:  OK
;     http://allegroserve.sourceforge.net: OK
;     http://www.lispworks.com/products/ilc-goodies.html: OK
;     http://www.international-lisp-conference.org/2007/:  OK
;     /alu/~19782bb4773d45b47701c907~/alu-contact:  OK
;     http://www.international-lisp-conference.org/:  OK
;     http://www.international-lisp-conference.org/:  OK
;     http://planet.lisp.org: OK
;     http://wiki.alu.org: Not Found
;     /alu/~19782bb4773d45b47701c907~/res-research:  OK
;     /alu/~19782bb4773d45b47701c907~/res-local:  OK
;     /alu/~19782bb4773d45b47701c907~/res-lisp:  OK
;     http://www.alu.org/mailman/listinfo:  OK
;     http://wiki.alu.org/: Not Found
;     /alu/~19782bb4773d45b47701c907~/conf-all:  OK
;     /alu/~19782bb4773d45b47701c907~/conf-lugm:  OK
;     http://www.international-lisp-conference.org/2002/:  OK
;     http://www.international-lisp-conference.org/2003/index.html:  OK
;     http://www.international-lisp-conference.org/2005/:  OK
;     http://www.international-lisp-conference.org/2007/:  OK
;     http://www.international-lisp-conference.org/2009/:  OK
;     /alu/~19782bb4773d45b47701c907~/alu-contact:  OK
;     /alu/~19782bb4773d45b47701c907~/alu-membership:  OK
;     /alu/~19782bb4773d45b47701c907~/alu-sponsors:  OK
;     /alu/~19782bb4773d45b47701c907~/alu-minutes:  OK
;     /alu/~19782bb4773d45b47701c907~/alu-board:  OK
;     /alu/~19782bb4773d45b47701c907~/alu-history:  OK
;     http://www.alu.org:  OK
;=> NIL

議論