You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
67 lines
1.9 KiB
67 lines
1.9 KiB
12 years ago
|
#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)
|