google-video-helper


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))) 

category-code