Gauche でニコ動のタイトルやサムネ画像URLを取得したりとか

Gauche の勉強で書いてみたニコ動のタイトルやサムネ画像URLを取得する処理。
正直、SchemeやGaucheの流儀とかを知らずに書いたけど、取り敢えず動く。

(use rfc.http)
(use rfc.uri)

(define-constant *getthumbinfo-url* "http://ext.nicovideo.jp/api/getthumbinfo")
(define-constant *ok-string*   "<nicovideo_thumb_response status=\"ok\">")
(define-constant *fail-string* "<nicovideo_thumb_response status=\"fail\">")
(define-constant *elements* '(title description thumbnail_url watch_url))

(define (getthumbinfo video-id)
  (receive (code status body)
    (http-getthumbinfo video-id)
    (if (rxmatch (string->regexp *ok-string*) body)
      (map (lambda (element) 
             (rxmatch-substring ((element->regexp element) body) 1))
        *elements*)
      #f)))

(define (http-getthumbinfo video-id)
  (receive (scheme user-info hostname port path query frament)
    (uri-parse #`",|*getthumbinfo-url*|/,video-id")
    (http-get hostname path)))

(define (element->regexp element)
  (string->regexp #`"<,|element|>(.*?)<\/,|element|>"))
      
(receive (title description thumbnail_url watch_url)
  (apply values (getthumbinfo 'sm9))
  (print title)             ;=> 新・豪血寺一族 -煩悩解放 - レッツゴー！陰陽師
  (print description)       ;=> レッツゴー！陰陽師（フルコーラスバージョン）
  (print thumbnail_url)     ;=> http://tn-skr2.smilevideo.jp/smile?i=9
  (print watch_url))        ;=> http://www.nicovideo.jp/watch/sm9
(print (getthumbinfo 'smx)) ;=> #f

次は Gauche のオブジェクト指向的にクラス定義したりとか。
ただ、このままだと内臓がトップレベルに駄々漏れなので
なんとかした方がいいと思いつつも途中辞め。

(define-class <nicovideo> ()
  ((videoid :init-keyword :videoid :accessor videoid-of)
   (title :init-value #f)
   (description :init-value #f)
   (thumbnail_url :init-value #f)
   (watch_url :init-value #f)))

(define-method write-object ((nicovideo <nicovideo>) port)
  (format port "#<<nicovideo> (~a)>"
          (slot-ref nicovideo 'videoid)))

(define-method getthumbinfo ((nicovideo <nicovideo>))
  (let ((result (getthumbinfo (slot-ref nicovideo 'videoid)))) 
    (if (list? result)
      (receive (title description thumbnail_url watch_url)
        (apply values result)
        (set! (slot-ref nicovideo 'title) title)
        (set! (slot-ref nicovideo 'description) description)
        (set! (slot-ref nicovideo 'thumbnail_url) thumbnail_url)
        (set! (slot-ref nicovideo 'watch_url) watch_url))
      #f)))

(define sm9 (make <nicovideo> :videoid 'sm9))
(getthumbinfo sm9)
(print sm9)                           ; => #<<nicovideo> (sm9)>
(print (slot-ref sm9 'title))         ; => 新・豪血寺一族 -煩悩解放 - レッツゴー！陰陽師
(print (slot-ref sm9 'description))   ; => レッツゴー！陰陽師（フルコーラスバージョン）
(print (slot-ref sm9 'thumbnail_url)) ; => http://tn-skr2.smilevideo.jp/smile?i=9
(print (slot-ref sm9 'watch_url))     ; => http://www.nicovideo.jp/watch/sm9

(define smx (make <nicovideo> :videoid 'smx))
(print (getthumbinfo smx))            ; => #f
(print smx)                           ; => #<<nicovideo> (smx)>