From 775608232d8d94e74fe8ed2727ec06a94ff78800 Mon Sep 17 00:00:00 2001 From: wes Date: Sun, 12 Aug 2012 03:18:36 -0400 Subject: [PATCH] added server stuff --- categories.html | 35 ++++++++++++++ links.rkt | 113 ++++++++++++++++++++++++++++++++++++++++++++ main.html | 6 +++ playlist_server.rkt | 67 ++++++++++++++++++++++++++ sent.html | 5 ++ 5 files changed, 226 insertions(+) create mode 100644 categories.html create mode 100644 links.rkt create mode 100644 main.html create mode 100644 playlist_server.rkt create mode 100644 sent.html diff --git a/categories.html b/categories.html new file mode 100644 index 0000000..416d210 --- /dev/null +++ b/categories.html @@ -0,0 +1,35 @@ + + + Animation/Comics +
+ Comedy +
+ Drama +
+ Entertainment +
+ Fashion/Beauty +
+ Food/Drink +
+ Health/Fitness +
+ Home/Family +
+ Howto +
+ Learning +
+ Music +
+ News/Politics +
+ Sports/Cars +
+ Talk/Interview +
+ Tech/Gadgets +
+ Videogames + + \ No newline at end of file diff --git a/links.rkt b/links.rkt new file mode 100644 index 0000000..00d1632 --- /dev/null +++ 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§ion=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 + "~a" + (format "~a" (string-join + (map (λ (x) + (format "~a" + (form-urlencoded-encode + (blipurl->direct-url (hash-ref x 'url))) + (hash-ref x 'title))) data) + "
"))))) + +;(retrieve-videos "slowbeef") + +(provide get-category retrieve-videos) \ No newline at end of file diff --git a/main.html b/main.html new file mode 100644 index 0000000..f22f9b8 --- /dev/null +++ b/main.html @@ -0,0 +1,6 @@ + + + @categoryname + @categories + + \ No newline at end of file diff --git a/playlist_server.rkt b/playlist_server.rkt new file mode 100644 index 0000000..a7b2000 --- /dev/null +++ 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) \ No newline at end of file diff --git a/sent.html b/sent.html new file mode 100644 index 0000000..02fd9ed --- /dev/null +++ b/sent.html @@ -0,0 +1,5 @@ + + + Sent @name + + \ No newline at end of file