Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2007-11-30

YouTubeのFLVダウンローダー

| 18:02 | YouTubeのFLVダウンローダー - わだばLisperになる を含むブックマーク はてなブックマーク - YouTubeのFLVダウンローダー - わだばLisperになる

最近PCを新しくして、Ubuntuで64bit環境にしてみたのですが、64bit版Flash PlayerがないためYouTube等は工夫しないと見れなくなってしまいました。元々YouTubeはあんまり見てないんないですが、観れないとなると観たくなってきました。

YouTubeの動画は、FLVという形式らしく、ダウンロード可能とのことで、動画ページに含まれるswfArgsという行のvideo_idとtをyoutube.com/get_video.phpというページにGETで送れば、FLVが取得できる仕組みとのこと(11/30日現在の仕様)ということなので、idの取得は、cl-ppcreで適当に抽出し、FLVのダウンロードは、以前letterさんのletter: Common Lisp でニコニコ動画ダウンローダーという記事を目にしていたので、記事を参考にさせて頂きました。

そんなこんなで、拙いですがFLVダウンローダーをでっち上げてみました。一応動きますが、flvファイル名の付けなおし等はいまいちな出来です。

一応ソース(youtube.lisp)も置いてみます。

;;; 動画ページのJavaScriptにある、swfArgsからvideo_idとtを取得し、両方をhttp://youtube.com/get_video.phpにGETで送りFLVを取得
;;; 
;;; 使用例
;;; (mapc (lambda (u)
;;; 	(format t "~A Started...~%" u)
;;; 	(get-flv-to-file-interactive u (merge-pathnames "Desktop/" (user-homedir-pathname)))
;;; 	(format t "Done...~%"))
;;;       '("http://jp.youtube.com/watch?v=E4PYJhh8ooo" ...))

(defpackage #:setagaya.youtube.mc
  (:nicknames #:youtube)
  (:use #:cl #:series #:drakma)			;and cl-ppcre
  (:export #:get-flv-to-file 
	   #:get-flv-to-file-interactive ;インタラクティブというよりちょっと状況を表示してくれるだけ
	   #:extruct-links))

(in-package #:youtube)

(defun get-video_id-&-title (uri)
  (with-input-from-string (line (http-request uri))
    (let ((id-scanner (ppcre:create-scanner "video_id:'\([0-9A-z\-_]{11}\)'.*,t:'\([0-9A-z\-_]{32}\)'"))
	  (title-scanner (ppcre:create-scanner "vidTitle\">\(.*\)</div>")))
      (flet ((rl () (read-line line nil :eof))
	     (latch (data scanner line)
	       (or data (nth-value 1 (ppcre:scan-to-strings scanner line)))))
	(do ((l (rl) (rl))
	     (id+tee nil (latch id+tee id-scanner l))
	     (title nil (latch title title-scanner l)))
	    ((eq :eof l))
	  (when (and id+tee title)
	    (let ((video_id (aref id+tee 0))
		  (tee (aref id+tee 1))
		  (title (ppcre:regex-replace-all "/" (aref title 0) "-"))) ;ファイル名の"/"をエスケープ
	      (return (values video_id tee title)))))))))

(defun decode-flv-uri (uri)
  (multiple-value-bind (id tee title ) (get-video_id-&-title uri)
    (values (concatenate 'string "http://youtube.com/get_video.php" "?video_id=" id "&t=" tee) title)))

(defun get-flv-to-file (uri path)
  (with-open-stream (in (http-request (decode-flv-uri uri) :want-stream t))
    (with-open-file (out path :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
      (collect-stream out (scan-stream in #'read-byte) #'write-byte))))

(defun get-flv-to-file-interactive (uri dir)
  (multiple-value-bind (flv-uri title) (decode-flv-uri uri)
    (with-open-stream (in (http-request flv-uri :want-stream t))
      (print "connect...")
      (with-open-file (out (merge-pathnames (concatenate 'string title ".flv") dir)
			   :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
	(collect-stream out (scan-stream in #'read-byte) #'write-byte))
      (print "Done..."))))

;; 検索結果等のページからflvへのリンクを抽出
(defun extruct-links (uri)
  (with-input-from-string (line (http-request uri))
    (let ((scanner (ppcre:create-scanner "watch\\?v=")))
      (flet ((rl () (read-line line nil :eof)))
	(do ((l (rl) (rl))
	     res)
	    ((eq :eof l) (nreverse res))
	  (let ((v (nth-value 1 (ppcre:scan-to-strings scanner l))))
	    (when v
	      (pushnew (concatenate 'string "http://jp.youtube.com"
				    (aref (nth-value 1 (ppcre:scan-to-strings ".*\(/watch\\?v=.{11}\)\".*" l)) 0))
		       res :test #'equal))))))))

;; 使用例
;; (get-flv-to-file-interactive URL 保存場所
;;
;; (mapc (lambda (u)
;; 	(format t "~A Started...~%" u)
;; 	(get-flv-to-file-interactive u (merge-pathnames "Desktop/" (user-homedir-pathname)))
;; 	(format t "Done...~%"))
;;       (extruct-links "http://jp.youtube.com/results?search_query=jerry+bergonzi&search=%E6%A4%9C%E7%B4%A2"))