livedoor 番組表から Google Calendar へ
plagger 界隈等で話題としてはおなじみだと思うんですが、Scheme でやってみました。livedoor 番組表の RSS フィードで番組検索をし、ATOM ドキュメントに変換して Google Calendar のフィード API にポストする、というものです。
livedoor tv
とりあえず、番組情報 RSS の取得に必要な関数を作ってみましょう:
(require (planet lizorkin/sxml:2:0/sxml)
scheme/list
net/uri-codec)
(define (sxml:tv-rss url)
(sxml:document
url
'((rdf . "http://www.w3.org/1999/02/22-rdf-syntax-ns#")
(rss . "http://purl.org/rss/1.0/")
(dc . "http://purl.org/dc/elements/1.1/")
(tv . "http://tv.livedoor.com/spec/-/1.0/")
(content . "http://purl.org/rss/1.0/modules/content/")
(image . "http://web.resource.org/rss/1.0/modules/image/"))))SXML では名前空間の扱いが非常に厳格で、
<dc:subject>
のようなタグが一旦
(http://purl.org/dc/elements/1.1/:subject)
という、URI で修飾された形に変換されます (参照: SXML)。
そこで、sxpath で要素の検索をする際に短い名前が使えるよう、sxml:tv-rss という関数を作って URI を省略形に戻す指定をしています。
次に RSS の URL を生成する関数ですが、
(define ((search-url pref_id type) word) (format "http://tv.livedoor.com/rss/search?keywords=~a&pref_id=~a&search_type=~a" (uri-encode word) pref_id type))
と、カリー化関数として定義してみました。こうすると関数を map の引数にしたい場合等に便利なんです。例えば、好きなタレントさんをまとめて検索したい場合:
(append-map (compose (sxpath '(rdf:RDF rss:item))
sxml:tv-rss
(search-url 27 3))
'("千原ジュニア" "久住小春" "月島きらり"))という風にうまくはまるわけです。
出力は長いので省略しますが、きらりちゃんのおはスタ出演情報は出てきませんでした (来週の火曜まで出るのは知っています)。この方法でチェックできたら便利だなと思っていただけに、残念。
ちなみに 27 というのは都道府県 ID、3 は「フリーワード検索」の指定です (1 だと出演者名、2 だと番組名での検索となります)。
Google Calendar
Google の他のサービスでもそうだと思いますが、Google Calendar に情報を書き込んだり、読み出し・問い合わせをするために、Atom フィード API というものが提供されています。
こういうのです:
http://www.google.com/calendar/feeds/default/private/full
この URL に対して GET や POST を行うことで、イベント (番組の予定など) の閲覧や投稿ができるわけです。
なお、上 URL はメインのカレンダーに読み書きする場合なんですが、複数のカレンダーを作っている場合は "default" の部分をそれぞれのカレンダー ID に置き換えることでアクセス可能です。
以下、詳細は次のレファレンスに記載されていますが、かいつまんで投稿までの流れを追っていきましょう。
API Developer's Guide: The Protocol
フィード URL にアクセスするには認証ヘッダー ("Authorization: GoogleLogin auth=AUTH-STRING") が必要なので、まず Google アカウントのログインができるようにしておきます。
(define (port->string in)
(dynamic-wind
void
(lambda ()
(let ((out (open-output-string)))
(copy-port in out)
(get-output-string out)))
(lambda ()
(close-input-port in))))
(define (login-google)
(let ((res
(port->string
(ssl:post-pure-port
(string->url "https://www.google.com/accounts/ClientLogin")
(string->bytes/utf-8
(alist->form-urlencoded
'((Email . "foo@gmail.com")
(Passwd . "password")
(source . "livedoor-tv2gcal-1.0")
(service . "cl"))))
(list
"Content-Type: application/x-www-form-urlencoded")))))
(cond ((regexp-match #rx"(?m:^Auth=(.+)$)" res) => cadr)
(else (error 'login-google "Login failed.")))))次にフィード API に POST するんですが、最初に POST した後に、302 のステータス・コードが返ってきて、セッション ID 付きの URL にリダイレクトされます (GET の場合も同様です)。同時にクッキーも食べさせられますが、多分1回限りのクッキーなので保存処理は考えなくても良いだろうと思います。
投稿に成功した場合は 201 が返ります。これらのケースを次のような述語関数で判定することにします:
(define-values (repost? success?)
(let ((code=?
(lambda (code)
(curry regexp-match?
(regexp
(format "^HTTP/[0-9]+\\.[0-9]+ ~a" code))))))
(values (code=? 302) (code=? 201))))投稿関数はこんな感じです:
(define (post-item item)
(receive (ok? head body)
(post-event (feed-api) (item->event item))
(if ok?
item
(printf "Failed posting event:~%~a~%~a~%" head body))))
(define (post-event api event)
(define (post api (cookie #f))
(on-post
(post-impure-port
(string->url api)
(string->bytes/utf-8 event)
(append
(if cookie (list cookie) '())
(list "Content-Type: application/atom+xml"
(format "Authorization: GoogleLogin auth=~a"
(login-google)))))))
(define (on-post in)
(let ((head (purify-port in))
(body (port->string in)))
(cond ((repost? head) (redirect/cookie head post))
((success? head) (values #t head body))
(else (values #f head body)))))
(begin0 (post api)
(sleep 1)))
(define (redirect/cookie head succ (fail void))
(cond ((header-location head)
=> (lambda (url)
(succ url (header-cookie head))))
(else (fail))))投稿するイベント・データについては、Scheme らしく S 式で XML を組み立ててから文字列にシリアライズする方法を取ることにします。
形式はこんな感じです:
'(entry
(@ (xmlns "http://www.w3.org/2005/Atom")
(xmlns:gd "http://schemas.google.com/g/2005"))
(category
(@ (scheme "http://schemas.google.com/g/2005#kind")
(term "http://schemas.google.com/g/2005#event")))
(title (@ (type "text")) "タイトル")
(content (@ (type "text")) "番組内容")
(gd:transparency
(@ (value "http://schemas.google.com/g/2005#event.opaque")))
(gd:eventStatus
(@ (value "http://schemas.google.com/g/2005#event.confirmed")))
(gd:where (@ (valueString "放送局")))
(gd:when
(@ (startTime "開始時刻") (endTime "終了時刻"))))これを文字列化したいわけなんですが、SXML ライブラリのシリアライザ (srl:sxml->xml, sxml:sxml->xml) だと API が受け付けてくれなかったり、時刻等のパラメータが登録されなかったりで、どうもうまくいきませんでした (多分 Gauche とかでも同じなんじゃないかと思います)。
どうやら名前空間の扱いが問題を生じているようなので、次のような関数を用意することで何とか解決しました:
(define (my:attr->xml attr)
`(" " ,(symbol->string (car attr)) "='" ,(cadr attr) "'"))
(define (my:sxml->xml tree)
(cond ((nodeset? tree) (map my:sxml->xml tree))
((pair? tree)
(let ((nm (symbol->string (car tree)))
(content (sxml:content-raw tree)))
`("<" ,nm
,@(map my:attr->xml (sxml:attr-list tree))
,@(if (null? content)
'("/>")
`(">" ,@(my:sxml->xml content) "</" ,nm ">")))))
((string? tree) (sxml:string->xml tree))
(else #f)))実際には my:sxml->xml は文字列を含むツリーを返しますので、ツリーを文字列化する関数を使う必要があります:
(define (tree->string tree)
(let ((o (open-output-string)))
(parameterize ((current-output-port o))
(let loop ((tree tree))
(cond ((pair? tree) (map loop tree))
((string? tree) (display tree)))))
(get-output-string o)))
(tree->string (my:sxml->xml event-sxml))まとめますと、
(map post-item
(append-map (compose (sxpath '(rdf:RDF rss:item))
sxml:tv-rss
(search-url 27 3))
'("ケンドーコバヤシ" "久住小春" "星月きらら")))のようにして検索から投稿までを一気に行うことができます。
実際に走らせてみた例です:
1日にやりすぎコージーが3つあるとか… (1つは番宣ですが)。ちなみに9時からの放送ではフットボールアワーの岩尾君が Berryz ネタをやるみたいです。
上記のほか、番組の重複投稿を防ぐ工夫などを加えたコードを張っておきます。ご覧ください:
prelude.ss
tv2gcal.ss
ssl-url.ss
conf.ss
alist.ss
zipper.ss
P.S.
g000001様、
お声をお掛け頂き、有難うございます。恐縮しております。
醜い言い訳なのは重々承知なのですが、次にブログを書くタイミングでコメントをチェックするというのがこのところ習慣づいてまして、今回気付くのが大幅に遅れてしまいました。非礼をお詫びいたします。
ということで今更なんですが、やはり人前で話すとなるとちょっと臆してしまいます。きっと期日前に知ったとしてもお断りしていたことでしょう…。
もっと自分に自信が付いたら、自ら名乗りを上げさせて頂くかも知れません。ともあれ、失礼いたしました。
