Cosmetic changes to code

This commit is contained in:
arthurmaciel 2014-07-07 23:37:35 -03:00
parent 6edd64bc5d
commit 49dbc4599e
3 changed files with 20 additions and 17 deletions

View File

@ -31,39 +31,41 @@
(import scheme chicken data-structures extras posix) (import scheme chicken data-structures extras posix)
(use awful spiffy intarweb) (use awful spiffy intarweb)
(define (add-sse-resource! path proc vhost-root-path redirect-path) (define (add-sse-resource! sse-path sse-proc vhost-root-path client-path)
(add-resource! path (add-resource! sse-path
(or vhost-root-path (root-path)) (or vhost-root-path (root-path))
(lambda (#!optional given-path) (lambda (#!optional given-path)
(let ((accept (header-values 'accept (let ((accept (header-values 'accept
(request-headers (current-request))))) (request-headers (current-request)))))
;; If client 'EventSource' JS code requested SSE page...
(if (memq 'text/event-stream accept) (if (memq 'text/event-stream accept)
(lambda () ;; ...complete handshake and keep connection alive with 'sse-proc'.
(lambda ()
(with-headers '((content-type text/event-stream) (with-headers '((content-type text/event-stream)
(cache-control no-cache) (cache-control no-cache)
(connection keep-alive)) (connection keep-alive))
(lambda () (lambda ()
(write-logged-response) (write-logged-response)
(proc)))) (sse-proc))))
(redirect-to redirect-path)))) (redirect-to client-path))))
'GET)) 'GET))
(define (define-page/sse path contents sse-path sse-proc #!rest rest)
(apply define-page (append (list path contents) rest))
(add-sse-resource! sse-path sse-proc (get-keyword vhost-root-path: rest) path))
(define (write-body data) (define (write-body data)
(display data (response-port (current-response))) (display data (response-port (current-response)))
(finish-response-body (current-response))) (finish-response-body (current-response)))
(define (send-sse-data data #!key event id) (define (send-sse-data data #!key event id)
(let ((msg (conc (if id (conc "id: " id "\n") "") (let ((msg (conc (if id (conc "id: " id "\n") "")
(if event (conc "event: " event "\n") "") (if event (conc "event: " event "\n") "")
"data: " data "\n\n"))) "data: " data "\n\n")))
(write-body msg))) (write-body msg)))
(define (send-sse-retry retry) (define (send-sse-retry retry)
(write-body (conc "retry: " retry "\n\n"))) (write-body (conc "retry: " retry "\n\n")))
(define (define-page/sse path contents sse-path sse-proc #!rest rest)
(apply define-page (append (list path contents) rest))
(add-sse-resource! sse-path sse-proc (get-keyword vhost-root-path: rest) path))
) ; End of module ) ; End of module

View File

@ -1,5 +1,5 @@
;; Run with {{awful example1.scm}}. ;; Run with 'awful example1.scm'.
;; On web browser open [[http://localhost:8080/client]] and watch the ;; On web browser open http://localhost:8080/client and watch the
;; new time coming each second from the server. ;; new time coming each second from the server.
(use awful-sse awful spiffy posix srfi-18) (use awful-sse awful spiffy posix srfi-18)

View File

@ -1,10 +1,10 @@
;; Run with {{awful example2.scm}}. ;; Run with 'awful example2.scm'.
;; Open two web browsers and point both to [[http://localhost:8080/client]]. ;; Open two web browsers and point both to http://localhost:8080/client.
;; Try clicking on the blue and the red div and see them changing their ;; Try clicking on the blue and the red divs and see them changing their
;; boolean values on BOTH browsers. ;; boolean values on BOTH browsers.
(use awful-sse awful spiffy json posix srfi-18) (use awful-sse awful spiffy json posix srfi-18)
;; Global variables are not good practice, but will suffice for the moment. ; Global variables are not good practice, but will suffice for the moment.
(define one #t) (define one #t)
(define two #f) (define two #f)
@ -39,6 +39,7 @@
(ajax "one" 'one 'click (ajax "one" 'one 'click
(lambda () (lambda ()
(swap1!))) (swap1!)))
(ajax "two" 'two 'click (ajax "two" 'two 'click
(lambda () (lambda ()
(swap2!))) (swap2!)))