タイムアウトつき url-retrieve-synchronously
SKK の ML に書いた内容をブログにもメモしときます。
url-retrieve-synchronously は同期的に HTTP で指定した URL にアクセスすることができますが、相手サイトが重いと反応が中々返ってこず、Emacs が固まってしまいます。
その問題を解決するために、タイムアウトつきの url-retrieve-synchronously を作ってみました。
単純に run-with-timer で url-retrieve のプロセスを監視するタイマを作り、タイマが励起されると url-retrieve のプロセスが殺される仕組みです。
タイマウトは、デフォルトで2秒で発生します。
(require 'url-http) (defun my-url-retrieve-with-timeout (url coding-system &optional timeout-interval) (let ((url-max-redirections 0) ; URL リダイレクトを抑制する ;; `url-retrieve' のためのコールバック関数 (url-callback #'(lambda (status coding) (let (p) (setq done t) (when (setq p (url-http-symbol-value-in-buffer 'url-http-end-of-headers (current-buffer))) (setq jsonp (decode-coding-string (buffer-substring (1+ p) (point-max)) coding)))))) ;; タイムアウト発生時に呼ばれるコールバック関数 (timeout-callback #'(lambda () ;; `url-retrieve' のプロセスを止める (when (processp proc) (delete-process proc)) ;; `url-retrieve' は終わったものと見做す (unless done (setq done t)))) ;; タイムアウト時間 (timeout-interval (if timeout-interval timeout-interval 2)) (done nil) buf proc jsonp timeout) (unwind-protect ;; condition-case を用いて全てのエラーを捕捉する。ここで、捕捉した ;; エラーは無視する。開発、デバッグ時には condition-case のブロック ;; を外す。 (condition-case e (when (setq buf (url-retrieve url url-callback (list coding-system))) (setq proc (get-buffer-process buf) ;; タイムアウト監視用の timer を設定する timeout (run-with-timer timeout-interval timeout-interval timeout-callback)) ;; `url-retrieve' は非同期なので、同期的に結果を得られるよ ;; うに待ち合わせる。ここでは、 ;; `url-retrieve-synchronously' が行っていることとほぼ同等 ;; のことをしている。本関数では、URL リダイクレトはしない ;; (はず)なので、URL リダイレクトに対する対策の部分のみ削除 ;; してある。 (while (null done) (when (and proc (memq (process-status proc) '(closed exit signal failed)) (eq proc (or (get-buffer-process buf) proc))) (delete-process proc) (setq done t)) (unless (or (with-local-quit (accept-process-output proc)) (null proc)) (when quit-flag (delete-process proc)) (setq proc (and (not quit-flag) (get-buffer-process buf)))))) (error ;; 全てのエラーは無視する nil)) (when (bufferp buf) (kill-buffer buf)) ;; タイムアウト用の timer を削除する (when timeout (cancel-timer timeout) ;; 一応、初期化をしておく (setq timeout nil))) jsonp))
利用例としては、social ime 相手に使うと以下のような感じです。
もし、2秒以内に social ime から応答が無ければ、my-url-retrieve-with-timeout は nil を返します。
(let ((url (concat "http://www.social-ime.com/api/" "?string=" (url-hexify-string (encode-coding-string "あ" 'utf-8)))) res) (when (setq res (my-url-retrieve-with-timeout url 'euc-jp)) (split-string (substring res 0 (1- (length res))) "\t" t))) ;; => ("亜" "唖" "娃" "阿" "蛙" "吾" "亞" "呀" "堊" "婀" "椏" "痾" "錏" "鐚" "閼" "鴉" "あ" "ア")
timeout の間隔を短くする場合、my-url-retrieve-with-timeout の第3引数に数値を指定します。
少数でもオッケーです。
(my-url-retrieve-with-timeout url 'euc-jp 0.5)
もっと上手いやり方があるだろうなーとか思いながら、そんなこんなで。
更新時刻
- 2011/11/12 23:20