Created by XTL? on #scheme-on-freenode. Requires gauche. Needs some fixing for current google video.
;;;; A small and unpolished helper (in gauche scheme) that should make it ;;;; easier to download clips from http://video.google.com ;;;; The site, when you hit "download" outputs an odd text file containing some ;;;; parameters including a long url. The filename can be extracted from that url's ;;;; HTTP headers. (use rfc.http) ;; SRFI-8 for receive ;; Apparently gauche doesn't actually need to explicitly load this (use srfi-8) (define *vidhost* "video.google.com") ;; For the param page (define *vphost* "vp.video.google.com") ;; For the video data ;; Fetches the description file for parsing (define (get-body url) (receive (status headers body) (http-get *vidhost* url) (or (not (string=? "200" status)) body ))) ;; Line is a comment if first character is a hashmark ;; Notably the first line in the output (define (comment? line) (string=? "#" (substring line 0 1))) ;; Find value of key from line (define (value-of key line) (and (not (comment? line)) (string=? key (string-scan line #\: 'before)) (string-scan line #\: 'after))) ;; finds the desired field in the name:value output (define (find-value key port) (let loop ((line (read-line port))) (or (value-of key line) (loop (read-line port))))) ;; Fetch the file ;; FIXME: There's no checks about existing files, filename is naively read from net (define (fetch url) (let* ((hdrs (receive (status headers body) (http-head *vphost* url) headers)) (attachment (cadr (assoc "content-disposition" hdrs))) (filename (string-scan attachment #\= 'after))) (call-with-output-file filename (lambda (out) (http-get *vphost* url :sink out :flusher (lambda _ #t)))))) ;; Main reads a line containing the url to the odd page, for example ;; http://video.google.com/videogvp/trailerforshortfilmr.gvp?docid=2691563751319871425 (define (main args) (display "URL: ") (flush) (let* ((url (read-line)) (body (get-body url)) ) (display (string-append "Fetching '" (find-value "title" (open-input-string body)) "'")) (newline) (display (fetch (find-value "url" (open-input-string body)))) (newline)))