Common Lisp から OAuth で Twitter

cl-twitter で OAuth がよく分からなかったので cl-twitter は使わずに cl-oauth を直でやってみたら簡単にできました。というお話です。

(eval-when (:compile-toplevel :load-toplevel :execute)
  (require :series)
  (require :cl-oauth)
  (require :drakma)
  (require :cl-json)
  (require :quek))

;; 対 drakma 用おまじない
(setf drakma:*drakma-default-external-format* :utf-8)
(pushnew '("application" . "json") drakma:*text-content-types* :test #'equal)

(defpackage :repl-twitter-client
  (:use :cl :series :quek)
  (:shadowing-import-from :series let let* multiple-value-bind funcall defun)
  (:export #:home-timeline
           #:tweet))

(in-package :repl-twitter-client)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (series::install :pkg :repl-twitter-client :implicit-map t))


(defun query-message ()
  (string-right-trim
   #(#\Space #\Cr #\Lf #\Tab)
   (with-output-to-string (out)
     (loop for line = (read-line *terminal-io*)
           until (string= "." line)
           if (string= "\\q" line)
             do (return-from query-message nil)
           do (write-line line out)))))

(macrolet ((m ()
             (let ((sec (collect-first (scan-file "~/.twitter-oauth.lisp"))))
               `(defparameter *access-token*
                  (oauth:make-access-token :consumer (oauth:make-consumer-token
                                                      :key ,(getf sec :consumer-key)
                                                      :secret ,(getf sec :consumer-secret))
                                           :key ,(getf sec :access-key)
                                           :secret ,(getf sec :access-secret))))))
  (m))

(defun home-timeline ()
  (json:decode-json-from-string
   (oauth:access-protected-resource
    "http://api.twitter.com/1/statuses/home_timeline.json"
    *access-token*)))

(defun tweet (&optional (message (query-message)))
  (when message
    (json:decode-json-from-string
     (oauth:access-protected-resource
      "http://api.twitter.com/1/statuses/update.json"
      *access-token*
      :request-method :post
      :user-parameters `(("status" . ,#"""#,message #'求職中"""))))))

~/.twitter-oauth.lisp に中身はこんな感じです。

(:consumer-key "xxxxxxxxxxxxxxxxxxxx"
 :consumer-secret "xxxxxxxxxxxxxxxxxxxx"
 :access-key "xxxxxxxxxxxxxxxxxxxx"
 :access-secret "xxxxxxxxxxxxxxxxxxxx")

CLSQL の select を使う時は :refresh と :caching に気をつける

そうしなと、毎回同じ結果が返って来て悲しくなります。

ちゃんとドキュメントを読んでなかったのが悪いだけです。

ちゃんとキャシュしてくれる、ということです。

Shibuya.lisp テクニカルトーク #6

土曜日に開催された Shibuya.lisp テクニカルトーク #6 に参加しました。

• ELIS の場合は市場そのものがなくなった。
• Lisp は便利です。
• Lisper は Lisper を信用する。
• 気分いいですねぇ。
• 大事なのはそれがユーザに解放されていること。
• 無政府主義的。

ごちゃ混ぜの単語だけで申し訳ない。

ブログでしか知らなかった人とお話できたのが嬉しかったな。ありがとうございました。

個人的な希望ですが dis らないでください。

ずっと停滞している Common Lisp の Web フレームワーク作り

何年も前から作りかけなんだよね。

継続使えるといろいろ楽だったりもするけど、ステートレスの方を選択したい。

@ で始まる変数でリクエストパラメータやセッション変数にアクセスできる。

• @foo リクエストパラメータ
• s@foo セッション変数
• c@foo クッキー

(setf s@foo "bar") みたいなこともしたい。

ビューは S 式だけど、(list (make-instance 'html :content (list (make-instance 'header ...) ...))) みたいなのに変換して User-Agent によって出力を変えるとかもしてみたい。

(defmacro with-default-template ((&key (title "ブログ")) &body body)
  `(html (:html
           (:head
            (:meta :charset "UTF-8")
            (:title ,title)
            (:script :type "text/javascript"
                     :src "http://ajax.googleapis.com/ajax/libs/jquery/1.4.4/jquery.min.js"))
           (:body
            (:div (get-universal-time))
            ,@body))))

(defaction index.html ()
  (with-default-template ()
    (:h1 "ブログ")
    (:a :href (path-for 'new-entry) "投稿")
    (collect (#M(^ html
                   (:h3 (:a :href (path-for 'entry :id (id _)) #"""#,(title _) <#,(id _)>"""))
                   (:div :class :content (content _)))
                (scan (clsql:select 'entry :flatp t :refresh t :order-by '(([created-at] :desc))))))))

(defaction new-entry (:route "entry/new")
  (with-default-template ()
    (:h1 "投稿")
    (:form :action (path-for 'create-entry) :method :post
           (:div "タイトル" (:text :name :title))
           (:textarea :name :content :rows 5 :cols 40)
           (:submit :value "投稿"))
    (:a :href (path-for 'index.html) "戻る")))

(defaction create-entry ()
  ;; TODO redirect で throw するので無駄に新しいトランザクションを作る
  (with-db
    (clsql:update-records-from-instance
     (make-instance 'entry :title @title :content @content)))
  (redirect (path-for 'index.html)))

(defaction entry (:route "entry/:id")
  (let ((entry (car (clsql:select 'entry :where [= [id] @id] :flatp t))))
    (with-default-template ()
      (:h1 (title entry))
      (:div (content entry))
      (:div (:a :href (path-for 'index.html) "戻る")))))

いつか完成するかな。

Opera での Hit a Hint

Opera のカスタマイズ で使わせてもらった Hit a Hint が自分でキーをカスタマイズできるようになっていました。

• Hit-a-Hintブックマークレット一応完成
• Hit-a-Hint Bookmarklet Generator

すばらしい。ありがとうございます。

最初だけ "" で後は "/" のシリーズを作る

Common Lisp の SERIES にある latch の使い道が分からなかったけど、初めて使い道を見付けた。

(subseries (latch (series "") :after 1 :post "/") 0 5)

本当はこんな関数を書くのに使った。

(defun path-to-regexp (path)
  (let (bindings)
    (values
      (with-output-to-string (out)
        (iterate ((x (scan (ppcre:split "/" path)))
                  (y (latch (series #'values) :after 1 :post (^ write-string "/" out))))
          (funcall y)
          (if (q:string-start-p x ":")
              (let ((var (subseq x 1)))
                (write-string "([^/]+)" out)
                (push (intern (string-upcase var)) bindings))
              (write-string (ppcre:quote-meta-chars x) out))))
      (nreverse bindings))))
;; (path-to-regexp "a/:a-id/b/:id")
;; => "a/([^/]+)/b/([^/]+)"
;;    (A-ID ID)

2日間みっちり！ Lispチュートリアル & 事例紹介セミナー

金曜日に数理システムさんの 2日間みっちり！ Lispチュートリアル & 事例紹介セミナー (数理システムユーザーコンファレンス2010) の 2 日目に行ってきました。ときどき 1 日目には行っていましたが、2 日目に行くのは初めてでした。

いろんな意味で豪華でした。

個人的には外国の方二名と(日本語で)お話できたのが嬉しかったです。

ありがとうございました。