added server stuff

12 years ago · 775608232d
5 changed files with 226 additions and 0 deletions
--- a/categories.html
+++ b/categories.html
@ -0,0 +1,35 @@
+<html>
+    <body>
+        <a href="http://localhost:8080/getcategory?category=Animation%2FComics">Animation/Comics</a>
+        <br />
+        <a href="http://localhost:8080/getcategory?category=Comedy">Comedy</a>
+        <br />
+        <a href="http://localhost:8080/getcategory?category=Drama">Drama</a>
+        <br />
+        <a href="http://localhost:8080/getcategory?category=Entertainment">Entertainment</a>
+        <br />
+        <a href="http://localhost:8080/getcategory?category=Fashion%2FBeauty">Fashion/Beauty</a>
+        <br />
+        <a href="http://localhost:8080/getcategory?category=Food%2FDrink">Food/Drink</a>
+        <br />
+        <a href="http://localhost:8080/getcategory?category=Health%2FFitness">Health/Fitness</a>
+        <br />
+        <a href="http://localhost:8080/getcategory?category=Home%2FFamily">Home/Family</a>
+        <br />
+        <a href="http://localhost:8080/getcategory?category=Howto">Howto</a>
+        <br />
+        <a href="http://localhost:8080/getcategory?category=Learning">Learning</a>
+        <br />
+        <a href="http://localhost:8080/getcategory?category=Music">Music</a>
+        <br />
+        <a href="http://localhost:8080/getcategory?category=News%2FPolitics">News/Politics</a>
+        <br />
+        <a href="http://localhost:8080/getcategory?category=Sports%2FCars">Sports/Cars</a>
+        <br />
+        <a href="http://localhost:8080/getcategory?category=Talk%2FInterview">Talk/Interview</a>
+        <br />
+        <a href="http://localhost:8080/getcategory?category=Tech%2FGadgets">Tech/Gadgets</a>
+        <br />
+        <a href="http://localhost:8080/getcategory?category=Videogames">Videogames</a>
+    </body>
+</html>
--- a/links.rkt
+++ b/links.rkt
@ -0,0 +1,113 @@
+#lang racket
+(require (planet clements/sxml2:1:3))
+(require (planet dherman/json:4:0))
+(require (planet neil/htmlprag:1:5))
+(require net/url)
+(require net/uri-codec)
+
+;; Blip.tv search and download server
+
+(define *MAXPAGES* 60)
+
+(define categories
+  #hash(("Animation/Comics" . 43)
+        ("Comedy" . 44)
+        ("Drama" . 45)
+        ("Entertainment" . 45)
+        ("Fashion/Beauty" . 47)
+        ("Food/Drink" . 48)
+        ("Health/Fitness" . 50)
+        ("Home/Family" . 51)
+        ("Howto" . 52)
+        ("Learning" . 53)
+        ("Music" . 55)
+        ("News/Politics" . 56)
+        ("Sports/Cars" . 58)
+        ("Talk/Interview" . 59)
+        ("Tech/Gadgets" . 60)
+        ("Videogames" . 61)))
+
+;; Category Stuff Starts...
+(define (make-category-url category page)
+  (let* ([id (hash-ref categories category #f)]
+         [url (λ () (format
+                     "http://blip.tv/pr/channel_get_directory_listing?channels_id=~a&section=all&page=~a"
+                     id
+                     page))])
+    (if (false? id)
+        #f
+   (values
+    (λ ()
+     (set! page (+ 1 page))
+      (url))
+    url
+    category
+    id))))
+
+(define add-breaks
+  (sxml:modify (list "a" 'insert-following `(br ""))))
+
+(define (parse-category-chunk chunk)
+  (let* ([links (sxpath "//li/div/h3/a")]
+         [descriptions (sxpath "//p")]
+         [html (port->string (get-pure-port (string->url chunk)))]
+         [result (links (html->shtml html))])
+  (match result
+    ['() '()]
+    [_ 
+     (let* ([new-result (shtml->html result)]
+            [new-new-result (html->sxml new-result)])
+       (srl:sxml->html (add-breaks new-new-result)))])))
+
+(define (get-category-list next url category)
+  (let ([pages '()])
+    (letrec ([acc-pages (λ (n)
+                (match (eq? n *MAXPAGES*)
+                    [#t pages]
+                    [#f (let ([res (parse-category-chunk (next))])
+                          (match (empty? res) 
+                           [#f (set! pages (cons res pages))
+                               (acc-pages (+ 1 n))]
+                           [#t pages]))]))])
+      (acc-pages 1)
+      pages)))
+
+(define (get-category category)
+  (define-values (drama.next drama.url drama.category drama.id) (make-category-url category 1))
+        (string-join
+         (reverse (get-category-list drama.next (drama.url) drama.category)) ""))
+
+;; Category Stuff ends...
+
+(define (string->json data)
+  (json->jsexpr (regexp-replace* #px"\\s" (port->string data) "")))
+
+;; Turns a normal blip video url into the direct link
+(define (blipurl->direct-url link)
+  (let* ([data (string->json (get-pure-port (string->url (format "~a?skin=json&version=2&no_wrap=1" link))))]
+         [new-url (string->url (hash-ref (hash-ref (hash-ref data 'Post) 'media) 'url))])
+    (url->string new-url)))
+
+;; Searches blip.tv
+(define (search-blip keywords)
+  (let ([data (get-pure-port 
+                (string->url (format "http://blip.tv/posts/?pagelen=650&skin=json&search=~a&version=2&no_wrap=1" keywords)))])
+    (string->json data)))
+
+;;Gets all of a user's videos
+(define (retrieve-videos username)
+  (let* ([user-url (string->url (format "http://blip.tv/~a?pagelen=10&skin=json&version=2&no_wrap=1" username))]
+         [data (string->json (get-pure-port user-url))])
+    (format
+     "<html><body>~a</body></html>"
+     (format "~a" (string-join
+                           (map (λ (x) 
+                                 (format "<a href=\"http://localhost:8080/add?name=~a\">~a</a>"
+                                         (form-urlencoded-encode
+                                          (blipurl->direct-url (hash-ref x 'url)))
+                                         (hash-ref x 'title))) data)
+                           "<br />")))))
+
+;(retrieve-videos "slowbeef")
+
+(provide get-category retrieve-videos)
--- a/main.html
+++ b/main.html
@ -0,0 +1,6 @@
+<html>
+    <body>
+        <title> @categoryname </title>
+        @categories
+    </body>
+</html>
--- a/playlist_server.rkt
+++ b/playlist_server.rkt
@ -0,0 +1,67 @@
+#lang racket
+(require web-server/servlet
+         web-server/servlet-env)
+(require web-server/templates)
+(require web-server/dispatch)
+(require "links.rkt")
+(require xml)
+
+(define (make-server player-thread parse-command)
+  (define (response/404 req) 
+  (response 404 #"Not Found" 
+            (current-seconds) 
+            TEXT/HTML-MIME-TYPE 
+            (list) 
+            (λ (op) (write-bytes #"Not Found" op))))
+
+(define (list->hash xs)
+  (let ([ht (make-hash)])
+    (map
+     (λ (item)
+       (if (pair? item)
+           (hash-set! ht (car item) (cdr item))
+           (error "not a pair"))) xs)
+    ht))
+
+(define-values (lazyplay-dispatch lazyplay-url)
+  (dispatch-rules
+   [("getcategory") category-response]
+   [("categories") category-list-response]
+   [("favicon.ico") response/404]
+   [("add") add-name]
+   [else user-list]))
+
+;; Returns all of the videos for a user
+(define (user-list req)
+  (response/xexpr
+   (string->xexpr
+    (retrieve-videos (path/param-path (car (url-path (request-uri req))))))))
+
+;; Adds a new resource to the lazyplay queue
+(define (add-name req)
+  (let ([name (hash-ref
+               (list->hash (url-query (request-uri req)))
+               'name)])
+    (display name)
+    (thread-send player-thread (parse-command (format "add ~a" name)))
+    (response/xexpr (string->xexpr (include-template "./sent.html")))))
+
+;; Lists all the available categories
+(define (category-list-response req)
+  (response/xexpr (string->xexpr (include-template "./categories.html"))))
+
+;; Gets a category listing
+(define (category-response req) 
+  (let* ([query-data (url-query (request-uri req))]
+         [query-hash (list->hash query-data)]
+         [categoryname (hash-ref query-hash 'category)]
+         [categories (get-category categoryname)])
+    (response/xexpr (string->xexpr (include-template "./main.html")))))
+
+(serve/servlet 
+ lazyplay-dispatch
+ #:servlet-regexp #px""
+ #:launch-browser? #f
+ #:port 8080))
+
+(provide make-server)
--- a/sent.html
+++ b/sent.html
@ -0,0 +1,5 @@
+<html>
+    <body>
+        <strong>Sent @name </strong>
+    </body>
+</html>